Diff of /Sprout/CustomAttributes.pm

-revision 1.23, Mon Apr 23 06:26:54 2007 UTC
+revision 1.33, Tue Aug 12 06:06:02 2008 UTC
 Line 9
      use Tracer;
      use ERDBLoad;
      use Stats;
+     use Time::HiRes qw(time);
+     use FIGRules;
  =head1 Custom SEED Attribute Manager
-Line 124
+Line 126
  functions as data to the attribute management process, so if the data is
  moved, this file must go with it.
+ =item attr_default_table
+ Name of the default relationship for attribute values. If not present,
+ C<HasValueFor> is used.
  =back
  =head2 Public Methods
  =head3 new
- C<< my $attrDB = CustomAttributes->new(%options); >>
+     my $attrDB = CustomAttributes->new(%options);
  Construct a new CustomAttributes object. The following options are
  supported.
-Line 154
+Line 161
  sub new {
      # Get the parameters.
      my ($class, %options) = @_;
+     # Get the name ofthe default table.
      # Connect to the database.
      my $dbh = DBKernel->new($FIG_Config::attrDbms, $FIG_Config::attrDbName,
                              $FIG_Config::attrUser, $FIG_Config::attrPass,
-Line 167
+Line 175
      # Store the user name.
      $retVal->{user} = $options{user} || '<unknown>';
      Trace("User $retVal->{user} selected for attribute object.") if T(3);
+     # Compute the default value table name. If it's not overridden, the
+     # default is HasValueFor.
+     $retVal->{defaultRel} = $FIG_Config::attr_default_table || 'HasValueFor';
      # Return the result.
      return $retVal;
  }
  =head3 StoreAttributeKey
- C<< $attrDB->StoreAttributeKey($attributeName, $type, $notes, \@groups); >>
+     $attrDB->StoreAttributeKey($attributeName, $notes, \@groups, $table);
  Create or update an attribute for the database.
-Line 183
+Line 194
  Name of the attribute (the real key). If it does not exist already, it will be created.
- =item type
- Data type of the attribute. This must be a valid ERDB data type name.
  =item notes
  Descriptive notes about the attribute. It is presumed to be raw text, not HTML.
-Line 196
+Line 203
  Reference to a list of the groups to which the attribute should be associated.
  This will replace any groups to which the attribute is currently attached.
+ =item table
+ The name of the relationship in which the attribute's values are to be stored.
+ If empty or undefined, the default relationship (usually C<HasValueFor>) will be
+ assumed.
  =back
  =cut
  sub StoreAttributeKey {
      # Get the parameters.
-     my ($self, $attributeName, $type, $notes, $groups) = @_;
+     my ($self, $attributeName, $notes, $groups, $table) = @_;
      # Declare the return variable.
      my $retVal;
+     # Default the table name.
+     if (! $table) {
+         $table = $self->{defaultRel};
+     }
      # Get the data type hash.
      my %types = ERDB::GetDataTypes();
      # Validate the initial input values.
      if ($attributeName =~ /$self->{splitter}/) {
          Confess("Invalid attribute name \"$attributeName\" specified.");
-     } elsif (! $notes || length($notes) < 25) {
+     } elsif (! $notes) {
-         Confess("Missing or incomplete description for $attributeName.");
+         Confess("Missing description for $attributeName.");
-     } elsif (! exists $types{$type}) {
+     } elsif (! grep { $_ eq $table } $self->GetConnectingRelationships('AttributeKey')) {
-         Confess("Invalid data type \"$type\" for $attributeName.");
+         Confess("Invalid relationship name \"$table\" specified as a custom attribute table.");
      } else {
          # Create a variable to hold the action to be displayed for the log (Add or Update).
          my $action;
-Line 223
+Line 240
              # It does, so we do an update.
              $action = "Update Key";
              $self->UpdateEntity('AttributeKey', $attributeName,
-                                 { description => $notes, 'data-type' => $type });
+                                 { description => $notes,
+                                   'relationship-name' => $table});
              # Detach the key from its current groups.
              $self->Disconnect('IsInGroup', 'AttributeKey', $attributeName);
          } else {
              # It doesn't, so we do an insert.
              $action = "Insert Key";
              $self->InsertObject('AttributeKey', { id => $attributeName,
-                                 description => $notes, 'data-type' => $type });
+                                 description => $notes,
+                                 'relationship-name' => $table});
          }
          # Attach the key to the specified groups. (We presume the groups already
          # exist.)
-Line 246
+Line 265
  =head3 DeleteAttributeKey
- C<< my $stats = $attrDB->DeleteAttributeKey($attributeName); >>
+     my $stats = $attrDB->DeleteAttributeKey($attributeName);
  Delete an attribute from the custom attributes database.
-Line 278
+Line 297
  =head3 NewName
- C<< my $text = CustomAttributes::NewName(); >>
+     my $text = CustomAttributes::NewName();
  Return the string used to indicate the user wants to add a new attribute.
-Line 288
+Line 307
      return "(new)";
  }
- =head3 ControlForm
- C<< my $formHtml = $attrDB->ControlForm($cgi, $name, \%keys); >>
- Return a form that can be used to control the creation and modification of
- attributes. Only a subset of the attribute keys will be displayed, as
- determined by the incoming list.
- =over 4
- =item cgi
- CGI query object used to create HTML.
- =item name
- Name to give to the form. This should be unique for the web page.
- =item keys
- Reference to a hash mapping attribute keys to n-tuples. Each tuple will contain the
- attribute's data type, its description, and a list of the groups in which it participates.
- =item RETURN
- Returns the HTML for a form that can be used to  submit instructions to the C<Attributes.cgi> script
- for loading, creating, displaying, changing, or deleting an attribute. Note that only the form
- controls are generated. The form tags are left to the caller.
- =back
- =cut
- sub ControlForm {
-     # Get the parameters.
-     my ($self, $cgi, $name, $keys) = @_;
-     # Declare the return list.
-     my @retVal = ();
-     # We'll put the controls in a table. Nothing else ever seems to look nice.
-     push @retVal, $cgi->start_table({ border => 2, cellpadding => 2 });
-     # The first row is for selecting the field name.
-     push @retVal, $cgi->Tr($cgi->th("Select a Field"),
-                            $cgi->td($self->FieldMenu($cgi, 10, 'fieldName', $keys,
-                                                      new => 1,
-                                                      notes => "document.$name.notes.value",
-                                                      type => "document.$name.dataType.value",
-                                                      groups => "document.$name.groups")));
-     # Now we set up a dropdown for the data types. The values will be the
-     # data type names, and the labels will be the descriptions.
-     my %types = ERDB::GetDataTypes();
-     my %labelMap = map { $_ => $types{$_}->{notes} } keys %types;
-     my $typeMenu = $cgi->popup_menu(-name   => 'dataType',
-                                     -values => [sort keys %types],
-                                     -labels => \%labelMap,
-                                     -default => 'string');
-     # Allow the user to specify a new field name. This is required if the
-     # user has selected the "(new)" marker. We put a little scriptlet in here that
-     # selects the (new) marker when the user enters the field.
-     push @retVal, "<script language=\"javaScript\">";
-     my $fieldField = "document.$name.fieldName";
-     my $newName = "\"" . NewName() . "\"";
-     push @retVal, $cgi->Tr($cgi->th("New Field Name"),
-                            $cgi->td($cgi->textfield(-name => 'newName',
-                                                     -size => 30,
-                                                     -value => "",
-                                                     -onFocus => "setIfEmpty($fieldField, $newName);")),
-                                     );
-     push @retVal, $cgi->Tr($cgi->th("Data type"),
-                            $cgi->td($typeMenu));
-     # The next row is for the notes.
-     push @retVal, $cgi->Tr($cgi->th("Description"),
-                            $cgi->td($cgi->textarea(-name => 'notes',
-                                                    -rows => 6,
-                                                    -columns => 80))
-                           );
-     # Now we have the groups, which are implemented as a checkbox group.
-     my @groups = $self->GetGroups();
-     push @retVal, $cgi->Tr($cgi->th("Groups"),
-                            $cgi->td($cgi->checkbox_group(-name=>'groups',
-                                     -values=> \@groups))
-                           );
-     # Now the four buttons: STORE, SHOW, ERASE, and DELETE.
-     push @retVal, $cgi->Tr($cgi->th("&nbsp;"),
-                            $cgi->td({align => 'center'}, join(" ",
-                                     $cgi->submit(-name => 'Delete', -value => 'DELETE'),
-                                     $cgi->submit(-name => 'Store',  -value => 'STORE'),
-                                     $cgi->submit(-name => 'Erase',  -value => 'ERASE'),
-                                     $cgi->submit(-name => 'Show',   -value => 'SHOW')
-                                    ))
-                           );
-     # Close the table and the form.
-     push @retVal, $cgi->end_table();
-     # Return the assembled HTML.
-     return join("\n", @retVal, "");
- }
  =head3 LoadAttributesFrom
  C<< my $stats = $attrDB->LoadAttributesFrom($fileName, %options); >>
  Load attributes from the specified tab-delimited file. Each line of the file must
  contain an object ID in the first column, an attribute key name in the second
- column, and attribute values in the remaining columns. The attribute values will
+ column, and attribute values in the remaining columns. The attribute values must
  be assembled into a single value using the splitter code. In addition, the key names may
  contain a splitter. If this is the case, the portion of the key after the splitter is
  treated as a subkey.
-Line 417
+Line 340
  =over 4
+ =item mode
+ Loading mode. Legal values are C<low_priority> (which reduces the task priority
+ of the load) and C<concurrent> (which reduces the locking cost of the load). The
+ default is a normal load.
  =item append
  If TRUE, then the attributes will be appended to existing data; otherwise, the
-Line 424
+Line 353
  =item archive
- If specified, the name of a file into which the incoming data file should be saved.
+ If specified, the name of a file into which the incoming data should be saved.
+ If I<resume> is also specified, only the lines actually loaded will be put
+ into this file.
  =item objectType
  If specified, the specified object type will be prefixed to each object ID.
+ =item resume
+ If specified, key-value pairs already in the database will not be reinserted.
+ Specify a number to start checking after the specified number of lines and
+ then admit everything after the first line not yet loaded. Specify C<careful>
+ to check every single line. Specify C<none> to ignore this option. The default
+ is C<none>. So, if you believe that a previous load failed somewhere after 50000
+ lines, a resume value of C<50000> would skip 50000 lines in the file, then
+ check each line after that until it finds one not already in the database. The
+ first such line found and all lines after that will be loaded. On the other
+ hand, if you have a file of 100000 records, and some have been loaded and some
+ not, you would use the word C<careful>, so that every line would be checked before
+ it is inserted. A resume of C<0> will start checking the first line of the
+ input file and then begin loading once it finds a line not in the database.
+ =item chunkSize
+ Number of lines to load in each burst. The default is 10,000.
  =back
  =cut
-Line 438
+Line 388
      # Get the parameters.
      my ($self, $fileName, %options) = @_;
      # Declare the return variable.
-     my $retVal = Stats->new('keys', 'values');
+     my $retVal = Stats->new('keys', 'values', 'linesOut');
+     # Initialize the timers.
+     my ($eraseTime, $archiveTime, $checkTime) = (0, 0, 0);
      # Check for append mode.
      my $append = ($options{append} ? 1 : 0);
+     # Check for resume mode.
+     my $resume = (defined($options{resume}) ? $options{resume} : 'none');
      # Create a hash of key names found.
      my %keyHash = ();
+     # Create a hash of table names to files. Most attributes go into the HasValueFor
+     # table, but some are put into other tables. Each table name will be mapped
+     # to a sub-hash with keys "fileName" (output file for the table) and "count"
+     # (number of lines in the file).
+     my %tableHash = ();
+     # Compute the chunk size.
+     my $chunkSize = ($options{chunkSize} ? $options{chunkSize} : 10000);
      # Open the file for input. Note we must anticipate the possibility of an
-     # open filehandle being passed in.
+     # open filehandle being passed in. This occurs when the user is submitting
+     # the load file over the web.
      my $fh;
      if (ref $fileName) {
          Trace("Using file opened by caller.") if T(3);
-Line 453
+Line 415
          Trace("Attributes will be loaded from $fileName.") if T(3);
          $fh = Open(undef, "<$fileName");
      }
+     # Trace the mode.
+     if (T(3)) {
+         if ($options{mode}) {
+             Trace("Mode is $options{mode}.")
+         } else {
+             Trace("No mode specified.")
+         }
+     }
      # Now check to see if we need to archive.
      my $ah;
-     if ($options{archive}) {
+     if (exists $options{archive}) {
-         $ah = Open(undef, ">$options{archive}");
+         my $ah = Open(undef, ">$options{archive}");
          Trace("Load file will be archived to $options{archive}.") if T(3);
      }
-     # Finally, open a database transaction.
+     # Insure we recover from errors.
-     $self->BeginTran();
-     # Insure we recover from errors. If an error occurs, we will delete the archive file and
-     # roll back the updates.
      eval {
+         # If we have a resume number, process it here.
+         if ($resume =~ /\d+/) {
+             Trace("Skipping $resume lines.") if T(2);
+             my $startTime = time();
+             # Skip the specified number of lines.
+             for (my $skipped = 0; ! eof($fh) && $skipped < $resume; $skipped++) {
+                 my $line = <$fh>;
+                 $retVal->Add(skipped => 1);
+             }
+             $checkTime += time() - $startTime;
+         }
          # Loop through the file.
+         Trace("Starting load.") if T(2);
          while (! eof $fh) {
              # Read the current line.
              my ($id, $key, @values) = Tracer::GetLine($fh);
              $retVal->Add(linesIn => 1);
-             # Check to see if we need to fix up the object ID.
-             if ($options{objectType}) {
-                 $id = "$options{objectType}:$id";
-             }
-             # Archive the line (if necessary).
-             if (defined $ah) {
-                 Tracer::PutLine($ah, [$id, $key, @values]);
-             }
              # Do some validation.
              if (! $id) {
                  # We ignore blank lines.
-Line 494
+Line 465
                  Trace("Line $lines for key $key has no attribute values.") if T(1);
                  $retVal->Add(skipped => 1);
              } else {
+                 # Check to see if we need to fix up the object ID.
+                 if ($options{objectType}) {
+                     $id = "$options{objectType}:$id";
+                 }
                  # The key contains a real part and an optional sub-part. We need the real part.
                  my ($realKey, $subKey) = $self->SplitKey($key);
                  # Now we need to check for a new key.
                  if (! exists $keyHash{$realKey}) {
-                     if (! $self->Exists('AttributeKey', $realKey)) {
+                     my $keyObject = $self->GetEntity(AttributeKey => $realKey);
+                     if (! defined($keyObject)) {
+                         # Here the specified key does not exist, which is an error.
                          my $line = $retVal->Ask('linesIn');
                          Confess("Attribute \"$realKey\" on line $line of $fileName not found in database.");
                      } else {
-                         # Make sure we know this is no longer a new key.
+                         # Make sure we know this is no longer a new key. We do this by putting
-                         $keyHash{$realKey} = 1;
+                         # its table name in the key hash.
+                         $keyHash{$realKey} = $keyObject->PrimaryValue('AttributeKey(relationship-name)');
                          $retVal->Add(keys => 1);
-                         # If this is NOT append mode, erase the key.
+                         # If this is NOT append mode, erase the key. This does not delete the key
+                         # itself; it just clears out all the values.
                          if (! $append) {
+                             my $startTime = time();
                              $self->EraseAttribute($realKey);
+                             $eraseTime += time() - $startTime;
+                             Trace("Attribute $realKey erased.") if T(3);
                          }
                      }
                      Trace("Key $realKey found.") if T(3);
                  }
-                 # Everything is all set up, so add the value.
+                 # If we're in resume mode, check to see if this insert is redundant.
-                 $self->AddAttribute($id, $key, @values);
+                 my $ok = 1;
-                 my $progress = $retVal->Add(values => 1);
+                 if ($resume ne 'none') {
-                 Trace("$progress values loaded.") if T(3) && ($progress % 1000 == 0);
+                     my $startTime = time();
+                     my $count = $self->GetAttributes($id, $key, @values);
+                     if ($count) {
+                         # Here the record is found, so we skip it.
+                         $ok = 0;
+                         $retVal->Add(skipped => 1);
+                     } else {
+                         # Here the record is not found. If we're in non-careful mode, we
+                         # stop resume checking at this point.
+                         if ($resume ne 'careful') {
+                             $resume = 'none';
+                         }
              }
+                     $checkTime += time() - $startTime;
          }
+                 if ($ok) {
+                     # We're in business. First, archive this row.
+                     if (defined $ah) {
+                         my $startTime = time();
+                         Tracer::PutLine($ah, [$id, $key, @values]);
+                         $archiveTime += time() - $startTime;
+                     }
+                     # We need to format the attribute data so it will work
+                     # as if it were a load file. This means we join the
+                     # values.
+                     my $valueString = join('::', @values);
+                     # Now we need to get access to the key's load file. Check for it in the
+                     # table hash.
+                     my $keyTable = $keyHash{$realKey};
+                     if (! exists $tableHash{$keyTable}) {
+                         # This is a new table, so we need to set it up. First, we get
+                         # a temporary file for it.
+                         my $tempFileName = FIGRules::GetTempFileName(sessionID => $$ . $keyTable,
+                                                                      extension => 'dtx');
+                         my $oh = Open(undef, ">$tempFileName");
+                         # Now we create its descriptor in the table hash.
+                         $tableHash{$keyTable} = {fileName => $tempFileName, handle => $oh, count => 0};
+                     }
+                     # Everything is all set up, so we put the value in the temporary file and
+                     # count it.
+                     my $tableData = $tableHash{$keyTable};
+                     my $startTime = time();
+                     Tracer::PutLine($tableData->{handle}, [$realKey, $id, $subKey, $valueString]);
+                     $archiveTime += time() - $startTime;
+                     $retVal->Add(linesOut => 1);
+                     $tableData->{count}++;
+                     # See if it's time to load a chunk.
+                     if ($tableData->{count} >= $chunkSize) {
+                         # We've filled a chunk, so it's time.
+                         close $tableData->{handle};
+                         $self->_LoadAttributeTable($keyTable, $tableData->{fileName}, $retVal);
+                         # Reset for the next chunk.
+                         $tableData->{count} = 0;
+                         $tableData->{handle} = Open(undef, ">$tableData->{fileName}");
+                     }
+                 } else {
+                     # Here we skipped because of resume mode.
+                     $retVal->Add(resumeSkip => 1);
+                 }
+                 Trace($retVal->Ask('values') . " values processed.") if $retVal->Check(values => 1000) && T(3);
+             }
+         }
+         # Now we close the archive file. Note we undefine the handle so the error methods know
+         # not to worry.
+         if (defined $ah) {
+             close $ah;
+             undef $ah;
+         }
+         # Now we load the residual from the temporary files (if any). This time we'll do an
+         # analyze as well.
+         for my $tableName (keys %tableHash) {
+             # Get the data for this table.
+             my $tableData = $tableHash{$tableName};
+             # Close the handle. ERDB will re-open it for input later.
+             close $tableData->{handle};
+             # Check to see if there's anything left to load.
+             if ($tableData->{count} > 0) {
+                 # Yes, load the data.
+                 $self->_LoadAttributeTable($tableName, $tableData->{fileName}, $retVal);
+             }
+             # Regardless of whether additional loading was required, we need to
+             # analyze the table for performance.
+             my $startTime = time();
+             $self->Analyze($tableName);
+             $retVal->Add(analyzeTime => time() - $startTime);
+         }
+         Trace("Attribute load successful.") if T(2);
      };
      # Check for an error.
      if ($@) {
-         # Here we have an error. Roll back the transaction and delete the archive file.
+         # Here we have an error. Display the error message.
          my $message = $@;
-         Trace("Rolling back attribute updates due to error.") if T(1);
+         Trace("Error during attribute load: $message") if T(0);
-         $self->RollbackTran();
+         $retVal->AddMessage($message);
-         if (defined $ah) {
+         # Close the archive file if it's open. The archive file can sometimes provide
-             Trace("Deleting archive file $options{archive}.") if T(1);
+         # clues as to what happened.
-             close $ah;
-             unlink $options{archive};
-         }
-         Confess("Error during attribute load: $message");
-     } else {
-         # Here the load worked. Commit the transaction and close the archive file.
-         Trace("Committing attribute upload.") if T(2);
-         $self->CommitTran();
          if (defined $ah) {
-             Trace("Closing archive file $options{archive}.") if T(2);
              close $ah;
          }
      }
+     # Store the timers.
+     $retVal->Add(eraseTime   => $eraseTime);
+     $retVal->Add(archiveTime => $archiveTime);
+     $retVal->Add(checkTime   => $checkTime);
      # Return the result.
      return $retVal;
  }
  =head3 BackupKeys
- C<< my $stats = $attrDB->BackupKeys($fileName, %options); >>
+     my $stats = $attrDB->BackupKeys($fileName, %options);
  Backup the attribute key information from the attribute database.
-Line 586
+Line 647
      while (my $keyData = $keyQuery->Fetch()) {
          $retVal->Add(key => 1);
          # Get the fields.
-         my ($id, $type, $description) = $keyData->Values(['AttributeKey(id)', 'AttributeKey(data-type)',
+         my ($id, $type, $tableName, $description) =
+             $keyData->Values(['AttributeKey(id)', 'AttributeKey(relationship-name)',
                                                            'AttributeKey(description)']);
          # Escape any tabs or new-lines in the description.
          my $escapedDescription = Tracer::Escape($description);
          # Write the key data to the output.
-         Tracer::PutLine($fh, [$id, $type, $escapedDescription]);
+         Tracer::PutLine($fh, [$id, $type, $tableName, $escapedDescription]);
          # Get the key's groups.
          my @groups = $self->GetFlat(['IsInGroup'], "IsInGroup(from-link) = ?", [$id],
                                      'IsInGroup(to-link)');
-Line 608
+Line 670
  =head3 RestoreKeys
- C<< my $stats = $attrDB->RestoreKeys($fileName, %options); >>
+     my $stats = $attrDB->RestoreKeys($fileName, %options);
  Restore the attribute keys and groups from a backup file.
-Line 635
+Line 697
      # Loop until we're done.
      while (! eof $fh) {
          # Get a key record.
-         my ($id, $dataType, $description) = Tracer::GetLine($fh);
+         my ($id, $tableName, $description) = Tracer::GetLine($fh);
          if ($id eq '#GROUPS') {
              Confess("Group record found when key record expected.");
          } elsif (! defined($description)) {
-Line 643
+Line 705
          } else {
              $retVal->Add("keyIn" => 1);
              # Add this key to the database.
-             $self->InsertObject('AttributeKey', { id => $id, 'data-type' => $dataType,
+             $self->InsertObject('AttributeKey', { id => $id,
-                                                   description => Tracer::UnEscape($description) });
+                                                   description => Tracer::UnEscape($description),
+                                                   'relationship-name' => $tableName});
              Trace("Attribute $id stored.") if T(3);
              # Get the group line.
              my ($marker, @groups) = Tracer::GetLine($fh);
-Line 680
+Line 743
  =head3 ArchiveFileName
- C<< my $fileName = $ca->ArchiveFileName(); >>
+     my $fileName = $ca->ArchiveFileName();
  Compute a file name for archiving attribute input data. The file will be in the attribute log directory
-Line 713
+Line 776
  =head3 BackupAllAttributes
- C<< my $stats = $attrDB->BackupAllAttributes($fileName, %options); >>
+     my $stats = $attrDB->BackupAllAttributes($fileName, %options);
  Backup all of the attributes to a file. The attributes will be stored in a
  tab-delimited file suitable for reloading via L</LoadAttributesFrom>.
-Line 744
+Line 807
      # Declare the return variable.
      my $retVal = Stats->new();
      # Get a list of the keys.
-     my @keys = $self->GetFlat(['AttributeKey'], "", [], 'AttributeKey(id)');
+     my %keys = map { $_->[0] => $_->[1] } $self->GetAll(['AttributeKey'],
-     Trace(scalar(@keys) . " keys found during backup.") if T(2);
+                                                         "", [], ['AttributeKey(id)',
+                                                                   'AttributeKey(relationship-name)']);
+     Trace(scalar(keys %keys) . " keys found during backup.") if T(2);
      # Open the file for output.
      my $fh = Open(undef, ">$fileName");
      # Loop through the keys.
-     for my $key (@keys) {
+     for my $key (sort keys %keys) {
          Trace("Backing up attribute $key.") if T(3);
          $retVal->Add(keys => 1);
+         # Get the key's relevant relationship name.
+         my $relName = $keys{$key};
          # Loop through this key's values.
-         my $query = $self->Get(['HasValueFor'], "HasValueFor(from-link) = ?", [$key]);
+         my $query = $self->Get([$relName], "$relName(from-link) = ?", [$key]);
          my $valuesFound = 0;
          while (my $line = $query->Fetch()) {
              $valuesFound++;
              # Get this row's data.
-             my ($id, $key, $subKey, $value) = $line->Values(['HasValueFor(to-link)',
+             my ($id, $key, $subKey, $value) = $line->Values(["$relName(to-link)",
-                                                              'HasValueFor(from-link)',
+                                                              "$relName(from-link)",
-                                                              'HasValueFor(subkey)',
+                                                              "$relName(subkey)",
-                                                              'HasValueFor(value)']);
+                                                              "$relName(value)"]);
              # Check for a subkey.
              if ($subKey ne '') {
                  $key = "$key$self->{splitter}$subKey";
              }
              # Write it to the file.
-             Tracer::PutLine($fh, [$id, $key, $value]);
+             Tracer::PutLine($fh, [$id, $key, Escape($value)]);
          }
          Trace("$valuesFound values backed up for key $key.") if T(3);
          $retVal->Add(values => $valuesFound);
-Line 778
+Line 845
      return $retVal;
  }
- =head3 FieldMenu
- C<< my $menuHtml = $attrDB->FieldMenu($cgi, $height, $name, $keys, %options); >>
- Return the HTML for a menu to select an attribute field. The menu will
- be a standard SELECT/OPTION thing which is called "popup menu" in the
- CGI package, but actually looks like a list. The list will contain
- one selectable row per field.
- =over 4
- =item cgi
- CGI query object used to generate HTML.
- =item height
- Number of lines to display in the list.
- =item name
- Name to give to the menu. This is the name under which the value will
- appear when the form is submitted.
- =item keys
- Reference to a hash mapping each attribute key name to a list reference,
- the list itself consisting of the attribute data type, its description,
- and a list of its groups.
- =item options
- Hash containing options that modify the generation of the menu.
- =item RETURN
- Returns the HTML to create a form field that can be used to select an
- attribute from the custom attributes system.
- =back
- The permissible options are as follows.
- =over 4
- =item new
- If TRUE, then extra rows will be provided to allow the user to select
- a new attribute. In other words, the user can select an existing
- attribute, or can choose a C<(new)> marker to indicate a field to
- be created in the parent entity.
- =item notes
- If specified, the name of a variable for displaying the notes attached
- to the field. This must be in Javascript form ready for assignment.
- So, for example, if you have a variable called C<notes> that
- represents a paragraph element, you should code C<notes.innerHTML>.
- If it actually represents a form field you should code C<notes.value>.
- If an C<innerHTML> coding is used, the text will be HTML-escaped before
- it is copied in. Specifying this parameter generates Javascript for
- displaying the field description when a field is selected.
- =item type
- If specified, the name of a variable for displaying the field's
- data type. Data types are a much more controlled vocabulary than
- notes, so there is no worry about HTML translation. Instead, the
- raw value is put into the specified variable. Otherwise, the same
- rules apply to this value that apply to I<$noteControl>.
- =item groups
- If specified, the name of a multiple-selection list control (also called
- a popup menu) which shall be used to display the selected groups.
- =back
- =cut
- sub FieldMenu {
-     # Get the parameters.
-     my ($self, $cgi, $height, $name, $keys, %options) = @_;
-     # Reformat the list of keys.
-     my %keys = %{$keys};
-     # Add the (new) key, if needed.
-     if ($options{new}) {
-         $keys{NewName()} = ["string", ""];
-     }
-     # Get a sorted list of key.
-     my @keys = sort keys %keys;
-     # We need to create the name for the onChange function. This function
-     # may not do anything, but we need to know the name to generate the HTML
-     # for the menu.
-     my $changeName = "${name}_setNotes";
-     my $retVal = $cgi->popup_menu({name => $name,
-                                    size => $height,
-                                    onChange => "$changeName(this.value)",
-                                    values => \@keys,
-                                   });
-     # Create the change function.
-     $retVal .= "\n<script language=\"javascript\">\n";
-     $retVal .= "    function $changeName(fieldValue) {\n";
-     # The function only has a body if we have a control to store data about the
-     # attribute.
-     if ($options{notes} || $options{type} || $options{groups}) {
-         # Check to see if we're storing HTML or text into the note control.
-         my $noteControl = $options{notes};
-         my $htmlMode = ($noteControl && $noteControl =~ /innerHTML$/);
-         # We use a CASE statement based on the newly-selected field value. The
-         # field description will be stored in the JavaScript variable "myText"
-         # and the data type in "myType". Note the default data type is a normal
-         # string, but the default notes is an empty string.
-         $retVal .= "        var myText = \"\";\n";
-         $retVal .= "        var myType = \"string\";\n";
-         $retVal .= "        switch (fieldValue) {\n";
-         # Loop through the keys.
-         for my $key (@keys) {
-             # Generate this case.
-             $retVal .= "        case \"$key\" :\n";
-             # Here we either want to update the note display, the
-             # type display, the group list, or a combination of them.
-             my ($type, $notes, @groups) = @{$keys{$key}};
-             if ($noteControl) {
-                 # Insure it's in the proper form.
-                 if ($htmlMode) {
-                     $notes = ERDB::HTMLNote($notes);
-                 }
-                 # Escape it for use as a string literal.
-                 $notes =~ s/\n/\\n/g;
-                 $notes =~ s/"/\\"/g;
-                 $retVal .= "           myText = \"$notes\";\n";
-             }
-             if ($options{type}) {
-                 # Here we want the type updated.
-                 $retVal .= "           myType = \"$type\";\n";
-             }
-             if ($options{groups}) {
-                 # Here we want the groups shown. Get a list of this attribute's groups.
-                 # We'll search through this list for each group to see if it belongs with
-                 # our attribute.
-                 my $groupLiteral = "=" . join("=", @groups) . "=";
-                 # Now we need some variables containing useful code for the javascript. It's
-                 # worth knowing we go through a bit of pain to insure $groupField[i] isn't
-                 # parsed as an array element.
-                 my $groupField = $options{groups};
-                 my $currentField = $groupField . "[i]";
-                 # Do the javascript.
-                 $retVal .= "           var groupList = \"$groupLiteral\";\n";
-                 $retVal .= "           for (var i = 0; i < $groupField.length; i++) {\n";
-                 $retVal .= "              var srchString = \"=\" + $currentField.value + \"=\";\n";
-                 $retVal .= "              var srchLoc = groupList.indexOf(srchString);\n";
-                 $retVal .= "              $currentField.checked = (srchLoc >= 0);\n";
-                 $retVal .= "           }\n";
-             }
-             # Close this case.
-             $retVal .= "           break;\n";
-         }
-         # Close the CASE statement and make the appropriate assignments.
-         $retVal .= "        }\n";
-         if ($noteControl) {
-             $retVal .= "        $noteControl = myText;\n";
-         }
-         if ($options{type}) {
-             $retVal .= "        $options{type} = myType;\n";
-         }
-     }
-     # Terminate the change function.
-     $retVal .= "    }\n";
-     $retVal .= "</script>\n";
-     # Return the result.
-     return $retVal;
- }
  =head3 GetGroups
- C<< my @groups = $attrDB->GetGroups(); >>
+     my @groups = $attrDB->GetGroups();
  Return a list of the available groups.
-Line 971
+Line 865
  =head3 GetAttributeData
- C<< my %keys = $attrDB->GetAttributeData($type, @list); >>
+     my %keys = $attrDB->GetAttributeData($type, @list);
  Return attribute data for the selected attributes. The attribute
  data is a hash mapping each attribute key name to a n-tuple containing the
- data type, the description, and the groups. This is the same format expected in
+ data type, the description, the table name, and the groups.
- the L</FieldMenu> and L</ControlForm> methods for the list of attributes to display.
  =over 4
-Line 991
+Line 884
  =item RETURN
- Returns a hash mapping each attribute key name to its data type, description, and
+ Returns a hash mapping each attribute key name to its description,
- parent groups.
+ table name, and parent groups.
  =back
-Line 1024
+Line 917
          }
          while (my $row = $query->Fetch()) {
              # Get this attribute's data.
-             my ($key, $type, $notes) = $row->Values(['AttributeKey(id)', 'AttributeKey(data-type)',
+             my ($key, $relName, $notes) = $row->Values(['AttributeKey(id)',
+                                                      'AttributeKey(relationship-name)',
                                                       'AttributeKey(description)']);
              # If it's new, get its groups and add it to the return hash.
              if (! exists $retVal{$key}) {
                  my @groups = $self->GetFlat(['IsInGroup'], "IsInGroup(from-link) = ?",
                                              [$key], 'IsInGroup(to-link)');
-                 $retVal{$key} = [$type, $notes, @groups];
+                 $retVal{$key} = [$relName, $notes, @groups];
              }
          }
      }
-Line 1040
+Line 934
  =head3 LogOperation
- C<< $ca->LogOperation($action, $target, $description); >>
+     $ca->LogOperation($action, $target, $description);
  Write an operation description to the attribute activity log (C<$FIG_Config::var/attributes.log>).
-Line 1077
+Line 971
      close $oh;
  }
- =head2 Internal Utility Methods
- =head3 _KeywordString
- C<< my $keywordString = $ca->_KeywordString($key, $value); >>
- Compute the keyword string for a specified key/value pair. This consists of the
- key name and value converted to lower case with underscores translated to spaces.
- This method is for internal use only. It is called whenever we need to update or
- insert a B<HasValueFor> record.
- =over 4
- =item key
- Name of the relevant attribute key.
- =item target
- ID of the target object to which this key/value pair will be associated.
- =item value
- The value to store for this key/object combination.
- =item RETURN
- Returns the value that should be stored as the keyword string for the specified
- key/value pair.
- =back
- =cut
- sub _KeywordString {
-     # Get the parameters.
-     my ($self, $key, $value) = @_;
-     # Get a copy of the key name and convert underscores to spaces.
-     my $keywordString = $key;
-     $keywordString =~ s/_/ /g;
-     # Add the value convert it all to lower case.
-     my $retVal = lc "$keywordString $value";
-     # Return the result.
-     return $retVal;
- }
- =head3 _QueryResults
- C<< my @attributeList = $attrDB->_QueryResults($query, @values); >>
- Match the results of a B<HasValueFor> query against value criteria and return
- the results. This is an internal method that splits the values coming back
- and matches the sections against the specified section patterns. It serves
- as the back end to L</GetAttributes> and L</FindAttributes>.
- =over 4
- =item query
- A query object that will return the desired B<HasValueFor> records.
- =item values
- List of the desired attribute values, section by section. If C<undef>
- or an empty string is specified, all values in that section will match. A
- generic match can be requested by placing a percent sign (C<%>) at the end.
- In that case, all values that match up to and not including the percent sign
- will match. You may also specify a regular expression enclosed
- in slashes. All values that match the regular expression will be returned. For
- performance reasons, only values have this extra capability.
- =item RETURN
- Returns a list of tuples. The first element in the tuple is an object ID, the
- second is an attribute key, and the remaining elements are the sections of
- the attribute value. All of the tuples will match the criteria set forth in
- the parameter list.
- =back
- =cut
- sub _QueryResults {
-     # Get the parameters.
-     my ($self, $query, @values) = @_;
-     # Declare the return value.
-     my @retVal = ();
-     # Get the number of value sections we have to match.
-     my $sectionCount = scalar(@values);
-     # Loop through the assignments found.
-     while (my $row = $query->Fetch()) {
-         # Get the current row's data.
-         my ($id, $realKey, $subKey, $valueString) = $row->Values(['HasValueFor(to-link)',
-                                                                   'HasValueFor(from-link)',
-                                                                   'HasValueFor(subkey)',
-                                                                   'HasValueFor(value)'
-                                                                 ]);
-         # Form the key from the real key and the sub key.
-         my $key = $self->JoinKey($realKey, $subKey);
-         # Break the value into sections.
-         my @sections = split($self->{splitter}, $valueString);
-         # Match each section against the incoming values. We'll assume we're
-         # okay unless we learn otherwise.
-         my $matching = 1;
-         for (my $i = 0; $i < $sectionCount && $matching; $i++) {
-             # We need to check to see if this section is generic.
-             my $value = $values[$i];
-             Trace("Current value pattern is \"$value\".") if T(4);
-             if (substr($value, -1, 1) eq '%') {
-                 Trace("Generic match used.") if T(4);
-                 # Here we have a generic match.
-                 my $matchLen = length($values[$i]) - 1;
-                 $matching = substr($sections[$i], 0, $matchLen) eq
-                             substr($values[$i], 0, $matchLen);
-             } elsif ($value =~ m#^/(.+)/[a-z]*$#) {
-                 Trace("Regular expression detected.") if T(4);
-                 # Here we have a regular expression match.
-                 my $section = $sections[$i];
-                 $matching = eval("\$section =~ $value");
-             } else {
-                 # Here we have a strict match.
-                 Trace("Strict match used.") if T(4);
-                 $matching = ($sections[$i] eq $values[$i]);
-             }
-         }
-         # If we match, output this row to the return list.
-         if ($matching) {
-             push @retVal, [$id, $key, @sections];
-         }
-     }
-     # Return the rows found.
-     return @retVal;
- }
  =head2 FIG Method Replacements
  The following methods are used by B<FIG.pm> to replace the previous attribute functionality.
-Line 1239
+Line 998
  =head3 GetAttributes
- C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @values); >>
+     my @attributeList = $attrDB->GetAttributes($objectID, $key, @values);
  In the database, attribute values are sectioned into pieces using a splitter
  value specified in the constructor (L</new>). This is not a requirement of
-Line 1324
+Line 1083
  sub GetAttributes {
      # Get the parameters.
      my ($self, $objectID, $key, @values) = @_;
-     # This hash will map "HasValueFor" fields to patterns. We use it to build the
+     # This hash will map value-table fields to patterns. We use it to build the
      # SQL statement.
      my %data;
-     # Before we do anything else, we must parse the key. The key is treated by the
-     # user as a single field, but to us it's actually a real key and a subkey.
-     # If the key has no splitter and is exact, the real key is the original key
-     # and the subkey is an empty string. If the key has a splitter, it is
-     # split into two pieces and each piece is processed separately. If the key has
-     # no splitter and is generic, the real key is the incoming key and the subkey
-     # is allowed to be wild. Of course, this only matters if an actual key has
-     # been specified.
-     if (defined $key) {
-         if ($key =~ /$self->{splitter}/) {
-             # Here we have a two-part key, so we split it normally.
-             my ($realKey, $subKey) = $self->SplitKey($key);
-             $data{'HasValueFor(from-link)'} = $realKey;
-             $data{'HasValueFor(subkey)'} = $subKey;
-         } elsif (substr($key, -1, 1) eq '%') {
-             $data{'HasValueFor(from-link)'} = $key;
-         } else {
-             $data{'HasValueFor(from-link)'} = $key;
-             $data{'HasValueFor(subkey)'} = '';
-         }
-     }
      # Add the object ID to the key information.
-     $data{'HasValueFor(to-link)'} = $objectID;
+     $data{'to-link'} = $objectID;
      # The first value represents a problem, because we can search it using SQL, but not
      # in the normal way. If the user specifies a generic search or exact match for
      # every alternative value (remember, the values may be specified as a list),
-Line 1386
+Line 1124
          }
          # If everything works, add the value data to the filtering hash.
          if ($okValues) {
-             $data{'HasValueFor(value)'} = \@valuePatterns;
+             $data{value} = \@valuePatterns;
+         }
+     }
+     # Now comes the really tricky part, which is key handling. The key is
+     # actually split in two parts: the real key and a sub-key. The real key
+     # determines which value table contains the relevant values. The information
+     # we need is kept in here.
+     my %tables = map { $_ => [] } $self->_GetAllTables();
+     # See if we have any key filtering to worry about.
+     if ($key) {
+         # Here we have either a single key or a list. We convert both cases to a list.
+         my $keyList = (ref $key ne 'ARRAY' ? [$key] : $key);
+         # Get easy access to the key/table hash.
+         my $keyTableHash = $self->_KeyTable();
+         # Loop through the keys, discovering tables.
+         for my $keyChoice (@$keyList) {
+             # Now we have to start thinking about the real key and the subkeys.
+             my ($realKey, $subKey) = $self->_SplitKeyPattern($keyChoice);
+             # Find the matches for the real key in the key hash. For each of
+             # these, we memorize the table name in the hash below.
+             my %tableNames = ();
+             for my $keyInTable (keys %{$keyTableHash}) {
+                 if ($self->_CheckSQLPattern($realKey, $keyInTable)) {
+                     $tableNames{$keyTableHash->{$key}} = 1;
+                 }
+             }
+             # If the key is generic, or didn't match anything, add
+             # the default table to the mix.
+             if (keys %tableNames == 0 || $keyChoice =~ /%/) {
+                 $tableNames{$self->{defaultRel}} = 1;
+             }
+             # Now we add this key combination to the key list for each relevant table.
+             for my $tableName (keys %tableNames) {
+                 push @{$tables{$tableName}}, [$realKey, $subKey];
          }
      }
+     }
+     # Declare the return variable.
+     my @retVal = ();
+     # Now we loop through the tables of interest, performing queries.
+     # Loop through the tables.
+     for my $table (keys %tables) {
+         # Get the key pairs for this table.
+         my $pairs = $tables{$table};
+         # Does this table have data? It does if there is no key specified or
+         # it has at least one key pair.
+         my $pairCount = scalar @{$pairs};
+         Trace("Pair count for table $table is $pairCount.") if T(3);
+         if ($pairCount || ! $key) {
      # Create some lists to contain the filter fragments and parameter values.
      my @filter = ();
      my @parms = ();
      # This next loop goes through the different fields that can be specified in the
      # parameter list and generates filters for each. The %data hash that we built above
-     # contains all the necessary information to do this.
+             # contains most of the necessary information to do this. When we're done, we'll
+             # paste on stuff for the key pairs.
      for my $field (keys %data) {
          # Accumulate filter information for this field. We will OR together all the
          # elements accumulated to create the final result.
          my @fieldFilter = ();
-         # Get the specified data from the caller.
+                 # Get the specified filter for this field.
          my $fieldPattern = $data{$field};
          # Only proceed if the pattern is one that won't match everything.
          if (defined($fieldPattern) && $fieldPattern ne "" && $fieldPattern ne "%") {
-Line 1416
+Line 1201
              if (@patterns) {
                  # Loop through the individual patterns.
                  for my $pattern (@patterns) {
-                     # Check for a generic request.
+                             my ($clause, $value) = _WherePart($table, $field, $pattern);
-                     if (substr($pattern, -1, 1) ne '%') {
+                             push @fieldFilter, $clause;
-                         # Here we have a normal request.
+                             push @parms, $value;
-                         push @fieldFilter, "$field = ?";
-                         push @parms, $pattern;
-                     } else {
-                         # Here we have a generic request, so we will use the LIKE operator to
-                         # filter the field to this value pattern.
-                         push @fieldFilter, "$field LIKE ?";
-                         # We must convert the pattern value to an SQL match pattern. First
-                         # we get a copy of it.
-                         my $actualPattern = $pattern;
-                         # Now we escape the underscores. Underscores are an SQL wild card
-                         # character, but they are used frequently in key names and object IDs.
-                         $actualPattern =~ s/_/\\_/g;
-                         # Add the escaped pattern to the bound parameter list.
-                         push @parms, $actualPattern;
-                     }
                  }
                  # Form the filter for this field.
                  my $fieldFilterString = join(" OR ", @fieldFilter);
-Line 1441
+Line 1211
              }
          }
      }
-     # Now @filter contains one or more filter strings and @parms contains the parameter
+             # The final filter is for the key pairs. Only proceed if we have some.
-     # values to bind to them.
+             if ($pairCount) {
+                 # We'll accumulate pair filter clauses in here.
+                 my @pairFilters = ();
+                 # Loop through the key pairs.
+                 for my $pair (@$pairs) {
+                     my ($realKey, $subKey) = @{$pair};
+                     my ($realClause, $realValue) = _WherePart($table, 'from-link', $realKey);
+                     if (! $subKey) {
+                         # Here the subkey is wild, so only the real key matters.
+                         push @pairFilters, $realClause;
+                         push @parms, $realValue;
+                     } else {
+                         # Here we have to select on both keys.
+                         my ($subClause, $subValue) = _WherePart($table, 'subkey', $subKey);
+                         push @pairFilters, "($realClause AND $subClause)";
+                         push @parms, $subValue;
+                     }
+                 }
+                 # Join the pair filters together to make a giant key filter.
+                 my $pairFilter = "(" . join(" OR ", @pairFilters) . ")";
+                 push @filter, $pairFilter;
+             }
+             # At this point, @filter contains one or more filter strings and @parms
+             # contains the parameter values to bind to them.
      my $actualFilter = join(" AND ", @filter);
      # Now we're ready to make our query.
-     my $query = $self->Get(['HasValueFor'], $actualFilter, \@parms);
+             my $query = $self->Get([$table], $actualFilter, \@parms);
      # Format the results.
-     my @retVal = $self->_QueryResults($query, @values);
+             push @retVal, $self->_QueryResults($query, $table, @values);
-     # Return the rows found.
+         }
+     }
+     # The above loop ran the query for each necessary value table and merged the
+     # results into @retVal. Now we return the rows found.
      return @retVal;
  }
  =head3 AddAttribute
- C<< $attrDB->AddAttribute($objectID, $key, @values); >>
+     $attrDB->AddAttribute($objectID, $key, @values);
  Add an attribute key/value pair to an object. This method cannot add a new key, merely
  add a value to an existing key. Use L</StoreAttributeKey> to create a new key.
-Line 1495
+Line 1291
          my $valueString = join($self->{splitter}, @values);
          # Split up the key.
          my ($realKey, $subKey) = $self->SplitKey($key);
+         # Find the table containing the key.
+         my $table = $self->_KeyTable($realKey);
          # Connect the object to the key.
-         $self->InsertObject('HasValueFor', { 'from-link' => $realKey,
+         $self->InsertObject($table, { 'from-link' => $realKey,
                                               'to-link'   => $objectID,
                                               'subkey'    => $subKey,
                                               'value'     => $valueString,
-Line 1508
+Line 1306
  =head3 DeleteAttribute
- C<< $attrDB->DeleteAttribute($objectID, $key, @values); >>
+     $attrDB->DeleteAttribute($objectID, $key, @values);
  Delete the specified attribute key/value combination from the database.
-Line 1542
+Line 1340
      } else {
          # Split the key into the real key and the subkey.
          my ($realKey, $subKey) = $self->SplitKey($key);
+         # Find the table containing the key's values.
+         my $table = $self->_KeyTable($realKey);
          if ($subKey eq '' && scalar(@values) == 0) {
              # Here we erase the entire key for this object.
              $self->DeleteRow('HasValueFor', $key, $objectID);
-Line 1558
+Line 1358
  =head3 DeleteMatchingAttributes
- C<< my @deleted = $attrDB->DeleteMatchingAttributes($objectID, $key, @values); >>
+     my @deleted = $attrDB->DeleteMatchingAttributes($objectID, $key, @values);
  Delete all attributes that match the specified criteria. This is equivalent to
  calling L</GetAttributes> and then invoking L</DeleteAttribute> for each
-Line 1618
+Line 1418
  =head3 ChangeAttribute
- C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>
+     $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues);
  Change the value of an attribute key/value pair for an object.
-Line 1670
+Line 1470
  =head3 EraseAttribute
- C<< $attrDB->EraseAttribute($key); >>
+     $attrDB->EraseAttribute($key);
  Erase all values for the specified attribute key. This does not remove the
  key from the database; it merely removes all the values.
-Line 1689
+Line 1489
  sub EraseAttribute {
      # Get the parameters.
      my ($self, $key) = @_;
-     # Delete everything connected to the key.
+     # Find the table containing the key.
+     my $table = $self->_KeyTable($key);
+     # Is it the default table?
+     if ($table eq $self->{defaultRel}) {
+         # Yes, so the key is mixed in with other keys.
+         # Delete everything connected to it.
      $self->Disconnect('HasValueFor', 'AttributeKey', $key);
+     } else {
+         # No. Drop and re-create the table.
+         $self->TruncateTable($table);
+     }
      # Log the operation.
      $self->LogOperation("Erase Data", $key);
      # Return a 1, for backward compatability.
-Line 1699
+Line 1508
  =head3 GetAttributeKeys
- C<< my @keyList = $attrDB->GetAttributeKeys($groupName); >>
+     my @keyList = $attrDB->GetAttributeKeys($groupName);
  Return a list of the attribute keys for a particular group.
-Line 1727
+Line 1536
      return sort @groups;
  }
+ =head3 QueryAttributes
+     my @attributeData = $ca->QueryAttributes($filter, $filterParms);
+ Return the attribute data based on an SQL filter clause. In the filter clause,
+ the name C<$object> should be used for the object ID, C<$key> should be used for
+ the key name, C<$subkey> for the subkey value, and C<$value> for the value field.
+ =over 4
+ =item filter
+ Filter clause in the standard ERDB format, except that the field names are C<$object> for
+ the object ID field, C<$key> for the key name field, C<$subkey> for the subkey field,
+ and C<$value> for the value field. This abstraction enables us to hide the details of
+ the database construction from the user.
+ =item filterParms
+ Parameters for the filter clause.
+ =item RETURN
+ Returns a list of tuples. Each tuple consists of an object ID, a key (with optional subkey), and
+ one or more attribute values.
+ =back
+ =cut
+ # This hash is used to drive the substitution process.
+ my %AttributeParms = (object => 'to-link',
+                       key    => 'from-link',
+                       subkey => 'subkey',
+                       value  => 'value');
+ sub QueryAttributes {
+     # Get the parameters.
+     my ($self, $filter, $filterParms) = @_;
+     # Declare the return variable.
+     my @retVal = ();
+     # Make sue we have filter parameters.
+     my $realParms = (defined($filterParms) ? $filterParms : []);
+     # Loop through all the value tables.
+     for my $table ($self->_GetAllTables()) {
+         # Create the query for this table by converting the filter.
+         my $realFilter = $filter;
+         for my $name (keys %AttributeParms) {
+             $realFilter =~ s/\$$name/$table($AttributeParms{$name})/g;
+         }
+         my $query = $self->Get([$table], $realFilter, $realParms);
+         # Loop through the results, forming the output attribute tuples.
+         while (my $result = $query->Fetch()) {
+             # Get the four values from this query result row.
+             my ($objectID, $key, $subkey, $value) = $result->Values(["$table($AttributeParms{object})",
+                                                                     "$table($AttributeParms{key})",
+                                                                     "$table($AttributeParms{subkey})",
+                                                                     "$table($AttributeParms{value})"]);
+             # Combine the key and the subkey.
+             my $realKey = ($subkey ? $key . $self->{splitter} . $subkey : $key);
+             # Split the value.
+             my @values = split $self->{splitter}, $value;
+             # Output the result.
+             push @retVal, [$objectID, $realKey, @values];
+         }
+     }
+     # Return the result.
+     return @retVal;
+ }
  =head2 Key and ID Manipulation Methods
  =head3 ParseID
- C<< my ($type, $id) = CustomAttributes::ParseID($idValue); >>
+     my ($type, $id) = CustomAttributes::ParseID($idValue);
  Determine the type and object ID corresponding to an ID value from the attribute database.
  Most ID values consist of a type name and an ID, separated by a colon (e.g. C<Family:aclame|cluster10>);
-Line 1770
+Line 1649
      if ($idValue =~ /^([A-Za-z]+):(.+)/) {
          # Here we have a typed ID.
          ($type, $id) = ($1, $2);
+         # Fix the case sensitivity on PDB IDs.
+         if ($type eq 'PDB') { $id = lc $id; }
      } elsif ($idValue =~ /fig\|/) {
          # Here we have a feature ID.
          ($type, $id) = (Feature => $idValue);
-Line 1786
+Line 1667
  =head3 FormID
- C<< my $idValue = CustomAttributes::FormID($type, $id); >>
+     my $idValue = CustomAttributes::FormID($type, $id);
  Convert an object type and ID pair into an object ID string for the attribute system. Subsystems,
  genomes, and features are stored in the database without type information, but all other object IDs
-Line 1827
+Line 1708
  =head3 GetTargetObject
- C<< my $object = CustomAttributes::GetTargetObject($erdb, $idValue); >>
+     my $object = CustomAttributes::GetTargetObject($erdb, $idValue);
  Return the database object corresponding to the specified attribute object ID. The
  object type associated with the ID value must correspond to an entity name in the
-Line 1866
+Line 1747
  =head3 SplitKey
- C<< my ($realKey, $subKey) = $ca->SplitKey($key); >>
+     my ($realKey, $subKey) = $ca->SplitKey($key);
  Split an external key (that is, one passed in by a caller) into the real key and the sub key.
  The real and sub keys are separated by a splitter value (usually C<::>). If there is no splitter,
-Line 1900
+Line 1781
      return ($realKey, $subKey);
  }
  =head3 JoinKey
- C<< my $key = $ca->JoinKey($realKey, $subKey); >>
+     my $key = $ca->JoinKey($realKey, $subKey);
  Join a real key and a subkey together to make an external key. The external key is the attribute key
  used by the caller. The real key and the subkey are how the keys are represented in the database. The
-Line 1944
+Line 1826
      return $retVal;
  }
+ =head3 AttributeTable
+     my $tableHtml = CustomAttributes::AttributeTable($cgi, @attrList);
+ Format the attribute data into an HTML table.
+ =over 4
+ =item cgi
+ CGI query object used to generate the HTML
+ =item attrList
+ List of attribute results, in the format returned by the L</GetAttributes> or
+ L</QueryAttributes> methods.
+ =item RETURN
+ Returns an HTML table displaying the attribute keys and values.
+ =back
+ =cut
+ sub AttributeTable {
+     # Get the parameters.
+     my ($cgi, @attrList) = @_;
+     # Accumulate the table rows.
+     my @html = ();
+     for my $attrData (@attrList) {
+         # Format the object ID and key.
+         my @columns = map { CGI::escapeHTML($_) } @{$attrData}[0,1];
+         # Now we format the values. These remain unchanged unless one of them is a URL.
+         my $lastValue = scalar(@{$attrData}) - 1;
+         push @columns, map { $_ =~ /^http:/ ? $cgi->a({ href => $_ }, $_) : $_ } @{$attrData}[2 .. $lastValue];
+         # Assemble the values into a table row.
+         push @html, $cgi->Tr($cgi->td(\@columns));
+     }
+     # Format the table in the return variable.
+     my $retVal = $cgi->table({ border => 2 }, $cgi->Tr($cgi->th(['Object', 'Key', 'Values'])), @html);
+     # Return it.
+     return $retVal;
+ }
+ =head2 Internal Utility Methods
+ =head3 _KeyTable
+     my $tableName = $ca->_KeyTable($keyName);
+ Return the name of the table that contains the attribute values for the
+ specified key.
+ Most attribute values are stored in the default table (usually C<HasValueFor>).
+ Some, however, are placed in private tables by themselves for performance reasons.
+ =over 4
+ =item keyName (optional)
+ Name of the attribute key whose table name is desired. If not specified, the
+ entire key/table hash is returned.
+ =item RETURN
+ Returns the name of the table containing the specified attribute key's values,
+ or a reference to a hash that maps key names to table names.
+ =back
+ =cut
+ sub _KeyTable {
+     # Get the parameters.
+     my ($self, $keyName) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Insure the key table hash is present.
+     if (! exists $self->{keyTables}) {
+         $self->{keyTables} = { map { $_->[0] => $_->[1] } $self->GetAll(['AttributeKey'],
+                                                 "AttributeKey(relationship-name) <> ?",
+                                                 [$self->{defaultRel}],
+                                                 ['AttributeKey(id)', 'AttributeKey(relationship-name)']) };
+     }
+     # Get the key hash.
+     my $keyHash = $self->{keyTables};
+     # Does the user want a specific table or the whole thing?
+     if ($keyName) {
+         # Here we want a specific table. Is this key in the hash?
+         if (exists $keyHash->{$keyName}) {
+             # It's there, so return the specified table.
+             $retVal = $keyHash->{$keyName};
+         } else {
+             # No, return the default table name.
+             $retVal = $self->{defaultRel};
+         }
+     } else {
+         # Here we want the whole hash.
+         $retVal = $keyHash;
+     }
+     # Return the result.
+     return $retVal;
+ }
+ =head3 _QueryResults
+     my @attributeList = $attrDB->_QueryResults($query, $table, @values);
+ Match the results of a query against value criteria and return
+ the results. This is an internal method that splits the values coming back
+ and matches the sections against the specified section patterns. It serves
+ as the back end to L</GetAttributes> and L</FindAttributes>.
+ =over 4
+ =item query
+ A query object that will return the desired records.
+ =item table
+ Name of the value table for the query.
+ =item values
+ List of the desired attribute values, section by section. If C<undef>
+ or an empty string is specified, all values in that section will match. A
+ generic match can be requested by placing a percent sign (C<%>) at the end.
+ In that case, all values that match up to and not including the percent sign
+ will match. You may also specify a regular expression enclosed
+ in slashes. All values that match the regular expression will be returned. For
+ performance reasons, only values have this extra capability.
+ =item RETURN
+ Returns a list of tuples. The first element in the tuple is an object ID, the
+ second is an attribute key, and the remaining elements are the sections of
+ the attribute value. All of the tuples will match the criteria set forth in
+ the parameter list.
+ =back
+ =cut
+ sub _QueryResults {
+     # Get the parameters.
+     my ($self, $query, $table, @values) = @_;
+     # Declare the return value.
+     my @retVal = ();
+     # Get the number of value sections we have to match.
+     my $sectionCount = scalar(@values);
+     # Loop through the assignments found.
+     while (my $row = $query->Fetch()) {
+         # Get the current row's data.
+         my ($id, $realKey, $subKey, $valueString) = $row->Values(["$table(to-link)",
+                                                                   "$table(from-link)",
+                                                                   "$table(subkey)",
+                                                                   "$table(value)"
+                                                                 ]);
+         # Form the key from the real key and the sub key.
+         my $key = $self->JoinKey($realKey, $subKey);
+         # Break the value into sections.
+         my @sections = split($self->{splitter}, $valueString);
+         # Match each section against the incoming values. We'll assume we're
+         # okay unless we learn otherwise.
+         my $matching = 1;
+         for (my $i = 0; $i < $sectionCount && $matching; $i++) {
+             # We need to check to see if this section is generic.
+             my $value = $values[$i];
+             Trace("Current value pattern is \"$value\".") if T(4);
+             if ($value =~ m#^/(.+)/[a-z]*$#) {
+                 Trace("Regular expression detected.") if T(4);
+                 # Here we have a regular expression match.
+                 my $section = $sections[$i];
+                 $matching = eval("\$section =~ $value");
+             } else {
+                 # Here we have a normal match.
+                 Trace("SQL match used.") if T(4);
+                 $matching = _CheckSQLPattern($values[$i], $sections[$i]);
+             }
+         }
+         # If we match, output this row to the return list.
+         if ($matching) {
+             push @retVal, [$id, $key, @sections];
+         }
+     }
+     # Return the rows found.
+     return @retVal;
+ }
+ =head3 _LoadAttributeTable
+     $attr->_LoadAttributeTable($tableName, $fileName, $stats, $mode);
+ Load a file's data into an attribute table. This is an internal method
+ provided for the convenience of L</LoadAttributesFrom>. It loads the
+ specified file into the specified table and updates the statistics
+ object.
+ =over 4
+ =item tableName
+ Name of the table being loaded. This is usually C<HasValueFor>, but may
+ be a different table for some specific attribute keys.
+ =item fileName
+ Name of the file containing a chunk of attribute data to load.
+ =item stats
+ Statistics object into which counts and times should be placed.
+ =item mode
+ Load mode for the file, usually C<low_priority>, C<concurrent>, or
+ an empty string. The mode is used by some applications to control access
+ to the table while it's being loaded. The default (empty string) is to lock the
+ table until all the data's in place.
+ =back
+ =cut
+ sub _LoadAttributeTable {
+     # Get the parameters.
+     my ($self, $tableName, $fileName, $stats, $mode) = @_;
+     # Load the table from the file. Note that we don't do an analyze.
+     # The analyze is done only after everything is complete.
+     my $startTime = time();
+     Trace("Loading attributes from $fileName: " . (-s $fileName) .
+           " characters.") if T(3);
+     my $loadStats = $self->LoadTable($fileName, $tableName,
+                                      mode => $mode, partial => 1);
+     # Record the load time.
+     $stats->Add(insertTime => time() - $startTime);
+     # Roll up the other statistics.
+     $stats->Accumulate($loadStats);
+ }
+ =head3 _GetAllTables
+     my @tables = $ca->_GetAllTables();
+ Return a list of the names of all the tables used to store attribute
+ values.
+ =cut
+ sub _GetAllTables {
+     # Get the parameters.
+     my ($self) = @_;
+     # Start with the default table.
+     my @retVal = $self->{defaultRel};
+     # Add the tables named in the key hash. These tables are automatically
+     # NOT the default, and each can only occur once, because alternate tables
+     # are allocated on a per-key basis.
+     my $keyHash = $self->_KeyTable();
+     push @retVal, values %$keyHash;
+     # Return the result.
+     return @retVal;
+ }
+ =head3 _SplitKeyPattern
+     my ($realKey, $subKey) = $ca->_SplitKeyPattern($keyChoice);
+ Split a key pattern into the main part (the I<real key>) and a sub-part
+ (the I<sub key>). This method differs from L</SplitKey> in that it treats
+ the key as an SQL pattern instead of a raw string. Also, if there is no
+ incoming sub-part, the sub-key will be undefined instead of an empty
+ string.
+ =over 4
+ =item keyChoice
+ SQL key pattern to be examined. This can either be a literal, an SQL pattern,
+ a literal with an internal splitter code (usually C<::>) or an SQL pattern with
+ an internal splitter. Note that the only SQL pattern we support is a percent
+ sign (C<%>) at the end. This is the way we've declared things in the documentation,
+ so users who try anything else will have problems.
+ =item RETURN
+ Returns a two-element list. The first element is the SQL pattern for the
+ real key and the second is the SQL pattern for the sub-key. If the value
+ for either one does not matter (e.g., the user wants a real key value of
+ C<iedb> and doesn't care about the sub-key value), it will be undefined.
+ =back
+ =cut
+ sub _SplitKeyPattern {
+     # Get the parameters.
+     my ($self, $keyChoice) = @_;
+     # Declare the return variables.
+     my ($realKey, $subKey);
+     # Look for a splitter in the input.
+     if ($keyChoice =~ /^(.*?)$self->{splitter}(.*)/) {
+         # We found one. This means we can treat both sides of the
+         # splitter as known patterns.
+         ($realKey, $subKey) = ($1, $2);
+     } elsif ($keyChoice =~ /%$/) {
+         # Here we have a generic pattern for the whole key. The pattern
+         # is treated as the correct pattern for the real key, but the
+         # sub-key is considered to be wild.
+         $realKey = $keyChoice;
+     } else {
+         # Here we have a literal pattern for the whole key. The pattern
+         # is treated as the correct pattern for the real key, and the
+         # sub-key is required to be blank.
+         $realKey = $keyChoice;
+         $subKey = '';
+     }
+     # Return the results.
+     return ($realKey, $subKey);
+ }
+ =head3 _WherePart
+     my ($sqlClause, $escapedValue) = _WherePart($tableName, $fieldName, $sqlPattern);
+ Return the SQL clause and value for checking a field against the
+ specified SQL pattern value. If the pattern is generic (ends in a C<%>),
+ then a C<LIKE> expression is returned. Otherwise, an equality expression
+ is returned. We take in information describing the field being checked,
+ and the pattern we're checking against it. The output is a WHERE clause
+ fragment for the comparison and a value to be used as a bound parameter
+ value for the clause.
+ =over 4
+ =item tableName
+ Name of the table containing the field we want checked by the clause.
+ =item fieldName
+ Name of the field to check in that table.
+ =item sqlPattern
+ Pattern to be compared against the field. If the last character is a percent sign
+ (C<%>), it will be treated as a generic SQL pattern; otherwise, it will be treated
+ as a literal.
+ =item RETURN
+ Returns a two-element list. The first element will be an SQL comparison expression
+ and the second will be the value to be used as a bound parameter for the expression
+ in order to
+ =back
+ =cut
+ sub _WherePart {
+     # Get the parameters.
+     my ($tableName, $fieldName, $sqlPattern) = @_;
+     # Declare the return variables.
+     my ($sqlClause, $escapedValue);
+     # Copy the pattern into the return area.
+     $escapedValue = $sqlPattern;
+     # Check the pattern. Is it generic or exact?
+     if ($sqlPattern =~ /%$/) {
+         # Yes, it is. We need a LIKE clause and we must escape the underscores
+         # and percents in the pattern.
+         $escapedValue =~ s/(%|_)/\\$1/g;
+         $sqlClause = "$tableName($fieldName) LIKE ?";
+     } else {
+         # No, it isn't. We use an equality clause.
+         $sqlClause = "$tableName($fieldName) = ?";
+     }
+     # Return the results.
+     return ($sqlClause, $escapedValue);
+ }
+ =head3 _CheckSQLPattern
+     my $flag = _CheckSQLPattern($pattern, $value);
+ Return TRUE if the specified SQL pattern matches the specified value,
+ else FALSE. The pattern is not a true full-blown SQL LIKE pattern: the
+ only wild-carding allowed is a percent sign (C<%>) at the end.
+ =over 4
+ =item pattern
+ SQL pattern to match against a value.
+ =item value
+ Value to match against an SQL pattern.
+ =item RETURN
+ Returns TRUE if the pattern matches the value, else FALSE.
+ =back
+ =cut
+ sub _CheckSQLPattern {
+     # Get the parameters.
+     my ($pattern, $value) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Check for a generic pattern.
+     if ($pattern =~ /(.*)%$/) {
+         # Here we have one. Do a substring match.
+         $retVal = (substr($value, 0, length $1) eq $1);
+     } else {
+         # Here it's an exact match.
+         $retVal = ($pattern eq $value);
+     }
+     # Return the result.
+     return $retVal;
+ }
 ;

 Legend:



Removed from v.1.23
 


changed lines


 
Added in v.1.33
 Legend:



Removed from v.1.23
 


changed lines


 
Added in v.1.33
-Removed from v.1.23
+Added in v.1.33

MCS Webmaster	ViewVC Help
Powered by ViewVC 1.0.3