[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.9, Thu Nov 16 22:09:33 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 22  Line 20 
20    
21  The full suite of ERDB retrieval capabilities is provided. In addition,  The full suite of ERDB retrieval capabilities is provided. In addition,
22  custom methods are provided specific to this application. To get all  custom methods are provided specific to this application. To get all
23  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
24  would code  would code
25    
26      my @values = $attrDB->GetAttributeValues($fid, Feature => 'essential');      my @values = $attrDB->GetAttributes([Feature => $fid], 'essential');
27    
28  where I<$fid> contains the ID of the desired feature. Each attribute has  where I<$fid> contains the ID of the desired feature. Each attribute has
29  an alternate index to allow searching for attributes by value.  an alternate index to allow searching for attributes by value.
# Line 78  Line 76 
76    
77  =back  =back
78    
79    The DBD file is critical, and must have reasonable contents before we can
80    begin using the system. In the old system, attributes were only provided
81    for Genomes and Features, so the initial XML file was the following.
82    
83        <Database>
84          <Title>SEED Custom Attribute Database</Title>
85          <Entities>
86            <Entity name="Feature" keyType="id-string">
87              <Notes>A [i]feature[/i] is a part of the genome
88              that is of special interest. Features may be spread
89              across multiple contigs of a genome, but never across
90              more than one genome. Features can be assigned to roles
91              via spreadsheet cells, and are the targets of
92              annotation.</Notes>
93            </Entity>
94            <Entity name="Genome" keyType="name-string">
95              <Notes>A [i]genome[/i] describes a particular individual
96              organism's DNA.</Notes>
97            </Entity>
98          </Entities>
99        </Database>
100    
101    It is not necessary to put any tables into the database; however, you should
102    run
103    
104        AttrDBRefresh
105    
106    periodically to insure it has the correct Genomes and Features in it. When
107    converting from the old system, use
108    
109        AttrDBRefresh -migrate
110    
111    to initialize the database and migrate the legacy data. You should only need
112    to do that once.
113    
114  =head2 Implementation Note  =head2 Implementation Note
115    
116  The L</Refresh> method reloads the entities in the database. If new  The L</Refresh> method reloads the entities in the database. If new
# Line 124  Line 157 
157      return $retVal;      return $retVal;
158  }  }
159    
 =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;  
 }  
   
160  =head3 StoreAttributeKey  =head3 StoreAttributeKey
161    
162  C<< my $attrDB = CustomAttributes::StoreAttributeKey($entityName, $attributeName, $type, $notes); >>  C<< my $attrDB = CustomAttributes::StoreAttributeKey($entityName, $attributeName, $type, $notes); >>
# Line 216  Line 197 
197  sub StoreAttributeKey {  sub StoreAttributeKey {
198      # Get the parameters.      # Get the parameters.
199      my ($entityName, $attributeName, $type, $notes) = @_;      my ($entityName, $attributeName, $type, $notes) = @_;
200        # Declare the return variable.
201        my $retVal;
202      # Get the data type hash.      # Get the data type hash.
203      my %types = ERDB::GetDataTypes();      my %types = ERDB::GetDataTypes();
204      # Validate the initial input values.      # Validate the initial input values.
# Line 236  Line 219 
219          # Okay, we're ready to begin. Get the entity hash and the field hash.          # Okay, we're ready to begin. Get the entity hash and the field hash.
220          my $entityData = $entityHash->{$entityName};          my $entityData = $entityHash->{$entityName};
221          my $fieldHash = ERDB::GetEntityFieldHash($metadata, $entityName);          my $fieldHash = ERDB::GetEntityFieldHash($metadata, $entityName);
222            # Compare the old attribute data to the new data.
223            my $bigChange = 1;
224            if (exists $fieldHash->{$attributeName} && $fieldHash->{$attributeName}->{type} eq $type) {
225                $bigChange = 0;
226            }
227          # Compute the attribute's relation name.          # Compute the attribute's relation name.
228          my $relName = join("", $entityName, map { ucfirst $_ } split(/-|_/, $attributeName));          my $relName = join("", $entityName, map { ucfirst $_ } split(/-|_/, $attributeName));
229          # Store the attribute's field data. Note the use of the "content" hash for          # Store the attribute's field data. Note the use of the "content" hash for
# Line 251  Line 239 
239          }          }
240          # Write the XML back out.          # Write the XML back out.
241          ERDB::WriteMetaXML($metadata, $FIG_Config::attrDBD);          ERDB::WriteMetaXML($metadata, $FIG_Config::attrDBD);
     }  
242      # Open a database with the new XML.      # Open a database with the new XML.
243      my $retVal = CustomAttributes->new();          $retVal = CustomAttributes->new();
244            # Create the table if there has been a significant change.
245            if ($bigChange) {
246                $retVal->CreateTable($relName);
247            }
248        }
249      return $retVal;      return $retVal;
250  }  }
251    
# Line 525  Line 517 
517                                                      -default => 1)                                                      -default => 1)
518                                     ),                                     ),
519                            );                            );
520      # Now the two buttons: UPDATE and DELETE.      # Now the three buttons: UPDATE, SHOW, and DELETE.
521      push @retVal, $cgi->Tr($cgi->th("&nbsp;"),      push @retVal, $cgi->Tr($cgi->th("&nbsp;"),
522                             $cgi->td({align => 'center'},                             $cgi->td({align => 'center'},
523                                      $cgi->submit(-name => 'Delete', -value => 'DELETE') . " " .                                      $cgi->submit(-name => 'Delete', -value => 'DELETE') . " " .
524                                      $cgi->submit(-name => 'Store',  -value => 'STORE')                                      $cgi->submit(-name => 'Store',  -value => 'STORE') . " " .
525                                        $cgi->submit(-name => 'Show',   -value => 'SHOW')
526                                     )                                     )
527                            );                            );
528      # Close the table and the form.      # Close the table and the form.
# Line 714  Line 707 
707    
708  =head3 MatchSqlPattern  =head3 MatchSqlPattern
709    
710  C<< my $matched = MatchSqlPattern($value, $pattern); >>  C<< my $matched = CustomAttributes::MatchSqlPattern($value, $pattern); >>
711    
712  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
713  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 719 
719    
720  =item value  =item value
721    
722  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
723  not match anything.  value will not match anything.
724    
725  =item pattern  =item pattern
726    
727  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
728  match everything.  match everything.
729    
730  =item RETURN  =item RETURN
# Line 748  Line 741 
741      # Declare the return variable.      # Declare the return variable.
742      my $retVal;      my $retVal;
743      # Insure we have a pattern.      # Insure we have a pattern.
744      if (! defined($pattern)) {      if (! defined($pattern) || $pattern eq "") {
745          $retVal = 1;          $retVal = 1;
746      } else {      } else {
747          # Break the pattern into pieces around the wildcard characters. Because we          # Break the pattern into pieces around the wildcard characters. Because we
# Line 873  Line 866 
866                  # Get the key, value, and URL. We ignore the first element because that's the                  # Get the key, value, and URL. We ignore the first element because that's the
867                  # object ID, and we already know the object ID.                  # object ID, and we already know the object ID.
868                  my (undef, $key, $value, $url) = @{$dataTuple};                  my (undef, $key, $value, $url) = @{$dataTuple};
869                    # Remove the buggy "1" for $url.
870                    if ($url eq "1") {
871                        $url = undef;
872                    }
873                  # Only proceed if this is not an old key.                  # Only proceed if this is not an old key.
874                  if (! $myOldKeys->{$key}) {                  if (! $myOldKeys->{$key}) {
875                      # See if we've run into this key before.                      # See if we've run into this key before.
# Line 930  Line 927 
927      Trace("Migration complete.") if T(2);      Trace("Migration complete.") if T(2);
928  }  }
929    
930    =head3 ComputeObjectTypeFromID
931    
932    C<< my ($entityName, $id) = CustomAttributes::ComputeObjectTypeFromID($objectID); >>
933    
934    This method will compute the entity type corresponding to a specified object ID.
935    If the object ID begins with C<fig|>, it is presumed to be a feature ID. If it
936    is all digits with a single period, it is presumed to by a genome ID. Otherwise,
937    it must be a list reference. In this last case the first list element will be
938    taken as the entity type and the second will be taken as the actual ID.
939    
940    =over 4
941    
942    =item objectID
943    
944    Object ID to examine.
945    
946    =item RETURN
947    
948    Returns a 2-element list consisting of the entity type followed by the specified ID.
949    
950    =back
951    
952    =cut
953    
954    sub ComputeObjectTypeFromID {
955        # Get the parameters.
956        my ($objectID) = @_;
957        # Declare the return variables.
958        my ($entityName, $id);
959        # Only proceed if the object ID is defined. If it's not, we'll be returning a
960        # pair of undefs.
961        if ($objectID) {
962            if (ref $objectID eq 'ARRAY') {
963                # Here we have the new-style list reference. Pull out its pieces.
964                ($entityName, $id) = @{$objectID};
965            } else {
966                # Here the ID is the outgoing ID, and we need to look at its structure
967                # to determine the entity type.
968                $id = $objectID;
969                if ($objectID =~ /^\d+\.\d+/) {
970                    # Digits with a single period is a genome.
971                    $entityName = 'Genome';
972                } elsif ($objectID =~ /^fig\|/) {
973                    # The "fig|" prefix indicates a feature.
974                    $entityName = 'Feature';
975                } else {
976                    # Anything else is illegal!
977                    Confess("Invalid attribute ID specification \"$objectID\".");
978                }
979            }
980        }
981        # Return the result.
982        return ($entityName, $id);
983    }
984    
985  =head2 FIG Method Replacements  =head2 FIG Method Replacements
986    
987  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 989 
989  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
990  capabilities were used in the old system.  capabilities were used in the old system.
991    
992    The methods here are the only ones supported by the B<RemoteCustomAttributes> object.
993    The idea is that these methods represent attribute manipulation allowed by all users, while
994    the others are only for privileged users with access to the attribute server.
995    
996  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,
997  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
998  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 1010 
1010    
1011  =head3 GetAttributes  =head3 GetAttributes
1012    
 C<< my @attributeList = GetAttributes($objectID, $key, @valuePatterns); >>  
   
 or  
   
1013  C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @valuePatterns); >>  C<< my @attributeList = $attrDB->GetAttributes($objectID, $key, @valuePatterns); >>
1014    
 The first form will connect to the database and release it. The second form  
 uses the database connection contained in the object.  
   
1015  In the database, attribute values are sectioned into pieces using a splitter  In the database, attribute values are sectioned into pieces using a splitter
1016  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
1017  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 1078 
1078  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
1079  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
1080  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
1081  C<undef> here will match all objects.  C<undef> or an empty string here will match all objects.
1082    
1083  =item key  =item key
1084    
# Line 1037  Line 1086 
1086  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
1087  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
1088  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
1089  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
1090    attribute keys.
1091    
1092  =item valuePatterns  =item valuePatterns
1093    
1094  List of the desired attribute values, section by section. If C<undef>  List of the desired attribute values, section by section. If C<undef>
1095  is specified, all values in that section will match.  or an empty string is specified, all values in that section will match.
1096    
1097  =item RETURN  =item RETURN
1098    
# Line 1056  Line 1106 
1106  =cut  =cut
1107    
1108  sub GetAttributes {  sub GetAttributes {
1109      # Connect to the database. The tricky part is knowing whether or not we      # Get the parameters.
1110      # 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) = @_;  
1111      # Declare the return variable.      # Declare the return variable.
1112      my @retVal = ();      my @retVal = ();
1113      # Determine the entity types for our search.      # Determine the entity types for our search.
1114      my @objects = ();      my @objects = ();
1115      my ($actualObjectID, $computedType);      my ($actualObjectID, $computedType);
1116      if (! defined($objectID)) {      if (! $objectID) {
1117          push @objects, $self->GetEntityTypes();          push @objects, $self->GetEntityTypes();
1118      } else {      } else {
1119          ($computedType, $actualObjectID) = ComputeObjectTypeFromID($objectID);          ($computedType, $actualObjectID) = ComputeObjectTypeFromID($objectID);
# Line 1081  Line 1126 
1126          # MatchSqlPattern method          # MatchSqlPattern method
1127          my %secondaries = $self->GetSecondaryFields($entityType);          my %secondaries = $self->GetSecondaryFields($entityType);
1128          my @fieldList = grep { MatchSqlPattern($_, $key) } keys %secondaries;          my @fieldList = grep { MatchSqlPattern($_, $key) } keys %secondaries;
1129          # 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. We will always
1130            # filter by key to a limited extent, so if we're filtering by object we need an
1131            # AND to join the object ID filter with the key filter.
1132          my $filter = "";          my $filter = "";
1133          my @params = ();          my @params = ();
1134          if (defined($actualObjectID)) {          if (defined($actualObjectID)) {
1135              # Here the caller wants to filter on object ID.              # Here the caller wants to filter on object ID. Check for a pattern.
1136              $filter = "$entityType(id) = ?";              my $comparator = ($actualObjectID =~ /%/ ? "LIKE" : "=");
1137                # Update the filter and the parameter list.
1138                $filter = "$entityType(id) $comparator ? AND ";
1139              push @params, $actualObjectID;              push @params, $actualObjectID;
1140          }          }
1141          # It's time to begin making queries. We process one attribute key at a time, because          # It's time to begin making queries. We process one attribute key at a time, because
# Line 1095  Line 1144 
1144          # the DBD. That's a good thing, because an invalid key name will cause an SQL error.          # the DBD. That's a good thing, because an invalid key name will cause an SQL error.
1145          for my $key (@fieldList) {          for my $key (@fieldList) {
1146              # Get all of the attribute values for this key.              # Get all of the attribute values for this key.
1147              my @dataRows = $self->GetAll([$entityType], $filter, \@params,              my @dataRows = $self->GetAll([$entityType], "$filter$entityType($key) IS NOT NULL",
1148                                           ["$entityType(id)", "$entityType($key)"]);                                           \@params, ["$entityType(id)", "$entityType($key)"]);
1149              # Process each value separately. We need to verify the values and reformat the              # Process each value separately. We need to verify the values and reformat the
1150              # tuples. Note that GetAll will give us one row per matching object ID,              # tuples. Note that GetAll will give us one row per matching object ID,
1151              # with the ID first followed by a list of the data values. This is very              # with the ID first followed by a list of the data values. This is very
# Line 1139  Line 1188 
1188    
1189  C<< $attrDB->AddAttribute($objectID, $key, @values); >>  C<< $attrDB->AddAttribute($objectID, $key, @values); >>
1190    
 or  
   
 C<< AddAttribute($objectID, $key, @values); >>  
   
1191  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
1192  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.
1193    
 The first form will connect to the database and release it. The second form  
 uses the database connection contained in the object.  
   
1194  =over 4  =over 4
1195    
1196  =item objectID  =item objectID
# Line 1173  Line 1215 
1215  =cut  =cut
1216    
1217  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());  
1218      # Get the parameters.      # Get the parameters.
1219      my ($objectID, $key, @values) = @_;      my ($self, $objectID, $key, @values) = @_;
1220      # Don't allow undefs.      # Don't allow undefs.
1221      if (! defined($objectID)) {      if (! defined($objectID)) {
1222          Confess("No object ID specified for AddAttribute call.");          Confess("No object ID specified for AddAttribute call.");
# Line 1204  Line 1241 
1241    
1242  C<< $attrDB->DeleteAttribute($objectID, $key, @values); >>  C<< $attrDB->DeleteAttribute($objectID, $key, @values); >>
1243    
 or  
   
 C<< DeleteAttribute($objectID, $key, @values); >>  
   
1244  Delete the specified attribute key/value combination from the database.  Delete the specified attribute key/value combination from the database.
1245    
1246  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 1268 
1268  =cut  =cut
1269    
1270  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());  
1271      # Get the parameters.      # Get the parameters.
1272      my ($objectID, $key, @values) = @_;      my ($self, $objectID, $key, @values) = @_;
1273      # Don't allow undefs.      # Don't allow undefs.
1274      if (! defined($objectID)) {      if (! defined($objectID)) {
1275          Confess("No object ID specified for DeleteAttribute call.");          Confess("No object ID specified for DeleteAttribute call.");
# Line 1261  Line 1289 
1289      return 1;      return 1;
1290  }  }
1291    
 =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);  
 }  
   
1292  =head3 ChangeAttribute  =head3 ChangeAttribute
1293    
1294  C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>  C<< $attrDB->ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>
1295    
 or  
   
 C<< ChangeAttribute($objectID, $key, \@oldValues, \@newValues); >>  
   
1296  Change the value of an attribute key/value pair for an object.  Change the value of an attribute key/value pair for an object.
1297    
 The first form will connect to the database and release it. The second form  
 uses the database connection contained in the object.  
   
1298  =over 4  =over 4
1299    
1300  =item objectID  =item objectID
# Line 1355  Line 1321 
1321  =cut  =cut
1322    
1323  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());  
1324      # Get the parameters.      # Get the parameters.
1325      my ($objectID, $key, $oldValues, $newValues) = @_;      my ($self, $objectID, $key, $oldValues, $newValues) = @_;
1326      # Don't allow undefs.      # Don't allow undefs.
1327      if (! defined($objectID)) {      if (! defined($objectID)) {
1328          Confess("No object ID specified for ChangeAttribute call.");          Confess("No object ID specified for ChangeAttribute call.");
# Line 1380  Line 1341 
1341      return 1;      return 1;
1342  }  }
1343    
1344    =head3 EraseAttribute
1345    
1346    C<< $attrDB->EraseAttribute($entityName, $key); >>
1347    
1348    Erase all values for the specified attribute key. This does not remove the
1349    key from the database; it merely removes all the values.
1350    
1351    =over 4
1352    
1353    =item entityName
1354    
1355    Name of the entity to which the key belongs. If undefined, all entities will be
1356    examined for the desired key.
1357    
1358    =item key
1359    
1360    Key to erase.
1361    
1362    =back
1363    
1364    =cut
1365    
1366    sub EraseAttribute {
1367        # Get the parameters.
1368        my ($self, $entityName, $key) = @_;
1369        # Determine the relevant entity types.
1370        my @objects = ();
1371        if (! $entityName) {
1372            push @objects, $self->GetEntityTypes();
1373        } else {
1374            push @objects, $entityName;
1375        }
1376        # Loop through the entity types.
1377        for my $entityType (@objects) {
1378            # Now check for this key in this entity.
1379            my %secondaries = $self->GetSecondaryFields($entityType);
1380            if (exists $secondaries{$key}) {
1381                # We found it, so delete all the values of the key.
1382                $self->DeleteValue($entityType, undef, $key);
1383            }
1384        }
1385        # Return a 1, for backward compatability.
1386        return 1;
1387    }
1388    
1389    =head3 GetAttributeKeys
1390    
1391    C<< my @keyList = $attrDB->GetAttributeKeys($entityName); >>
1392    
1393    Return a list of the attribute keys for a particular entity type.
1394    
1395    =over 4
1396    
1397    =item entityName
1398    
1399    Name of the entity whose keys are desired.
1400    
1401    =item RETURN
1402    
1403    Returns a list of the attribute keys for the specified entity.
1404    
1405    =back
1406    
1407    =cut
1408    
1409    sub GetAttributeKeys {
1410        # Get the parameters.
1411        my ($self, $entityName) = @_;
1412        # Get the entity's secondary fields.
1413        my %keyList = $self->GetSecondaryFields($entityName);
1414        # Return the keys.
1415        return sort keys %keyList;
1416    }
1417    
1418  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3