[Bio] / Sprout / CustomAttributes.pm Repository:
ViewVC logotype

Diff of /Sprout/CustomAttributes.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3, Thu Nov 9 21:19:53 2006 UTC revision 1.4, Fri Nov 10 21:00:14 2006 UTC
# Line 4  Line 4 
4    
5      require Exporter;      require Exporter;
6      use ERDB;      use ERDB;
7      @ISA = qw(Exporter ERDB);      @ISA = qw(ERDB);
     @EXPORT = qw(GetAttributes AddAttribute DeleteAttribute ChangeAttribute MatchSqlPattern);  
8      use strict;      use strict;
9      use Tracer;      use Tracer;
     use FIG;  
10      use ERDBLoad;      use ERDBLoad;
11    
12  =head1 Custom SEED Attribute Manager  =head1 Custom SEED Attribute Manager
# Line 124  Line 122 
122      return $retVal;      return $retVal;
123  }  }
124    
 =head3 GetAttributeValues  
   
 C<< my @values = $attrDB->GetAttributeValues($id, $entityName => $attributeName); >>  
   
 Return all the values of the specified attribute for the specified entity instance.  
 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:  
   
     my @values = $sttrDB->GetAttributeValues($fid, Feature => 'essential');  
   
 Here the user is asking for the values of the C<essential> attribute for the  
 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  
   
 =item id  
   
 ID of the desired entity instance. This identifies the specific object to  
 be interrogated for attribute values.  
   
 =item entityName  
   
 Name of the entity. This identifies the the type of the object to be  
 interrogated for attribute values.  
   
 =item attributeName  
   
 Name of the desired attribute.  
   
 =item RETURN  
   
 Returns zero or more strings, each representing a value of the named attribute  
 for the specified entity instance.  
   
 =back  
   
 =cut  
   
 sub GetAttributeValues {  
     # Get the parameters.  
     my ($self, $id, $entityName, $attributeName) = @_;  
     # Get the data.  
     my @retVal = $self->GetEntityValues($entityName, $id, ["$entityName($attributeName)"]);  
     # Return the result.  
     return @retVal;  
 }  
   
125  =head3 StoreAttributeKey  =head3 StoreAttributeKey
126    
127  C<< my $attrDB = CustomAttributes::StoreAttributeKey($entityName, $attributeName, $type, $notes); >>  C<< my $attrDB = CustomAttributes::StoreAttributeKey($entityName, $attributeName, $type, $notes); >>
# Line 714  Line 660 
660    
661  =head3 MatchSqlPattern  =head3 MatchSqlPattern
662    
663  C<< my $matched = MatchSqlPattern($value, $pattern); >>  C<< my $matched = CustomAttributes::MatchSqlPattern($value, $pattern); >>
664    
665  Determine whether or not a specified value matches an SQL pattern. An SQL  Determine whether or not a specified value matches an SQL pattern. An SQL
666  pattern has two wild card characters: C<%> that matches multiple characters,  pattern has two wild card characters: C<%> that matches multiple characters,
# Line 726  Line 672 
672    
673  =item value  =item value
674    
675  Value to be matched against the pattern. Note that an undefined value will  Value to be matched against the pattern. Note that an undefined or empty
676  not match anything.  value will not match anything.
677    
678  =item pattern  =item pattern
679    
680  SQL pattern against which to match the value. An undefined pattern will  SQL pattern against which to match the value. An undefined or empty pattern will
681  match everything.  match everything.
682    
683  =item RETURN  =item RETURN
# Line 748  Line 694 
694      # Declare the return variable.      # Declare the return variable.
695      my $retVal;      my $retVal;
696      # Insure we have a pattern.      # Insure we have a pattern.
697      if (! defined($pattern)) {      if (! defined($pattern) || $pattern eq "") {
698          $retVal = 1;          $retVal = 1;
699      } else {      } else {
700          # Break the pattern into pieces around the wildcard characters. Because we          # Break the pattern into pieces around the wildcard characters. Because we
# Line 930  Line 876 
876      Trace("Migration complete.") if T(2);      Trace("Migration complete.") if T(2);
877  }  }
878    
879    =head3 ComputeObjectTypeFromID
880    
881    C<< my ($entityName, $id) = CustomAttributes::ComputeObjectTypeFromID($objectID); >>
882    
883    This method will compute the entity type corresponding to a specified object ID.
884    If the object ID begins with C<fig|>, it is presumed to be a feature ID. If it
885    is all digits with a single period, it is presumed to by a genome ID. Otherwise,
886    it must be a list reference. In this last case the first list element will be
887    taken as the entity type and the second will be taken as the actual ID.
888    
889    =over 4
890    
891    =item objectID
892    
893    Object ID to examine.
894    
895    =item RETURN
896    
897    Returns a 2-element list consisting of the entity type followed by the specified ID.
898    
899    =back
900    
901    =cut
902    
903    sub ComputeObjectTypeFromID {
904        # Get the parameters.
905        my ($objectID) = @_;
906        # Declare the return variables.
907        my ($entityName, $id);
908        # Only proceed if the object ID is defined. If it's not, we'll be returning a
909        # pair of undefs.
910        if ($objectID) {
911            if (ref $objectID eq 'ARRAY') {
912                # Here we have the new-style list reference. Pull out its pieces.
913                ($entityName, $id) = @{$objectID};
914            } else {
915                # Here the ID is the outgoing ID, and we need to look at its structure
916                # to determine the entity type.
917                $id = $objectID;
918                if ($objectID =~ /^\d+\.\d+/) {
919                    # Digits with a single period is a genome.
920                    $entityName = 'Genome';
921                } elsif ($objectID =~ /^fig\|/) {
922                    # The "fig|" prefix indicates a feature.
923                    $entityName = 'Feature';
924                } else {
925                    # Anything else is illegal!
926                    Confess("Invalid attribute ID specification \"$objectID\".");
927                }
928            }
929        }
930        # Return the result.
931        return ($entityName, $id);
932    }
933    
934  =head2 FIG Method Replacements  =head2 FIG Method Replacements
935    
936  The following methods are used by B<FIG.pm> to replace the previous attribute functionality.  The following methods are used by B<FIG.pm> to replace the previous attribute functionality.
# Line 937  Line 938 
938  supported and there is no longer any searching by URL. Fortunately, neither of these  supported and there is no longer any searching by URL. Fortunately, neither of these
939  capabilities were used in the old system.  capabilities were used in the old system.
940    
941    The methods here are the only ones supported by the B<RemoteCustomAttributes> object.
942    The idea is that these methods represent attribute manipulation allowed by all users, while
943    the others are only for privileged users with access to the attribute server.
944    
945  In the previous implementation, an attribute had a value and a URL. In the new implementation,  In the previous implementation, an attribute had a value and a URL. In the new implementation,
946  there is only a value. In this implementation, each attribute has only a value. These  there is only a value. In this implementation, each attribute has only a value. These
947  methods will treat the value as a list with the individual elements separated by the  methods will treat the value as a list with the individual elements separated by the
# Line 954  Line 959 
959    
960  =head3 GetAttributes  =head3 GetAttributes
961    
 C<< my @attributeList = GetAttributes($objectID, $key, @valuePatterns); >>  
   
 or  
   
962  C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @valuePatterns); >>  C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @valuePatterns); >>
963    
 The first form will connect to the database and release it. The second form  
 uses the database connection contained in the object.  
   
964  In the database, attribute values are sectioned into pieces using a splitter  In the database, attribute values are sectioned into pieces using a splitter
965  value specified in the constructor (L</new>). This is not a requirement of  value specified in the constructor (L</new>). This is not a requirement of
966  the attribute system as a whole, merely a convenience for the purpose of  the attribute system as a whole, merely a convenience for the purpose of
# Line 1029  Line 1027 
1027  starts with C<fig|> is treated as a feature ID, and an ID that is all digits with a  starts with C<fig|> is treated as a feature ID, and an ID that is all digits with a
1028  single period is treated as a genome ID. For other entity types, use a list reference; in  single period is treated as a genome ID. For other entity types, use a list reference; in
1029  this case the first list element is the entity type and the second is the ID. A value of  this case the first list element is the entity type and the second is the ID. A value of
1030  C<undef> here will match all objects.  C<undef> or an empty string here will match all objects.
1031    
1032  =item key  =item key
1033    
# Line 1037  Line 1035 
1035  field name equal to the key name, it is very fast to find a list of all the  field name equal to the key name, it is very fast to find a list of all the
1036  matching keys. Each key's values require a separate query, however, which may  matching keys. Each key's values require a separate query, however, which may
1037  be a performance problem if the pattern matches a lot of keys. Wild cards are  be a performance problem if the pattern matches a lot of keys. Wild cards are
1038  acceptable here, and a value of C<undef> will match all attribute keys.  acceptable here, and a value of C<undef> or an empty string will match all
1039    attribute keys.
1040    
1041  =item valuePatterns  =item valuePatterns
1042    
1043  List of the desired attribute values, section by section. If C<undef>  List of the desired attribute values, section by section. If C<undef>
1044  is specified, all values in that section will match.  or an empty string is specified, all values in that section will match.
1045    
1046  =item RETURN  =item RETURN
1047    
# Line 1056  Line 1055 
1055  =cut  =cut
1056    
1057  sub GetAttributes {  sub GetAttributes {
1058      # Connect to the database. The tricky part is knowing whether or not we      # Get the parameters.
1059      # are an instance method (in which case the first parameter is a      my ($self, $objectID, $key, @valuePatterns) = @_;
     # CustomAttributes object) or a static method (in which case we must  
     # connect manually.  
     my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new());  
     # Get the remaining parameters.  
     my ($objectID, $key, @valuePatterns) = @_;  
1060      # Declare the return variable.      # Declare the return variable.
1061      my @retVal = ();      my @retVal = ();
1062      # Determine the entity types for our search.      # Determine the entity types for our search.
1063      my @objects = ();      my @objects = ();
1064      my ($actualObjectID, $computedType);      my ($actualObjectID, $computedType);
1065      if (! defined($objectID)) {      if (! $objectID) {
1066          push @objects, $self->GetEntityTypes();          push @objects, $self->GetEntityTypes();
1067      } else {      } else {
1068          ($computedType, $actualObjectID) = ComputeObjectTypeFromID($objectID);          ($computedType, $actualObjectID) = ComputeObjectTypeFromID($objectID);
# Line 1084  Line 1078 
1078          # Now we figure out whether or not we need to filter by object.          # Now we figure out whether or not we need to filter by object.
1079          my $filter = "";          my $filter = "";
1080          my @params = ();          my @params = ();
1081          if (defined($actualObjectID)) {          if (! $actualObjectID) {
1082              # Here the caller wants to filter on object ID.              # Here the caller wants to filter on object ID.
1083              $filter = "$entityType(id) = ?";              $filter = "$entityType(id) = ?";
1084              push @params, $actualObjectID;              push @params, $actualObjectID;
# Line 1139  Line 1133 
1133    
1134  C<< $attrDB->AddAttribute($objectID, $key, @values); >>  C<< $attrDB->AddAttribute($objectID, $key, @values); >>
1135    
 or  
   
 C<< AddAttribute($objectID, $key, @values); >>  
   
1136  Add an attribute key/value pair to an object. This method cannot add a new key, merely  Add an attribute key/value pair to an object. This method cannot add a new key, merely
1137  add a value to an existing key. Use L</StoreAttributeKey> to create a new key.  add a value to an existing key. Use L</StoreAttributeKey> to create a new key.
1138    
 The first form will connect to the database and release it. The second form  
 uses the database connection contained in the object.  
   
1139  =over 4  =over 4
1140    
1141  =item objectID  =item objectID
# Line 1173  Line 1160 
1160  =cut  =cut
1161    
1162  sub AddAttribute {  sub AddAttribute {
     # Connect to the database. The tricky part is knowing whether or not we  
     # are an instance method (in which case the first parameter is a  
     # CustomAttributes object) or a static method (in which case we must  
     # connect manually.  
     my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new());  
1163      # Get the parameters.      # Get the parameters.
1164      my ($objectID, $key, @values) = @_;      my ($self, $objectID, $key, @values) = @_;
1165      # Don't allow undefs.      # Don't allow undefs.
1166      if (! defined($objectID)) {      if (! defined($objectID)) {
1167          Confess("No object ID specified for AddAttribute call.");          Confess("No object ID specified for AddAttribute call.");
# Line 1204  Line 1186 
1186    
1187  C<< $attrDB->DeleteAttribute($objectID, $key, @values); >>  C<< $attrDB->DeleteAttribute($objectID, $key, @values); >>
1188    
 or  
   
 C<< DeleteAttribute($objectID, $key, @values); >>  
   
1189  Delete the specified attribute key/value combination from the database.  Delete the specified attribute key/value combination from the database.
1190    
1191  The first form will connect to the database and release it. The second form  The first form will connect to the database and release it. The second form
# Line 1235  Line 1213 
1213  =cut  =cut
1214    
1215  sub DeleteAttribute {  sub DeleteAttribute {
     # Connect to the database. The tricky part is knowing whether or not we  
     # are an instance method (in which case the first parameter is a  
     # CustomAttributes object) or a static method (in which case we must  
     # connect manually.  
     my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new());  
1216      # Get the parameters.      # Get the parameters.
1217      my ($objectID, $key, @values) = @_;      my ($self, $objectID, $key, @values) = @_;
1218      # Don't allow undefs.      # Don't allow undefs.
1219      if (! defined($objectID)) {      if (! defined($objectID)) {
1220          Confess("No object ID specified for DeleteAttribute call.");          Confess("No object ID specified for DeleteAttribute call.");
# Line 1261  Line 1234 
1234      return 1;      return 1;
1235  }  }
1236    
 =head3 ComputeObjectTypeFromID  
   
 C<< my ($entityName, $id) = CustomAttributes::ComputeObjectTypeFromID($objectID); >>  
   
 This method will compute the entity type corresponding to a specified object ID.  
 If the object ID begins with C<fig|>, it is presumed to be a feature ID. If it  
 is all digits with a single period, it is presumed to by a genome ID. Otherwise,  
 it must be a list reference. In this last case the first list element will be  
 taken as the entity type and the second will be taken as the actual ID.  
   
 =over 4  
   
 =item objectID  
   
 Object ID to examine.  
   
 =item RETURN  
   
 Returns a 2-element list consisting of the entity type followed by the specified ID.  
   
 =back  
   
 =cut  
   
 sub ComputeObjectTypeFromID {  
     # Get the parameters.  
     my ($objectID) = @_;  
     # Declare the return variables.  
     my ($entityName, $id);  
     # Only proceed if the object ID is defined. If it's not, we'll be returning a  
     # pair of undefs.  
     if (defined($objectID)) {  
         if (ref $objectID eq 'ARRAY') {  
             # Here we have the new-style list reference. Pull out its pieces.  
             ($entityName, $id) = @{$objectID};  
         } else {  
             # Here the ID is the outgoing ID, and we need to look at its structure  
             # to determine the entity type.  
             $id = $objectID;  
             if ($objectID =~ /^\d+\.\d+/) {  
                 # Digits with a single period is a genome.  
                 $entityName = 'Genome';  
             } elsif ($objectID =~ /^fig\|/) {  
                 # The "fig|" prefix indicates a feature.  
                 $entityName = 'Feature';  
             } else {  
                 # Anything else is illegal!  
                 Confess("Invalid attribute ID specification \"$objectID\".");  
             }  
         }  
     }  
     # Return the result.  
     return ($entityName, $id);  
 }  
   
1237  =head3 ChangeAttribute  =head3 ChangeAttribute
1238    
1239  C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>  C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>
1240    
 or  
   
 C<< ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>  
   
1241  Change the value of an attribute key/value pair for an object.  Change the value of an attribute key/value pair for an object.
1242    
 The first form will connect to the database and release it. The second form  
 uses the database connection contained in the object.  
   
1243  =over 4  =over 4
1244    
1245  =item objectID  =item objectID
# Line 1355  Line 1266 
1266  =cut  =cut
1267    
1268  sub ChangeAttribute {  sub ChangeAttribute {
     # Connect to the database. The tricky part is knowing whether or not we  
     # are an instance method (in which case the first parameter is a  
     # CustomAttributes object) or a static method (in which case we must  
     # connect manually.  
     my $self = (UNIVERSAL::isa($_[0],__PACKAGE__) ? shift @_ : CustomAttributes->new());  
1269      # Get the parameters.      # Get the parameters.
1270      my ($objectID, $key, $oldValues, $newValues) = @_;      my ($self, $objectID, $key, $oldValues, $newValues) = @_;
1271      # Don't allow undefs.      # Don't allow undefs.
1272      if (! defined($objectID)) {      if (! defined($objectID)) {
1273          Confess("No object ID specified for ChangeAttribute call.");          Confess("No object ID specified for ChangeAttribute call.");

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3