Diff of /Sprout/CustomAttributes.pm

-revision 1.1, Fri Nov  3 00:32:05 2006 UTC
+revision 1.35, Wed Sep  3 20:53:19 2008 UTC
 Line 4
      require Exporter;
      use ERDB;
-     @ISA = qw(Exporter ERDB);
+     @ISA = qw(ERDB);
      use strict;
      use Tracer;
-     use FIG;
      use ERDBLoad;
+     use Stats;
+     use Time::HiRes qw(time);
+     use FIGRules;
  =head1 Custom SEED Attribute Manager
-Line 16
+Line 18
  The Custom SEED Attributes Manager allows the user to upload and retrieve
  custom data for SEED objects. It uses the B<ERDB> database system to
- store the attributes, which are implemented as multi-valued fields
+ store the attributes.
- of ERDB entities.
+ Attributes are organized by I<attribute key>. Attribute values are
+ assigned to I<objects>. In the real world, objects have types and IDs;
+ however, to the attribute database only the ID matters. This will create
+ a problem if we have a single ID that applies to two objects of different
+ types, but it is more consistent with the original attribute implementation
+ in the SEED (which this implementation replaces).
+ The actual attribute values are stored as a relationship between the attribute
+ keys and the objects. There can be multiple values for a single key/object pair.
+ =head3 Object IDs
+ The object ID is normally represented as
+     I<type>:I<id>
+ where I<type> is the object type (C<Role>, C<Coupling>, etc.) and I<id> is
+ the actual object ID. Note that the object type must consist of only upper- and
+ lower-case letters! Thus, C<GenomeGroup> is a valid object type, but
+ C<genome_group> is not. Given that restriction, the object ID
+     Family:aclame|cluster10
+ would represent the FIG family C<aclame|cluster10>. For historical reasons,
+ there are three exceptions: subsystems, genomes, and features do not need
+ a type. So, for PEG 3361 of Streptomyces coelicolor A3(2), you simply code
+     fig|100226.1.peg.3361
+ The methods L</ParseID> and L</FormID> can be used to make this all seem
+ more consistent. Given any object ID string, L</ParseID> will convert it to an
+ object type and ID, and given any object type and ID, L</FormID> will
+ convert it to an object ID string. The attribute database is pretty
+ freewheeling about what it will allow for an ID; however, for best
+ results, the type should match an entity type from a Sprout genetics
+ database. If this rule is followed, then the database object
+ corresponding to an ID in the attribute database could be retrieved using
+ L</GetTargetObject> method.
+     my $object = CustomAttributes::GetTargetObject($sprout, $idValue);
+ =head3 Retrieval and Logging
  The full suite of ERDB retrieval capabilities is provided. In addition,
  custom methods are provided specific to this application. To get all
- the values of the attribute C<essential> in the B<Feature> entity, you
+ the values of the attribute C<essential> in a specified B<Feature>, you
  would code
-     my @values = $attrDB->GetAttributes($fid, Feature => 'essential');
+     my @values = $attrDB->GetAttributes($fid, 'essential');
  where I<$fid> contains the ID of the desired feature.
- New attributes are introduced by updating the database definition at
+ Keys can be split into two pieces using the splitter value defined in the
- run-time. Attribute values are stored by uploading data from files.
+ constructor (the default is C<::>). The first piece of the key is called
- A web interface is provided for both these activities.
+ the I<real key>. This portion of the key must be defined using the
+ web interface (C<Attributes.cgi>). The second portion of the key is called
+ the I<sub key>, and can take any value.
+ Major attribute activity is recorded in a log (C<attributes.log>) in the
+ C<$FIG_Config::var> directory. The log reports the user name, time, and
+ the details of the operation. The user name will almost always be unknown,
+ the exception being when it is specified in this object's constructor
+ (see L</new>).
  =head2 FIG_Config Parameters
-Line 74
+Line 126
  functions as data to the attribute management process, so if the data is
  moved, this file must go with it.
- =back
+ =item attr_default_table
- =head2 Impliementation Note
+ Name of the default relationship for attribute values. If not present,
+ C<HasValueFor> is used.
- The L</Refresh> method reloads the entities in the database. If new
+ =back
- entity types are added, that method will need to be adjusted accordingly.
  =head2 Public Methods
  =head3 new
- C<< my $attrDB = CustomAttributes->new(); >>
+     my $attrDB = CustomAttributes->new(%options);
+ Construct a new CustomAttributes object. The following options are
+ supported.
+ =over 4
+ =item splitter
+ Value to be used to split attribute values into sections in the
+ L</Fig Replacement Methods>. The default is a double colon C<::>,
+ and should only be overridden in extreme circumstances.
+ =item user
- Construct a new CustomAttributes object. This object is only used to load
+ Name of the current user. This will appear in the attribute log.
- or access data. To add new attributes, use the static L</NewAttribute>
- method.
+ =back
  =cut
  sub new {
      # Get the parameters.
-     my ($class) = @_;
+     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 104
+Line 170
      # Create the ERDB object.
      my $xmlFileName = $FIG_Config::attrDBD;
      my $retVal = ERDB::new($class, $dbh, $xmlFileName);
+     # Store the splitter value.
+     $retVal->{splitter} = $options{splitter} || '::';
+     # 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 GetAttributes
+ =head3 StoreAttributeKey
+     $attrDB->StoreAttributeKey($attributeName, $notes, \@groups, $table);
- C<< my @values = $attrDB->GetAttributes($id, $entityName => $attributeName); >>
+ Create or update an attribute for the database.
- Return all the values of the specified attribute for the specified entity instance.
+ =over 4
- A list of vaues will be returned. If the entity instance does not exist or the
- attribute has no values, an empty list will be returned. If the attribute name
- does not exist, an SQL error will occur.
- A typical invocation would look like this:
+ =item attributeName
-     my @values = $sttrDB->GetAttributes($fid, Feature => 'essential');
+ Name of the attribute (the real key). If it does not exist already, it will be created.
- Here the user is asking for the values of the C<essential> attribute for the
+ =item notes
- B<Feature> with the specified ID. If the identified feature is not essential,
- the list returned will be empty. If it is essential, then one or more values
- will be returned that describe the essentiality.
- =over 4
+ Descriptive notes about the attribute. It is presumed to be raw text, not HTML.
- =item id
+ =item groups
+ 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
- ID of the desired entity instance. This identifies the specific object to
+ The name of the relationship in which the attribute's values are to be stored.
- be interrogated for attribute values.
+ If empty or undefined, the default relationship (usually C<HasValueFor>) will be
+ assumed.
- =item entityName
+ =back
+ =cut
+ sub StoreAttributeKey {
+     # Get the parameters.
+     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) {
+         Confess("Missing description for $attributeName.");
+     } elsif (! grep { $_ eq $table } $self->GetConnectingRelationships('AttributeKey')) {
+         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;
+         # Okay, we're ready to begin. See if this key exists.
+         my $attribute = $self->GetEntity('AttributeKey', $attributeName);
+         if (defined($attribute)) {
+             # It does, so we do an update.
+             $action = "Update Key";
+             $self->UpdateEntity('AttributeKey', $attributeName,
+                                 { 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,
+                                 'relationship-name' => $table});
+         }
+         # Attach the key to the specified groups. (We presume the groups already
+         # exist.)
+         for my $group (@{$groups}) {
+             $self->InsertObject('IsInGroup', { 'from-link' => $attributeName,
+                                                'to-link'   => $group });
+         }
+         # Log the operation.
+         $self->LogOperation($action, $attributeName, "Group list is " . join(" ", @{$groups}));
+     }
+ }
+ =head3 DeleteAttributeKey
+     my $stats = $attrDB->DeleteAttributeKey($attributeName);
- Name of the entity. This identifies the the type of the object to be
+ Delete an attribute from the custom attributes database.
- interrogated for attribute values.
+ =over 4
  =item attributeName
- Name of the desired attribute.
+ Name of the attribute to delete.
  =item RETURN
- Returns zero or more strings, each representing a value of the named attribute
+ Returns a statistics object describing the effects of the deletion.
- for the specified entity instance.
  =back
  =cut
- sub GetAttributes {
+ sub DeleteAttributeKey {
      # Get the parameters.
-     my ($self, $id, $entityName, $attributeName) = @_;
+     my ($self, $attributeName) = @_;
-     # Get the data.
+     # Delete the attribute key.
-     my @retVal = $self->GetEntityValues($entityName, $id, ["$entityName($attributeName)"]);
+     my $retVal = $self->Delete('AttributeKey', $attributeName);
+     # Log this operation.
+     $self->LogOperation("Delete Key", $attributeName, "Key will no longer be available for use by anyone.");
      # Return the result.
-     return @retVal;
+     return $retVal;
  }
- =head3 StoreAttribute
+ =head3 NewName
- C<< my $attrDB = CustomAttributes::StoreAttribute($entityName, $attributeName, $type, $notes); >>
+     my $text = CustomAttributes::NewName();
- Create or update an attribute for the database. This method will update the database definition
+ Return the string used to indicate the user wants to add a new attribute.
- XML, but it will not create the table. It will connect to the database so that the caller
- can upload the attribute values.
- =over 4
+ =cut
- =item entityName
+ sub NewName {
+     return "(new)";
+ }
- Name of the entity containing the attribute. The entity must exist.
+ =head3 LoadAttributesFrom
- =item attributeName
+ C<< my $stats = $attrDB->LoadAttributesFrom($fileName, %options); >>
- Name of the attribute. It must be a valid ERDB field name, consisting entirely of
+ Load attributes from the specified tab-delimited file. Each line of the file must
- letters, digits, and hyphens, with a letter at the beginning. If it does not
+ contain an object ID in the first column, an attribute key name in the second
- exist already, it will be created.
+ 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.
- =item type
+ =over 4
- Data type of the attribute. This must be a valid ERDB data type name.
+ =item fileName
- =item notes
+ Name of the file from which to load the attributes, or an open handle for the file.
+ (This last enables the method to be used in conjunction with the CGI form upload
+ control.)
- Descriptive notes about the attribute. It is presumed to be raw text, not HTML.
+ =item options
+ Hash of options for modifying the load process.
  =item RETURN
- Returns a Custom Attribute Database object if successful. If unsuccessful, an
+ Returns a statistics object describing the load.
- error will be thrown.
+ =back
+ Permissible option values are as follows.
+ =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
+ first time a key name is encountered, it will be erased.
+ =item archive
+ 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
- sub StoreAttribute {
+ sub LoadAttributesFrom {
      # Get the parameters.
-     my ($entityName, $attributeName, $type, $notes) = @_;
+     my ($self, $fileName, %options) = @_;
-     # Get the data type hash.
+     # Declare the return variable.
-     my %types = ERDB::GetDataTypes();
+     my $retVal = Stats->new('keys', 'values', 'linesOut');
-     # Validate the initial input values.
+     # Initialize the timers.
-     if (! ERDB::ValidateFieldName($attributeName)) {
+     my ($eraseTime, $archiveTime, $checkTime) = (0, 0, 0);
-         Confess("Invalid attribute name \"$attributeName\" specified.");
+     # Check for append mode.
-     } elsif (! $notes || length($notes) < 25) {
+     my $append = ($options{append} ? 1 : 0);
-         Confess("Missing or incomplete description for $attributeName.");
+     # Check for resume mode.
-     } elsif (! exists $types{$type}) {
+     my $resume = (defined($options{resume}) ? $options{resume} : 'none');
-         Confess("Invalid data type \"$type\" for $attributeName.");
+     # 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. 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);
+         $fh = $fileName;
+     } else {
+         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 (exists $options{archive}) {
+         my $ah = Open(undef, ">$options{archive}");
+         Trace("Load file will be archived to $options{archive}.") if T(3);
+     }
+     # Insure we recover from errors.
+     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);
+             # Do some validation.
+             if (! $id) {
+                 # We ignore blank lines.
+                 $retVal->Add(blankLines => 1);
+             } elsif (substr($id, 0, 1) eq '#') {
+                 # A line beginning with a pound sign is a comment.
+                 $retVal->Add(comments => 1);
+             } elsif (! defined($key)) {
+                 # An ID without a key is a serious error.
+                 my $lines = $retVal->Ask('linesIn');
+                 Confess("Line $lines in $fileName has no attribute key.");
+             } elsif (! @values) {
+                 # A line with no values is not allowed.
+                 my $lines = $retVal->Ask('linesIn');
+                 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}) {
+                     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. We do this by putting
+                         # 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. 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);
+                 }
+                 # If we're in resume mode, check to see if this insert is redundant.
+                 my $ok = 1;
+                 if ($resume ne 'none') {
+                     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}");
      }
-     # Our next step is to read in the XML for the database defintion. We
-     # need to verify that the named entity exists.
-     my $metadata = ERDB::ReadMetaXML($FIG_Config::attrDBD);
-     my $entityHash = $metadata->{Entities};
-     if (! exists $entityHash->{$entityName}) {
-         Confess("Entity $entityName not found.");
      } else {
-         # Okay, we're ready to begin. Get the field hash.
+                     # Here we skipped because of resume mode.
-         my $fieldHash = ERDB::GetEntityFieldHash($metadata, $entityName);
+                     $retVal->Add(resumeSkip => 1);
-         # Compute the attribute's relation name.
+                 }
-         my $relName = join("", $entityName, map { ucfirst $_ } split(/-/, $attributeName));
+                 Trace($retVal->Ask('values') . " values processed.") if $retVal->Check(values => 1000) && T(3);
-         # Store the attribute's field data. Note the use of the "content" hash for
-         # the notes. This is how the XML writer knows Notes is a text tag instead of
-         # an attribute.
-         $fieldHash->{$attributeName} = { type => $type, relation => $relName,
-                                          Notes => { content => $notes } };
-         # Write the XML back out.
-         ERDB::WriteMetaXML($metadata, $FIG_Config::attrDBD);
      }
-     # Open a database with the new XML.
+         }
-     my $retVal = CustomAttributes->new();
+         # 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. Display the error message.
+         my $message = $@;
+         Trace("Error during attribute load: $message") if T(0);
+         $retVal->AddMessage($message);
+         # Close the archive file if it's open. The archive file can sometimes provide
+         # clues as to what happened.
+         if (defined $ah) {
+             close $ah;
+         }
+     }
+     # Store the timers.
+     $retVal->Add(eraseTime   => $eraseTime);
+     $retVal->Add(archiveTime => $archiveTime);
+     $retVal->Add(checkTime   => $checkTime);
+     # Return the result.
      return $retVal;
  }
- =head3 Refresh
+ =head3 BackupKeys
+     my $stats = $attrDB->BackupKeys($fileName, %options);
+ Backup the attribute key information from the attribute database.
+ =over 4
+ =item fileName
+ Name of the output file.
+ =item options
+ Options for modifying the backup process.
- C<< $attrDB->Refresh(); >>
+ =item RETURN
+ Returns a statistics object for the backup.
+ =back
- Refresh the primary entity tables from the FIG data store. This method basically
+ Currently there are no options. The backup is straight to a text file in
- drops and reloads the main tables of the custom attributes database.
+ tab-delimited format. Each key is backup up to two lines. The first line
+ is all of the data from the B<AttributeKey> table. The second is a
+ tab-delimited list of all the groups.
  =cut
- sub Refresh {
+ sub BackupKeys {
      # Get the parameters.
-     my ($self) = @_;
+     my ($self, $fileName, %options) = @_;
-     # Create load objects for the genomes and the features.
+     # Declare the return variable.
-     my $loadGenome = ERDBLoad->new($self, 'Genome', $FIG_Config::temp);
+     my $retVal = Stats->new();
-     my $loadFeature = ERDBLoad->new($self, 'Feature', $FIG_Config::temp);
+     # Open the output file.
-     # Get a FIG object. We'll use this to create the data.
+     my $fh = Open(undef, ">$fileName");
-     my $fig = FIG->new();
+     # Set up to read the keys.
-     # Get the genome list.
+     my $keyQuery = $self->Get(['AttributeKey'], "", []);
-     my @genomes = $fig->genomes();
+     # Loop through the keys.
-     # Loop through the genomes.
+     while (my $keyData = $keyQuery->Fetch()) {
-     for my $genomeID (@genomes) {
+         $retVal->Add(key => 1);
-         # Put this genome in the genome table.
+         # Get the fields.
-         $loadGenome->Put($genomeID);
+         my ($id, $type, $tableName, $description) =
-         Trace("Processing Genome $genomeID") if T(3);
+             $keyData->Values(['AttributeKey(id)', 'AttributeKey(relationship-name)',
-         # Put its features into the feature table. Note we have to use a hash to
+                               'AttributeKey(description)']);
-         # remove duplicates.
+         # Escape any tabs or new-lines in the description.
-         my %featureList = map { $_ => 1 } $fig->all_features($genomeID);
+         my $escapedDescription = Tracer::Escape($description);
-         for my $fid (keys %featureList) {
+         # Write the key data to the output.
-             $loadFeature->Put($fid);
+         Tracer::PutLine($fh, [$id, $type, $tableName, $escapedDescription]);
-         }
+         # Get the key's groups.
-     }
+         my @groups = $self->GetFlat(['IsInGroup'], "IsInGroup(from-link) = ?", [$id],
-     # Get a variable for holding statistics objects.
+                                     'IsInGroup(to-link)');
-     my $stats;
+         $retVal->Add(memberships => scalar(@groups));
-     # Finish the genome load.
+         # Write them to the output. Note we put a marker at the beginning to insure the line
-     Trace("Loading Genome relation.") if T(2);
+         # is nonempty.
-     $stats = $loadGenome->FinishAndLoad();
+         Tracer::PutLine($fh, ['#GROUPS', @groups]);
-     Trace("Genome table load statistics:\n" . $stats->Show()) if T(3);
+     }
-     # Finish the feature load.
+     # Log the operation.
-     Trace("Loading Feature relation.") if T(2);
+     $self->LogOperation("Backup Keys", $fileName, $retVal->Display());
-     $stats = $loadFeature->FinishAndLoad();
+     # Return the result.
-     Trace("Feature table load statistics:\n" . $stats->Show()) if T(3);
+     return $retVal;
  }
- =head3 LoadAttribute
+ =head3 RestoreKeys
- C<< my $stats = $attrDB->LoadAttribute($entityName, $fieldName, $fh, $keyCol, $dataCol); >>
+     my $stats = $attrDB->RestoreKeys($fileName, %options);
- Load the specified attribute from the specified file. The file should be a
+ Restore the attribute keys and groups from a backup file.
- tab-delimited file with internal tab and new-line characters escaped. This is
- the typical TBL-style file used by most FIG applications. One of the columns
- in the input file must contain the appropriate key value and the other the
- corresponding attribute value.
  =over 4
- =item entityName
+ =item fileName
- Name of the entity containing the attribute.
+ Name of the file containing the backed-up keys. Each key has a pair of lines,
+ one containing the key data and one listing its groups.
- =item fieldName
+ =back
+ =cut
- Name of the actual attribute.
+ sub RestoreKeys {
+     # Get the parameters.
+     my ($self, $fileName, %options) = @_;
+     # Declare the return variable.
+     my $retVal = Stats->new();
+     # Set up a hash to hold the group IDs.
+     my %groups = ();
+     # Open the file.
+     my $fh = Open(undef, "<$fileName");
+     # Loop until we're done.
+     while (! eof $fh) {
+         # Get a key record.
+         my ($id, $tableName, $description) = Tracer::GetLine($fh);
+         if ($id eq '#GROUPS') {
+             Confess("Group record found when key record expected.");
+         } elsif (! defined($description)) {
+             Confess("Invalid format found for key record.");
+         } else {
+             $retVal->Add("keyIn" => 1);
+             # Add this key to the database.
+             $self->InsertObject('AttributeKey', { id => $id,
+                                                   description => Tracer::UnEscape($description),
+                                                   'relationship-name' => $tableName});
+             Trace("Attribute $id stored.") if T(3);
+             # Get the group line.
+             my ($marker, @groups) = Tracer::GetLine($fh);
+             if (! defined($marker)) {
+                 Confess("End of file found where group record expected.");
+             } elsif ($marker ne '#GROUPS') {
+                 Confess("Group record not found after key record.");
+             } else {
+                 $retVal->Add(memberships => scalar(@groups));
+                 # Connect the groups.
+                 for my $group (@groups) {
+                     # Find out if this is a new group.
+                     if (! $groups{$group}) {
+                         $retVal->Add(newGroup => 1);
+                         # Add the group.
+                         $self->InsertObject('AttributeGroup', { id => $group });
+                         Trace("Group $group created.") if T(3);
+                         # Make sure we know it's not new.
+                         $groups{$group} = 1;
+                     }
+                     # Connect the group to our key.
+                     $self->InsertObject('IsInGroup', { 'from-link' => $id, 'to-link' => $group });
+                 }
+                 Trace("$id added to " . scalar(@groups) . " groups.") if T(3);
+             }
+         }
+     }
+     # Log the operation.
+     $self->LogOperation("Backup Keys", $fileName, $retVal->Display());
+     # Return the result.
+     return $retVal;
+ }
+ =head3 ArchiveFileName
+     my $fileName = $ca->ArchiveFileName();
+ Compute a file name for archiving attribute input data. The file will be in the attribute log directory
+ =cut
- =item fh
+ sub ArchiveFileName {
+     # Get the parameters.
+     my ($self) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # We start by turning the timestamp into something usable as a file name.
+     my $now = Tracer::Now();
+     $now =~ tr/ :\//___/;
+     # Next we get the directory name.
+     my $dir = "$FIG_Config::var/attributes";
+     if (! -e $dir) {
+         Trace("Creating attribute file directory $dir.") if T(1);
+         mkdir $dir;
+     }
+     # Put it together with the field name and the time stamp.
+     $retVal = "$dir/upload.$now";
+     # Modify the file name to insure it's unique.
+     my $seq = 0;
+     while (-e "$retVal.$seq.tbl") { $seq++ }
+     # Use the computed sequence number to get the correct file name.
+     $retVal .= ".$seq.tbl";
+     # Return the result.
+     return $retVal;
+ }
+ =head3 BackupAllAttributes
+     my $stats = $attrDB->BackupAllAttributes($fileName, %options);
- Open file handle for the input file.
+ Backup all of the attributes to a file. The attributes will be stored in a
+ tab-delimited file suitable for reloading via L</LoadAttributesFrom>.
- =item keyCol
+ =over 4
+ =item fileName
- Index (0-based) of the column containing the key field. The key field should
+ Name of the file to which the attribute data should be backed up.
- contain the ID of an instance of the named entity.
- =item dataCol
+ =item options
- Index (0-based) of the column containing the data value field.
+ Hash of options for the backup.
  =item RETURN
- Returns a statistics object for the load process.
+ Returns a statistics object describing the backup.
  =back
+ Currently there are no options defined.
  =cut
- sub LoadAttribute {
+ sub BackupAllAttributes {
      # Get the parameters.
-     my ($self, $entityName, $fieldName, $fh, $keyCol, $dataCol) = @_;
+     my ($self, $fileName, %options) = @_;
-     # Create the return variable.
+     # Declare the return variable.
-     my $retVal;
+     my $retVal = Stats->new();
-     # Insure the entity exists.
+     # Get a list of the keys.
-     my $found = grep { $_ eq $entityName } $self->GetEntityTypes();
+     my %keys = map { $_->[0] => $_->[1] } $self->GetAll(['AttributeKey'],
-     if (! $found) {
+                                                         "", [], ['AttributeKey(id)',
-         Confess("Entity \"$entityName\" not found in database.");
+                                                                   'AttributeKey(relationship-name)']);
-     } else {
+     Trace(scalar(keys %keys) . " keys found during backup.") if T(2);
-         # Get the field structure for the named entity.
+     # Open the file for output.
-         my $fieldHash = $self->GetFieldTable($entityName);
+     my $fh = Open(undef, ">$fileName");
-         # Verify that the attribute exists.
+     # Loop through the keys.
-         if (! exists $fieldHash->{$fieldName}) {
+     for my $key (sort keys %keys) {
-             Confess("Attribute \"$fieldName\" does not exist in entity $entityName.");
+         Trace("Backing up attribute $key.") if T(3);
-         } else {
+         $retVal->Add(keys => 1);
-             # Create a loader for the specified attribute. We need the
+         # Get the key's relevant relationship name.
-             # relation name first.
+         my $relName = $keys{$key};
-             my $relName = $fieldHash->{$fieldName}->{relation};
+         # Loop through this key's values.
-             my $loadAttribute = ERDBLoad->new($self, $relName, $FIG_Config::temp);
+         my $query = $self->Get([$relName], "$relName(from-link) = ?", [$key]);
-             # Loop through the input file.
+         my $valuesFound = 0;
-             while (! eof $fh) {
+         while (my $line = $query->Fetch()) {
-                 # Get the next line of the file.
+             $valuesFound++;
-                 my @fields = Tracer::GetLine($fh);
+             # Get this row's data.
-                 $loadAttribute->Add("lineIn");
+             my ($id, $key, $subKey, $value) = $line->Values(["$relName(to-link)",
-                 # Now we need to validate the line.
+                                                              "$relName(from-link)",
-                 if ($#fields < $dataCol) {
+                                                              "$relName(subkey)",
-                     $loadAttribute->Add("shortLine");
+                                                              "$relName(value)"]);
-                 } elsif (! $self->Exists($entityName, $fields[$keyCol])) {
+             # Check for a subkey.
-                     $loadAttribute->Add("badKey");
+             if ($subKey ne '') {
-                 } else {
+                 $key = "$key$self->{splitter}$subKey";
-                     # It's valid,so send it to the loader.
-                     $loadAttribute->Put($fields[$keyCol], $fields[$dataCol]);
-                     $loadAttribute->Add("lineUsed");
                  }
+             # Write it to the file.
+             Tracer::PutLine($fh, [$id, $key, Escape($value)]);
              }
-             # Finish the load.
+         Trace("$valuesFound values backed up for key $key.") if T(3);
-             $retVal = $loadAttribute->FinishAndLoad();
+         $retVal->Add(values => $valuesFound);
          }
-     }
+     # Log the operation.
-     # Return the statistics.
+     $self->LogOperation("Backup Data", $fileName, $retVal->Display());
+     # Return the result.
      return $retVal;
  }
- =head3 DeleteAttribute
- C<< CustomAttributes::DeleteAttribute($entityName, $attributeName); >>
+ =head3 GetGroups
- Delete an attribute from the custom attributes database.
+     my @groups = $attrDB->GetGroups();
+ Return a list of the available groups.
+ =cut
+ sub GetGroups {
+     # Get the parameters.
+     my ($self) = @_;
+     # Get the groups.
+     my @retVal = $self->GetFlat(['AttributeGroup'], "", [], 'AttributeGroup(id)');
+     # Return them.
+     return @retVal;
+ }
+ =head3 GetAttributeData
+     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, the table name, and the groups.
  =over 4
- =item entityName
+ =item type
- Name of the entity possessing the attribute.
+ Type of attribute criterion: C<name> for attributes whose names begin with the
+ specified string, or C<group> for attributes in the specified group.
- =item attributeName
+ =item list
- Name of the attribute to delete.
+ List containing the names of the groups or keys for the desired attributes.
+ =item RETURN
+ Returns a hash mapping each attribute key name to its description,
+ table name, and parent groups.
  =back
  =cut
- sub DeleteAttribute {
+ sub GetAttributeData {
      # Get the parameters.
-     my ($entityName, $attributeName) = @_;
+     my ($self, $type, @list) = @_;
-     # Read in the XML for the database defintion. We need to verify that
+     # Set up a hash to store the attribute data.
-     # the named entity exists and it has the named attribute.
+     my %retVal = ();
-     my $metadata = ERDB::ReadMetaXML($FIG_Config::attrDBD);
+     # Loop through the list items.
-     my $entityHash = $metadata->{Entities};
+     for my $item (@list) {
-     if (! exists $entityHash->{$entityName}) {
+         # Set up a query for the desired attributes.
-         Confess("Entity \"$entityName\" not found.");
+         my $query;
-     } else {
+         if ($type eq 'name') {
-         # Get the field hash.
+             # Here we're doing a generic name search. We need to escape it and then tack
-         my $fieldHash = ERDB::GetEntityFieldHash($metadata, $entityName);
+             # on a %.
-         if (! exists $fieldHash->{$attributeName}) {
+             my $parm = $item;
-             Confess("Attribute \"$attributeName\" not found in entity $entityName.");
+             $parm =~ s/_/\\_/g;
-         } else {
+             $parm =~ s/%/\\%/g;
-             # Get the attribute's relation name.
+             $parm .= "%";
-             my $relName = $fieldHash->{$attributeName}->{relation};
+             # Ask for matching attributes. (Note that if the user passed in a null string
-             # Delete the attribute from the field hash.
+             # he'll get everything.)
-             Trace("Deleting attribute $attributeName from $entityName.") if T(3);
+             $query = $self->Get(['AttributeKey'], "AttributeKey(id) LIKE ?", [$parm]);
-             delete $fieldHash->{$attributeName};
+         } elsif ($type eq 'group') {
-             # Write the XML back out.
+             $query = $self->Get(['IsInGroup', 'AttributeKey'], "IsInGroup(to-link) = ?", [$item]);
-             ERDB::WriteMetaXML($metadata, $FIG_Config::attrDBD);
+         } else {
-             # Insure the relation does not exist in the database. This requires connecting
+             Confess("Unknown attribute query type \"$type\".");
-             # since we may have to do a table drop.
+         }
-             my $attrDB = CustomAttributes->new();
+         while (my $row = $query->Fetch()) {
-             $attrDB->DropRelation($relName);
+             # Get this attribute's data.
+             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} = [$relName, $notes, @groups];
          }
      }
  }
+     # Return the result.
+     return %retVal;
+ }
- =head3 ControlForm
+ =head3 LogOperation
- C<< my $formHtml = $attrDB->ControlForm($cgi, $name); >>
+     $ca->LogOperation($action, $target, $description);
- Return a form that can be used to control the creation and modification of
+ Write an operation description to the attribute activity log (C<$FIG_Config::var/attributes.log>).
- attributes.
  =over 4
- =item cgi
+ =item action
+ Action being logged (e.g. C<Delete Group> or C<Load Key>).
+ =item target
+ ID of the key or group affected.
+ =item description
+ Short description of the action.
+ =back
- CGI query object used to create HTML.
+ =cut
+ sub LogOperation {
+     # Get the parameters.
+     my ($self, $action, $target, $description) = @_;
+     # Get the user ID.
+     my $user = $self->{user};
+     # Get a timestamp.
+     my $timeString = Tracer::Now();
+     # Open the log file for appending.
+     my $oh = Open(undef, ">>$FIG_Config::var/attributes.log");
+     # Write the data to it.
+     Tracer::PutLine($oh, [$timeString, $user, $action, $target, $description]);
+     # Close the log file.
+     close $oh;
+ }
+ =head2 FIG Method Replacements
+ The following methods are used by B<FIG.pm> to replace the previous attribute functionality.
+ Some of the old functionality is no longer present: controlled vocabulary is no longer
+ supported and there is no longer any searching by URL. Fortunately, neither of these
+ capabilities were used in the old system.
+ The methods here are the only ones supported by the B<RemoteCustomAttributes> object.
+ The idea is that these methods represent attribute manipulation allowed by all users, while
+ the others are only for privileged users with access to the attribute server.
+ In the previous implementation, an attribute had a value and a URL. In this implementation,
+ each attribute has only a value. These methods will treat the value as a list with the individual
+ elements separated by the value of the splitter parameter on the constructor (L</new>). The default
+ is double colons C<::>.
+ So, for example, an old-style keyword with a value of C<essential> and a URL of
+ C<http://www.sciencemag.org/cgi/content/abstract/293/5538/2266> using the default
+ splitter value would be stored as
+     essential::http://www.sciencemag.org/cgi/content/abstract/293/5538/2266
+ The best performance is achieved by searching for a particular key for a specified
+ feature or genome.
+ =head3 GetAttributes
+     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
+ the attribute system as a whole, merely a convenience for the purpose of
+ these methods. If a value has multiple sections, each section
+ is matched against the corresponding criterion in the I<@valuePatterns> list.
+ This method returns a series of tuples that match the specified criteria. Each tuple
+ will contain an object ID, a key, and one or more values. The parameters to this
+ method therefore correspond structurally to the values expected in each tuple. In
+ addition, you can ask for a generic search by suffixing a percent sign (C<%>) to any
+ of the parameters. So, for example,
+     my @attributeList = $attrDB->GetAttributes('fig|100226.1.peg.1004', 'structure%', 1, 2);
+ would return something like
+     ['fig}100226.1.peg.1004', 'structure', 1, 2]
+     ['fig}100226.1.peg.1004', 'structure1', 1, 2]
+     ['fig}100226.1.peg.1004', 'structure2', 1, 2]
+     ['fig}100226.1.peg.1004', 'structureA', 1, 2]
+ Use of C<undef> in any position acts as a wild card (all values). You can also specify
+ a list reference in the ID column. Thus,
+     my @attributeList = $attrDB->GetAttributes(['100226.1', 'fig|100226.1.%'], 'PUBMED');
+ would get the PUBMED attribute data for Streptomyces coelicolor A3(2) and all its
+ features.
- =item name
+ In addition to values in multiple sections, a single attribute key can have multiple
+ values, so even
- Name to give to the form. This should be unique for the web page.
+     my @attributeList = $attrDB->GetAttributes($peg, 'virulent');
+ which has no wildcard in the key or the object ID, may return multiple tuples.
+ Value matching in this system works very poorly, because of the way multiple values are
+ stored. For the object ID, key name, and first value, we create queries that filter for the
+ desired results. On any filtering by value, we must do a comparison after the attributes are
+ retrieved from the database, since the database has no notion of the multiple values, which
+ are stored in a single string. As a result, queries in which filter only on value end up
+ reading a lot more than they need to.
+ =over 4
+ =item objectID
+ ID of object whose attributes are desired. If the attributes are desired for multiple
+ objects, this parameter can be specified as a list reference. If the attributes are
+ desired for all objects, specify C<undef> or an empty string. Finally, you can specify
+ attributes for a range of object IDs by putting a percent sign (C<%>) at the end.
+ =item key
+ Attribute key name. A value of C<undef> or an empty string will match all
+ attribute keys. If the values are desired for multiple keys, this parameter can be
+ specified as a list reference. Finally, you can specify attributes for a range of
+ keys by putting a percent sign (C<%>) at the end.
+ =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 the HTML for a form that submits instructions to the C<Attributes.cgi> script
+ Returns a list of tuples. The first element in the tuple is an object ID, the
- for loading, creating, or deleting an attribute.
+ 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 ControlForm {
+ sub GetAttributes {
      # Get the parameters.
-     my ($self, $cgi, $name) = @_;
+     my ($self, $objectID, $key, @values) = @_;
-     # Declare the return list.
+     # This hash will map value-table fields to patterns. We use it to build the
+     # SQL statement.
+     my %data;
+     # Add the object ID to the key information.
+     $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),
+     # then we can create SQL filtering for it. If any of the values are specified
+     # as a regular expression, however, that's a problem, because we need to read
+     # every value to verify a match.
+     if (@values > 0) {
+         # Get the first value and put its alternatives in an array.
+         my $valueParm = $values[0];
+         my @valueList;
+         if (ref $valueParm eq 'ARRAY') {
+             @valueList = @{$valueParm};
+         } else {
+             @valueList = ($valueParm);
+         }
+         # Okay, now we have all the possible criteria for the first value in the list
+         # @valueList. We'll copy the values to a new array in which they have been
+         # converted to generic requests. If we find a regular-expression match
+         # anywhere in the list, we toss the whole thing.
+         my @valuePatterns = ();
+         my $okValues = 1;
+         for my $valuePattern (@valueList) {
+             # Check the pattern type.
+             if (substr($valuePattern, 0, 1) eq '/') {
+                 # Regular expressions invalidate the entire process.
+                 $okValues = 0;
+             } elsif (substr($valuePattern, -1, 1) eq '%') {
+                 # A Generic pattern is passed in unmodified.
+                 push @valuePatterns, $valuePattern;
+             } else {
+                 # An exact match is converted to generic.
+                 push @valuePatterns, "$valuePattern%";
+             }
+         }
+         # If everything works, add the value data to the filtering hash.
+         if ($okValues) {
+             $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 = ();
-     # Start the form. We use multipart to support the upload control.
+     # Now we loop through the tables of interest, performing queries.
-     push @retVal, $cgi->start_multipart_form(-name => $name);
+     # Loop through the tables.
-     # We'll put the controls in a table. Nothing else ever seems to look nice.
+     for my $table (keys %tables) {
-     push @retVal, $cgi->start_table({ border => 2, cellpadding => 2 });
+         # Get the key pairs for this table.
-     # The first row is for selecting the field name.
+         my $pairs = $tables{$table};
-     push @retVal, $cgi->Tr($cgi->th("Select a Field"),
+         # Does this table have data? It does if there is no key specified or
-                            $cgi->td($self->FieldMenu($cgi, 10, 'fieldName', 1,
+         # it has at least one key pair.
-                                                      "document.$name.notes.value",
+         my $pairCount = scalar @{$pairs};
-                                                      "document.$name.dataType.value")));
+         Trace("Pair count for table $table is $pairCount.") if T(3);
-     # Now we set up a dropdown for the data types. The values will be the
+         if ($pairCount || ! $key) {
-     # data type names, and the labels will be the descriptions.
+             # Create some lists to contain the filter fragments and parameter values.
-     my %types = ERDB::GetDataTypes();
+             my @filter = ();
-     my %labelMap = map { $_ => $types{$_}->{notes} } keys %types;
+             my @parms = ();
-     my $typeMenu = $cgi->popup_menu(-name   => 'dataType',
+             # This next loop goes through the different fields that can be specified in the
-                                     -values => [sort keys %types],
+             # parameter list and generates filters for each. The %data hash that we built above
-                                     -labels => \%labelMap);
+             # contains most of the necessary information to do this. When we're done, we'll
-     push @retVal, $cgi->Tr($cgi->th("Data type"),
+             # paste on stuff for the key pairs.
-                            $cgi->td($typeMenu));
+             for my $field (keys %data) {
-     # The next row is for the notes.
+                 # Accumulate filter information for this field. We will OR together all the
-     push @retVal, $cgi->Tr($cgi->th("Description"),
+                 # elements accumulated to create the final result.
-                            $cgi->td($cgi->textarea(-name => 'notes',
+                 my @fieldFilter = ();
-                                                    -rows => 6,
+                 # Get the specified filter for this field.
-                                                    -columns => 80))
+                 my $fieldPattern = $data{$field};
-                           );
+                 # Only proceed if the pattern is one that won't match everything.
-     # Allow the user to specify a new field name. This is required if the
+                 if (defined($fieldPattern) && $fieldPattern ne "" && $fieldPattern ne "%") {
-     # user has selected one of the "(new)" markers.
+                     # Convert the pattern to an array.
-     push @retVal, $cgi->Tr($cgi->th("New Field Name"),
+                     my @patterns = ();
-                            $cgi->td($cgi->textfield(-name => 'newName',
+                     if (ref $fieldPattern eq 'ARRAY') {
-                                                     -size => 30)),
+                         push @patterns, @{$fieldPattern};
-                                     );
+                     } else {
-     # If the user wants to upload new values for the field, then we have
+                         push @patterns, $fieldPattern;
-     # an upload file name and column indicators.
+                     }
-     push @retVal, $cgi->Tr($cgi->th("Upload Values"),
+                     # Only proceed if the array is nonempty. The loop will work fine if the
-                            $cgi->td($cgi->filefield(-name => 'newValueFile',
+                     # array is empty, but when we build the filter string at the end we'll
-                                                     -size => 20) .
+                     # get "()" in the filter list, which will result in an SQL syntax error.
-                                     " Key&nbsp;" .
+                     if (@patterns) {
-                                     $cgi->textfield(-name => 'keyCol',
+                         # Loop through the individual patterns.
-                                                     -size => 3,
+                         for my $pattern (@patterns) {
-                                                     -default => 0) .
+                             my ($clause, $value) = _WherePart($table, $field, $pattern);
-                                     " Value&nbsp;" .
+                             push @fieldFilter, $clause;
-                                     $cgi->textfield(-name => 'valueCol',
+                             push @parms, $value;
-                                                     -size => 3,
+                         }
-                                                     -default => 1)
+                         # Form the filter for this field.
-                                    ),
+                         my $fieldFilterString = join(" OR ", @fieldFilter);
-                           );
+                         push @filter, "($fieldFilterString)";
-     # Now the two buttons: UPDATE and DELETE.
+                     }
-     push @retVal, $cgi->Tr($cgi->th("&nbsp;"),
+                 }
-                            $cgi->td({align => 'center'},
+             }
-                                     $cgi->submit(-name => 'Delete', -value => 'DELETE') . " " .
+             # The final filter is for the key pairs. Only proceed if we have some.
-                                     $cgi->submit(-name => 'Store',  -value => 'STORE')
+             if ($pairCount) {
-                                    )
+                 # We'll accumulate pair filter clauses in here.
-                           );
+                 my @pairFilters = ();
-     # Close the table and the form.
+                 # Loop through the key pairs.
-     push @retVal, $cgi->end_table();
+                 for my $pair (@$pairs) {
-     push @retVal, $cgi->end_form();
+                     my ($realKey, $subKey) = @{$pair};
-     # Return the assembled HTML.
+                     my ($realClause, $realValue) = _WherePart($table, 'from-link', $realKey);
-     return join("\n", @retVal, "");
+                     if (! $subKey) {
- }
+                         # Here the subkey is wild, so only the real key matters.
+                         push @pairFilters, $realClause;
- =head3 FieldMenu
+                         push @parms, $realValue;
+                     } else {
- C<< my $menuHtml = $attrDB->FieldMenu($cgi, $height, $name, $newFlag, $noteControl, $typeControl); >>
+                         # Here we have to select on both keys.
+                         my ($subClause, $subValue) = _WherePart($table, 'subkey', $subKey);
- Return the HTML for a menu to select an attribute field. The menu will
+                         push @pairFilters, "($realClause AND $subClause)";
- be a standard SELECT/OPTION thing which is called "popup menu" in the
+                         push @parms, $subValue;
- CGI package, but actually looks like a list. The list will contain
+                     }
- one selectable row per field, grouped by entity.
+                 }
+                 # 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([$table], $actualFilter, \@parms);
+             # Format the results.
+             push @retVal, $self->_QueryResults($query, $table, @values);
+         }
+     }
+     # 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
+     $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.
  =over 4
- =item cgi
+ =item objectID
- CGI query object used to generate HTML.
+ ID of the object to which the attribute is to be added.
- =item height
+ =item key
- Number of lines to display in the list.
+ Attribute key name.
- =item name
+ =item values
- Name to give to the menu. This is the name under which the value will
+ One or more values to be associated with the key. The values are joined together with
- appear when the form is submitted.
+ the splitter value before being stored as field values. This enables L</GetAttributes>
+ to split them apart during retrieval. The splitter value defaults to double colons C<::>.
- =item newFlag (optional)
- 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 noteControl (optional)
- 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 typeControl (optional)
- 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 RETURN
- Returns the HTML to create a form field that can be used to select an
- attribute from the custom attributes system.
  =back
  =cut
- sub FieldMenu {
+ sub AddAttribute {
      # Get the parameters.
-     my ($self, $cgi, $height, $name, $newFlag, $noteControl, $typeControl) = @_;
+     my ($self, $objectID, $key, @values) = @_;
-     # These next two hashes make everything happen. "entities"
+     # Don't allow undefs.
-     # maps each entity name to the list of values to be put into its
+     if (! defined($objectID)) {
-     # option group. "labels" maps each entity name to a map from values
+         Confess("No object ID specified for AddAttribute call.");
-     # to labels.
+     } elsif (! defined($key)) {
-     my @entityNames = sort ($self->GetEntityTypes());
+         Confess("No attribute key specified for AddAttribute call.");
-     my %entities = map { $_ => [] } @entityNames;
+     } elsif (! @values) {
-     my %labels = map { $_ => { }} @entityNames;
+         Confess("No values specified in AddAttribute call for key $key.");
-     # Loop through the entities, adding the existing attributes.
+     } else {
-     for my $entity (@entityNames) {
+         # Okay, now we have some reason to believe we can do this. Form the values
-         # Get this entity's field table.
+         # into a scalar.
-         my $fieldHash = $self->GetFieldTable($entity);
+         my $valueString = join($self->{splitter}, @values);
-         # Get its field list in our local hashes.
+         # Split up the key.
-         my $fieldList = $entities{$entity};
+         my ($realKey, $subKey) = $self->SplitKey($key);
-         my $labelList = $labels{$entity};
+         # Find the table containing the key.
-         # Add the NEW fields if we want them.
+         my $table = $self->_KeyTable($realKey);
-         if ($newFlag) {
+         # Connect the object to the key.
-             push @{$fieldList}, $entity;
+         $self->InsertObject($table, { 'from-link' => $realKey,
-             $labelList->{$entity} = "(new)";
+                                              'to-link'   => $objectID,
-         }
+                                              'subkey'    => $subKey,
-         # Loop through the fields in the hash. We only keep the ones with a
+                                              'value'     => $valueString,
-         # secondary relation name. (In other words, the name of the relation
+                                        });
-         # in which the field appears cannot be the same as the entity name.)
+     }
-         for my $fieldName (sort keys %{$fieldHash}) {
+     # Return a one, indicating success. We do this for backward compatability.
-             if ($fieldHash->{$fieldName}->{relation} ne $entity) {
+     return 1;
-                 my $value = "$entity/$fieldName";
+ }
-                 push @{$fieldList}, $value;
-                 $labelList->{$value} = $fieldName;
+ =head3 DeleteAttribute
-             }
-         }
+     $attrDB->DeleteAttribute($objectID, $key, @values);
-     }
-     # Now we have a hash and a list for each entity, and they correspond
+ Delete the specified attribute key/value combination from the database.
-     # exactly to what the $cgi->optgroup function expects.
-     # The last step is to create the name for the onChange function. This function
+ =over 4
-     # may not do anything, but we need to know the name to generate the HTML
-     # for the menu.
+ =item objectID
-     my $changeName = "${name}_setNotes";
-     my $retVal = $cgi->popup_menu({name => $name,
+ ID of the object whose attribute is to be deleted.
-                                    size => $height,
-                                    onChange => "$changeName(this.value)",
+ =item key
-                                    values => [map { $cgi->optgroup(-name => $_,
-                                                                    -values => $entities{$_},
+ Attribute key name.
-                                                                    -labels => $labels{$_})
-                                                   } @entityNames]}
+ =item values
-                                  );
-     # Create the change function.
+ One or more values associated with the key. If no values are specified, then all values
-     $retVal .= "\n<script language=\"javascript\">\n";
+ will be deleted. Otherwise, only a matching value will be deleted.
-     $retVal .= "    function $changeName(fieldValue) {\n";
-     # The function only has a body if we have a notes control to store the description.
+ =back
-     if ($noteControl || $typeControl) {
-         # Check to see if we're storing HTML or text into the note control.
+ =cut
-         my $htmlMode = ($noteControl && $noteControl =~ /innerHTML$/);
-         # We use a CASE statement based on the newly-selected field value. The
+ sub DeleteAttribute {
-         # field description will be stored in the JavaScript variable "myText"
+     # Get the parameters.
-         # and the data type in "myType". Note the default data type is a normal
+     my ($self, $objectID, $key, @values) = @_;
-         # string, but the default notes is an empty string.
+     # Don't allow undefs.
-         $retVal .= "        var myText = \"\";\n";
+     if (! defined($objectID)) {
-         $retVal .= "        var myType = \"string\";\n";
+         Confess("No object ID specified for DeleteAttribute call.");
-         $retVal .= "        switch (fieldValue) {\n";
+     } elsif (! defined($key)) {
-         # Loop through the entities.
+         Confess("No attribute key specified for DeleteAttribute call.");
-         for my $entity (@entityNames) {
+     } else {
-             # Get the entity's field hash. This has the notes in it.
+         # Split the key into the real key and the subkey.
-             my $fieldHash = $self->GetFieldTable($entity);
+         my ($realKey, $subKey) = $self->SplitKey($key);
-             # Loop through the values we might see for this entity's fields.
+         # Find the table containing the key's values.
-             my $fields = $entities{$entity};
+         my $table = $self->_KeyTable($realKey);
-             for my $value (@{$fields}) {
+         if ($subKey eq '' && scalar(@values) == 0) {
-                 # Only proceed if we have an existing field.
+             # Here we erase the entire key for this object.
-                 if ($value =~ m!/(.+)$!) {
+             $self->DeleteRow('HasValueFor', $key, $objectID);
-                     # Get the field's hash element.
+         } else {
-                     my $element = $fieldHash->{$1};
+             # Here we erase the matching values.
-                     # Generate this case.
+             my $valueString = join($self->{splitter}, @values);
-                     $retVal .= "        case \"$value\" :\n";
+             $self->DeleteRow('HasValueFor', $realKey, $objectID,
-                     # Here we either want to update the note display, the
+                              { subkey => $subKey, value => $valueString });
-                     # type display, or both.
+         }
-                     if ($noteControl) {
+     }
-                         # Here we want the notes updated.
+     # Return a one. This is for backward compatability.
-                         my $notes = $element->{Notes}->{content};
+     return 1;
-                         # Insure it's in the proper form.
+ }
-                         if ($htmlMode) {
-                             $notes = ERDB::HTMLNote($notes);
+ =head3 DeleteMatchingAttributes
-                         }
-                         # Escape it for use as a string literal.
+     my @deleted = $attrDB->DeleteMatchingAttributes($objectID, $key, @values);
-                         $notes =~ s/\n/\\n/g;
-                         $notes =~ s/"/\\"/g;
+ Delete all attributes that match the specified criteria. This is equivalent to
-                         $retVal .= "           myText = \"$notes\";\n";
+ calling L</GetAttributes> and then invoking L</DeleteAttribute> for each
-                     }
+ row found.
-                     if ($typeControl) {
-                         # Here we want the type updated.
+ =over 4
-                         my $type = $element->{type};
-                         $retVal .= "           myType = \"$type\";\n";
+ =item objectID
-                     }
-                     # Close this case.
+ ID of object whose attributes are to be deleted. If the attributes for multiple
-                     $retVal .= "           break;\n";
+ objects are to be deleted, this parameter can be specified as a list reference. If
-                 }
+ attributes are to be deleted for all objects, specify C<undef> or an empty string.
-             }
+ Finally, you can delete attributes for a range of object IDs by putting a percent
-         }
+ sign (C<%>) at the end.
-         # Close the CASE statement and make the appropriate assignments.
-         $retVal .= "        }\n";
+ =item key
-         if ($noteControl) {
-             $retVal .= "        $noteControl = myText;\n";
+ Attribute key name. A value of C<undef> or an empty string will match all
-         }
+ attribute keys. If the values are to be deletedfor multiple keys, this parameter can be
-         if ($typeControl) {
+ specified as a list reference. Finally, you can delete attributes for a range of
-             $retVal .= "        $typeControl = myType;\n";
+ keys by putting a percent sign (C<%>) at the end.
-         }
-     }
+ =item values
-     # Terminate the change function.
-     $retVal .= "    }\n";
+ List of the desired attribute values, section by section. If C<undef>
-     $retVal .= "</script>\n";
+ 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 deleted. For
+ performance reasons, only values have this extra capability.
+ =item RETURN
+ Returns a list of tuples for the attributes that were deleted, in the
+ same form as L</GetAttributes>.
+ =back
+ =cut
+ sub DeleteMatchingAttributes {
+     # Get the parameters.
+     my ($self, $objectID, $key, @values) = @_;
+     # Get the matching attributes.
+     my @retVal = $self->GetAttributes($objectID, $key, @values);
+     # Loop through the attributes, deleting them.
+     for my $tuple (@retVal) {
+         $self->DeleteAttribute(@{$tuple});
+     }
+     # Log this operation.
+     my $count = @retVal;
+     $self->LogOperation("Mass Delete", $key, "$count matching attributes deleted.");
+     # Return the deleted attributes.
+     return @retVal;
+ }
+ =head3 ChangeAttribute
+     $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues);
+ Change the value of an attribute key/value pair for an object.
+ =over 4
+ =item objectID
+ ID of the genome or feature to which the attribute is to be changed. In general, an ID that
+ starts with C<fig|> is treated as a feature ID, and an ID that is all digits and periods
+ is treated as a genome ID. For IDs of other types, this parameter should be a reference
+ to a 2-tuple consisting of the entity type name followed by the object ID.
+ =item key
+ Attribute key name. This corresponds to the name of a field in the database.
+ =item oldValues
+ One or more values identifying the key/value pair to change.
+ =item newValues
+ One or more values to be put in place of the old values.
+ =back
+ =cut
+ sub ChangeAttribute {
+     # Get the parameters.
+     my ($self, $objectID, $key, $oldValues, $newValues) = @_;
+     # Don't allow undefs.
+     if (! defined($objectID)) {
+         Confess("No object ID specified for ChangeAttribute call.");
+     } elsif (! defined($key)) {
+         Confess("No attribute key specified for ChangeAttribute call.");
+     } elsif (! defined($oldValues) || ref $oldValues ne 'ARRAY') {
+         Confess("No old values specified in ChangeAttribute call for key $key.");
+     } elsif (! defined($newValues) || ref $newValues ne 'ARRAY') {
+         Confess("No new values specified in ChangeAttribute call for key $key.");
+     } else {
+         # We do the change as a delete/add.
+         $self->DeleteAttribute($objectID, $key, @{$oldValues});
+         $self->AddAttribute($objectID, $key, @{$newValues});
+     }
+     # Return a one. We do this for backward compatability.
+     return 1;
+ }
+ =head3 EraseAttribute
+     $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.
+ =over 4
+ =item key
+ Key to erase. This must be a real key; that is, it cannot have a subkey
+ component.
+ =back
+ =cut
+ sub EraseAttribute {
+     # Get the parameters.
+     my ($self, $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.
+     return 1;
+ }
+ =head3 GetAttributeKeys
+     my @keyList = $attrDB->GetAttributeKeys($groupName);
+ Return a list of the attribute keys for a particular group.
+ =over 4
+ =item groupName
+ Name of the group whose keys are desired.
+ =item RETURN
+ Returns a list of the attribute keys for the specified group.
+ =back
+ =cut
+ sub GetAttributeKeys {
+     # Get the parameters.
+     my ($self, $groupName) = @_;
+     # Get the attributes for the specified group.
+     my @groups = $self->GetFlat(['IsInGroup'], "IsInGroup(to-link) = ?", [$groupName],
+                                 'IsInGroup(from-link)');
+     # Return the keys.
+     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
+     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>);
+ however, Genomes, Features, and Subsystems are not stored with a type name, so we need to
+ deduce the type from the ID value structure.
+ The theory here is that you can plug the ID and type directly into a Sprout database method, as
+ follows
+     my ($type, $id) = CustomAttributes::ParseID($attrList[$num]->[0]);
+     my $target = $sprout->GetEntity($type, $id);
+ =over 4
+ =item idValue
+ ID value taken from the attribute database.
+ =item RETURN
+ Returns a two-element list. The first element is the type of object indicated by the ID value,
+ and the second element is the actual object ID.
+ =back
+ =cut
+ sub ParseID {
+     # Get the parameters.
+     my ($idValue) = @_;
+     # Declare the return variables.
+     my ($type, $id);
+     # Parse the incoming ID. We first check for the presence of an entity name. Entity names
+     # can only contain letters, which helps to insure typed object IDs don't collide with
+     # subsystem names (which are untyped).
+     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);
+     } elsif ($idValue =~ /\d+\.\d+/) {
+         # Here we have a genome ID.
+         ($type, $id) = (Genome => $idValue);
+     } else {
+         # The default is a subsystem ID.
+         ($type, $id) = (Subsystem => $idValue);
+     }
+     # Return the results.
+     return ($type, $id);
+ }
+ =head3 FormID
+     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
+ must be prefixed with the object type.
+ =over 4
+ =item type
+ Relevant object type.
+ =item id
+ ID of the object in question.
+ =item RETURN
+ Returns a string that will be recognized as an object ID in the attribute database.
+ =back
+ =cut
+ sub FormID {
+     # Get the parameters.
+     my ($type, $id) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Compute the ID string from the type.
+     if (grep { $type eq $_ } qw(Feature Genome Subsystem)) {
+         $retVal = $id;
+     } else {
+         $retVal = "$type:$id";
+     }
+     # Return the result.
+     return $retVal;
+ }
+ =head3 GetTargetObject
+     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
+ specified database.
+ =over 4
+ =item erdb
+ B<ERDB> object for accessing the target database.
+ =item idValue
+ ID value retrieved from the attribute database.
+ =item RETURN
+ Returns a B<ERDBObject> for the attribute value's target object.
+ =back
+ =cut
+ sub GetTargetObject {
+     # Get the parameters.
+     my ($erdb, $idValue) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Get the type and ID for the target object.
+     my ($type, $id) = ParseID($idValue);
+     # Plug them into the GetEntity method.
+     $retVal = $erdb->GetEntity($type, $id);
+     # Return the resulting object.
+     return $retVal;
+ }
+ =head3 SplitKey
+     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,
+ then the sub key is presumed to be an empty string.
+ =over 4
+ =item key
+ Incoming key to be split.
+ =item RETURN
+ Returns a two-element list, the first element of which is the real key and the second element of
+ which is the sub key.
+ =back
+ =cut
+ sub SplitKey {
+     # Get the parameters.
+     my ($self, $key) = @_;
+     # Do the split.
+     my ($realKey, $subKey) = split($self->{splitter}, $key, 2);
+     # Insure the subkey has a value.
+     if (! defined $subKey) {
+         $subKey = '';
+     }
+     # Return the results.
+     return ($realKey, $subKey);
+ }
+ =head3 JoinKey
+     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
+ real key is the key to the B<AttributeKey> entity. The subkey is an attribute of the B<HasValueFor>
+ relationship.
+ =over 4
+ =item realKey
+ The real attribute key.
+ =item subKey
+ The subordinate portion of the attribute key.
+ =item RETURN
+ Returns a single string representing both keys.
+ =back
+ =cut
+ sub JoinKey {
+     # Get the parameters.
+     my ($self, $realKey, $subKey) = @_;
+     # Declare the return variable.
+     my $retVal;
+     # Check for a subkey.
+     if ($subKey eq '') {
+         # No subkey, so the real key is the key.
+         $retVal = $realKey;
+     } else {
+         # Subkey found, so the two pieces must be joined by a splitter.
+         $retVal = "$realKey$self->{splitter}$subKey";
+     }
+     # Return the result.
+     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 = ();
+     # We use this hash to check for duplicates.
+     my %dupHash = ();
+     # 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);
+         # Check for a duplicate.
+         my $wholeThing = join($self->{splitter}, $id, $key, $valueString);
+         if (! $dupHash{$wholeThing}) {
+             # It's okay, we're not a duplicate. Insure we don't duplicate this result.
+             $dupHash{$wholeThing} = 1;
+             # 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 (except for the last one, of course).
+         $escapedValue = $1;
+         $escapedValue =~ s/(%|_)/\\$1/g;
+         $escapedValue .= "%";
+         $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.1
 


changed lines


 
Added in v.1.35
 Legend:



Removed from v.1.1
 


changed lines


 
Added in v.1.35
-Removed from v.1.1
+Added in v.1.35

MCS Webmaster	ViewVC Help
Powered by ViewVC 1.0.3