[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.14, Wed Dec 20 20:04:23 2006 UTC revision 1.15, Tue Jan 9 01:49:08 2007 UTC
# Line 271  Line 271 
271                  my ($id, $value) = ($fields[$idCol], $fields[$dataCol]);                  my ($id, $value) = ($fields[$idCol], $fields[$dataCol]);
272                  # Denote we're using this input line.                  # Denote we're using this input line.
273                  $retVal->Add(lineUsed => 1);                  $retVal->Add(lineUsed => 1);
                 # Now the fun begins. Find out if we need to create a target object record for this object ID.  
                 if (! exists $objectIDs{$id}) {  
                     my $found = $self->Exists('TargetObject', $id);  
                     if (! $found) {  
                         $self->InsertObject('TargetObject', { id => $id });  
                     }  
                     $objectIDs{$id} = 1;  
                     $retVal->Add(newObject => 1);  
                 }  
274                  # Now we insert the attribute.                  # Now we insert the attribute.
275                  $self->InsertObject('HasValueFor', { from => $keyName, to => $id, value => $value });                  $self->InsertObject('HasValueFor', { from => $keyName, to => $id,
276                                                         keywords => $self->_KeywordString($keyName, $value),
277                                                         value => $value });
278                  $retVal->Add(newValue => 1);                  $retVal->Add(newValue => 1);
279              }              }
280          }          }
# Line 983  Line 976 
976      return %retVal;      return %retVal;
977  }  }
978    
979    =head2 Internal Utility Methods
980    
981    =head3 _KeywordString
982    
983    C<< my $keywordString = $ca->_KeywordString($key, $value); >>
984    
985    Compute the keyword string for a specified key/value pair. This consists of the
986    key name and value converted to lower case with underscores translated to spaces.
987    
988    This method is for internal use only. It is called whenever we need to update or
989    insert a B<HasValueFor> record.
990    
991    =over 4
992    
993    =item key
994    
995    Name of the relevant attribute key.
996    
997    =item target
998    
999    ID of the target object to which this key/value pair will be associated.
1000    
1001    =item value
1002    
1003    The value to store for this key/object combination.
1004    
1005    =item RETURN
1006    
1007    Returns the value that should be stored as the keyword string for the specified
1008    key/value pair.
1009    
1010    =back
1011    
1012    =cut
1013    
1014    sub _KeywordString {
1015        # Get the parameters.
1016        my ($self, $key, $value) = @_;
1017        # Get a copy of the key name and convert underscores to spaces.
1018        my $keywordString = $key;
1019        $keywordString =~ s/_/ /g;
1020        # Add the value convert it all to lower case.
1021        my $retVal = lc "$keywordString $value";
1022        # Return the result.
1023        return $retVal;
1024    }
1025    
1026    =head3 _QueryResults
1027    
1028    C<< my @attributeList = $attrDB->_QueryResults($query, @values); >>
1029    
1030    Match the results of a B<HasValueFor> query against value criteria and return
1031    the results. This is an internal method that splits the values coming back
1032    and matches the sections against the specified section patterns. It serves
1033    as the back end to L</GetAttributes> and L</FindAttributes>.
1034    
1035    =over 4
1036    
1037    =item query
1038    
1039    A query object that will return the desired B<HasValueFor> records.
1040    
1041    =item values
1042    
1043    List of the desired attribute values, section by section. If C<undef>
1044    or an empty string is specified, all values in that section will match. A
1045    generic match can be requested by placing a percent sign (C<%>) at the end.
1046    In that case, all values that match up to and not including the percent sign
1047    will match. You may also specify a regular expression enclosed
1048    in slashes. All values that match the regular expression will be returned. For
1049    performance reasons, only values have this extra capability.
1050    
1051    =item RETURN
1052    
1053    Returns a list of tuples. The first element in the tuple is an object ID, the
1054    second is an attribute key, and the remaining elements are the sections of
1055    the attribute value. All of the tuples will match the criteria set forth in
1056    the parameter list.
1057    
1058    =back
1059    
1060    =cut
1061    
1062    sub _QueryResults {
1063        # Get the parameters.
1064        my ($self, $query, @values) = @_;
1065        # Declare the return value.
1066        my @retVal = ();
1067        # Get the number of value sections we have to match.
1068        my $sectionCount = scalar(@values);
1069        # Loop through the assignments found.
1070        while (my $row = $query->Fetch()) {
1071            # Get the current row's data.
1072            my ($id, $key, $valueString) = $row->Values(['HasValueFor(to-link)', 'HasValueFor(from-link)',
1073                                                          'HasValueFor(value)']);
1074            # Break the value into sections.
1075            my @sections = split($self->{splitter}, $valueString);
1076            # Match each section against the incoming values. We'll assume we're
1077            # okay unless we learn otherwise.
1078            my $matching = 1;
1079            for (my $i = 0; $i < $sectionCount && $matching; $i++) {
1080                # We need to check to see if this section is generic.
1081                my $value = $values[$i];
1082                Trace("Current value pattern is \"$value\".") if T(4);
1083                if (substr($value, -1, 1) eq '%') {
1084                    Trace("Generic match used.") if T(4);
1085                    # Here we have a generic match.
1086                    my $matchLen = length($values[$i] - 1);
1087                    $matching = substr($sections[$i], 0, $matchLen) eq
1088                                substr($values[$i], 0, $matchLen);
1089                } elsif ($value =~ m#^/(.+)/[a-z]*$#) {
1090                    Trace("Regular expression detected.") if T(4);
1091                    # Here we have a regular expression match.
1092                    my $section = $sections[$i];
1093                    $matching = eval("\$section =~ $value");
1094                } else {
1095                    # Here we have a strict match.
1096                    Trace("Strict match used.") if T(4);
1097                    $matching = ($sections[$i] eq $values[$i]);
1098                }
1099            }
1100            # If we match, output this row to the return list.
1101            if ($matching) {
1102                push @retVal, [$id, $key, @sections];
1103            }
1104        }
1105        # Return the rows found.
1106        return @retVal;
1107    }
1108    
1109  =head2 FIG Method Replacements  =head2 FIG Method Replacements
1110    
1111  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 1151  Line 1274 
1274      # Now @filter contains one or more filter strings and @parms contains the parameter      # Now @filter contains one or more filter strings and @parms contains the parameter
1275      # values to bind to them.      # values to bind to them.
1276      my $actualFilter = join(" AND ", @filter);      my $actualFilter = join(" AND ", @filter);
     # Declare the return variable.  
     my @retVal = ();  
     # Get the number of value sections we have to match.  
     my $sectionCount = scalar(@values);  
1277      # Now we're ready to make our query.      # Now we're ready to make our query.
1278      my $query = $self->Get(['HasValueFor'], $actualFilter, \@parms);      my $query = $self->Get(['HasValueFor'], $actualFilter, \@parms);
1279      # Loop through the assignments found.      # Format the results.
1280      while (my $row = $query->Fetch()) {      my @retVal = $self->_QueryResults($query, @values);
         # Get the current row's data.  
         my ($id, $key, $valueString) = $row->Values(['HasValueFor(to-link)', 'HasValueFor(from-link)',  
                                                       'HasValueFor(value)']);  
         # Break the value into sections.  
         my @sections = split($self->{splitter}, $valueString);  
         # Match each section against the incoming values. We'll assume we're  
         # okay unless we learn otherwise.  
         my $matching = 1;  
         for (my $i = 0; $i < $sectionCount && $matching; $i++) {  
             # We need to check to see if this section is generic.  
             my $value = $values[$i];  
             Trace("Current value pattern is \"$value\".") if T(4);  
             if (substr($value, -1, 1) eq '%') {  
                 Trace("Generic match used.") if T(4);  
                 # Here we have a generic match.  
                 my $matchLen = length($values[$i] - 1);  
                 $matching = substr($sections[$i], 0, $matchLen) eq  
                             substr($values[$i], 0, $matchLen);  
             } elsif ($value =~ m#^/(.+)/[a-z]*$#) {  
                 Trace("Regular expression detected.") if T(4);  
                 # Here we have a regular expression match.  
                 my $section = $sections[$i];  
                 $matching = eval("\$section =~ $value");  
             } else {  
                 # Here we have a strict match.  
                 Trace("Strict match used.") if T(4);  
                 $matching = ($sections[$i] eq $values[$i]);  
             }  
         }  
         # If we match, output this row to the return list.  
         if ($matching) {  
             push @retVal, [$id, $key, @sections];  
         }  
     }  
1281      # Return the rows found.      # Return the rows found.
1282      return @retVal;      return @retVal;
1283  }  }
1284    
1285    =head3 FindAttributes
1286    
1287    C<< my @attributeList = $attrDB->FindAttributes($searchString); >>
1288    
1289    Search for attributes relevant to a specified keyword. This method performs
1290    a full-text search for attribute data. It returns the same information as
1291    L</GetAttributes>, except instead of filtering on specific keys or objects we do
1292    a text search of the entire <strong>HasValueFor</strong> table.
1293    
1294    =over 4
1295    
1296    =item searchString
1297    
1298    Search string to use. The syntax is the same as it is for any ERDB keyword
1299    search.
1300    
1301    =item RETURN
1302    
1303    Returns a list of tuples. The first element in the tuple is an object ID, the
1304    second is an attribute key, and the remaining elements are the sections of
1305    the attribute value. All of the tuples will match the criteria expressed in
1306    the search string.
1307    
1308    =back
1309    
1310    =cut
1311    
1312    sub FindAttributes {
1313        # Get the parameters.
1314        my ($self, $searchString) = @_;
1315        # Search the database.
1316        my $query = $self->Search($searchString, 0, ['HasValueFor'], "", []);
1317        # Build the results from the query.
1318        my @retVal = $self->_QueryResults($query);
1319        # Return the result.
1320        return @retVal;
1321    }
1322    
1323  =head3 AddAttribute  =head3 AddAttribute
1324    
1325  C<< $attrDB->AddAttribute($objectID, $key, @values); >>  C<< $attrDB->AddAttribute($objectID, $key, @values); >>
# Line 1241  Line 1364 
1364          # Connect the object to the key.          # Connect the object to the key.
1365          $self->InsertObject('HasValueFor', { 'from-link' => $key,          $self->InsertObject('HasValueFor', { 'from-link' => $key,
1366                                               'to-link'   => $objectID,                                               'to-link'   => $objectID,
1367                                                 'keywords' => $self->_KeywordString($key, $valueString),
1368                                               'value'     => $valueString,                                               'value'     => $valueString,
1369                                         });                                         });
1370      }      }
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
MCS Webmaster
 ViewVC Help
Powered by ViewVC 1.0.3