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

Diff of /Sprout/Sprout.pm

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

revision 1.4, Tue Jan 25 01:36:09 2005 UTC revision 1.11, Tue Mar 8 09:17:40 2005 UTC
# Line 36  Line 36 
36    
37  #: Constructor SFXlate->new_sprout_only();  #: Constructor SFXlate->new_sprout_only();
38    
   
39  =head2 Public Methods  =head2 Public Methods
40    
41  =head3 new  =head3 new
# Line 125  Line 124 
124  =cut  =cut
125  #: Return Type $;  #: Return Type $;
126  sub MaxSegment {  sub MaxSegment {
127          my $self = shift @_;          my ($self) = @_;
128          return $self->{_options}->{maxSegmentLength};          return $self->{_options}->{maxSegmentLength};
129  }  }
130    
# Line 140  Line 139 
139  =cut  =cut
140  #: Return Type $;  #: Return Type $;
141  sub MaxSequence {  sub MaxSequence {
142          my $self = shift @_;          my ($self) = @_;
143          return $self->{_options}->{maxSequenceLength};          return $self->{_options}->{maxSequenceLength};
144  }  }
145    
# Line 233  Line 232 
232    
233  sub Get {  sub Get {
234          # Get the parameters.          # Get the parameters.
235          my $self = shift @_;          my ($self, $objectNames, $filterClause, $parameterList) = @_;
         my ($objectNames, $filterClause, $parameterList) = @_;  
236          # We differ from the ERDB Get method in that the parameter list is passed in as a list reference          # We differ from the ERDB Get method in that the parameter list is passed in as a list reference
237          # rather than a list of parameters. The next step is to convert the parameters from a reference          # rather than a list of parameters. The next step is to convert the parameters from a reference
238          # to a real list. We can only do this if the parameters have been specified.          # to a real list. We can only do this if the parameters have been specified.
# Line 270  Line 268 
268    
269  sub GetEntity {  sub GetEntity {
270          # Get the parameters.          # Get the parameters.
271          my $self = shift @_;          my ($self, $entityType, $ID) = @_;
         my ($entityType, $ID) = @_;  
272          # Create a query.          # Create a query.
273          my $query = $self->Get([$entityType], "$entityType(id) = ?", [$ID]);          my $query = $self->Get([$entityType], "$entityType(id) = ?", [$ID]);
274          # Get the first (and only) object.          # Get the first (and only) object.
# Line 310  Line 307 
307  #: Return Type @;  #: Return Type @;
308  sub GetEntityValues {  sub GetEntityValues {
309          # Get the parameters.          # Get the parameters.
310          my $self = shift @_;          my ($self, $entityType, $ID, $fields) = @_;
         my ($entityType, $ID, $fields) = @_;  
311          # Get the specified entity.          # Get the specified entity.
312          my $entity = $self->GetEntity($entityType, $ID);          my $entity = $self->GetEntity($entityType, $ID);
313          # Declare the return list.          # Declare the return list.
# Line 342  Line 338 
338    
339  sub ShowMetaData {  sub ShowMetaData {
340          # Get the parameters.          # Get the parameters.
341          my $self = shift @_;          my ($self, $fileName) = @_;
         my ($fileName) = @_;  
342          # Compute the file name.          # Compute the file name.
343          my $options = $self->{_options};          my $options = $self->{_options};
344          # Call the show method on the underlying ERDB object.          # Call the show method on the underlying ERDB object.
# Line 383  Line 378 
378  #: Return Type %;  #: Return Type %;
379  sub Load {  sub Load {
380          # Get the parameters.          # Get the parameters.
381          my $self = shift @_;          my ($self, $rebuild) = @_;
         my ($rebuild) = @_;  
382          # Get the database object.          # Get the database object.
383          my $erdb = $self->{_erdb};          my $erdb = $self->{_erdb};
384          # Load the tables from the data directory.          # Load the tables from the data directory.
# Line 424  Line 418 
418  =back  =back
419    
420  =cut  =cut
421  #: Return Type %;  #: Return Type $%;
422  sub LoadUpdate {  sub LoadUpdate {
423          # Get the parameters.          # Get the parameters.
424          my $self = shift @_;          my ($self, $truncateFlag, $tableList) = @_;
         my ($truncateFlag, $tableList) = @_;  
425          # Get the database object.          # Get the database object.
426          my $erdb = $self->{_erdb};          my $erdb = $self->{_erdb};
427          # Declare the return value.          # Declare the return value.
# Line 464  Line 457 
457  #: Return Type ;  #: Return Type ;
458  sub Build {  sub Build {
459          # Get the parameters.          # Get the parameters.
460          my $self = shift @_;          my ($self) = @_;
461          # Create the tables.          # Create the tables.
462          $self->{_erdb}->CreateTables;          $self->{_erdb}->CreateTables;
463  }  }
# Line 479  Line 472 
472  #: Return Type @;  #: Return Type @;
473  sub Genomes {  sub Genomes {
474          # Get the parameters.          # Get the parameters.
475          my $self = shift @_;          my ($self) = @_;
476          # Get all the genomes.          # Get all the genomes.
477          my @retVal = $self->GetFlat(['Genome'], "", [], 'Genome(id)');          my @retVal = $self->GetFlat(['Genome'], "", [], 'Genome(id)');
478          # Return the list of IDs.          # Return the list of IDs.
# Line 509  Line 502 
502  #: Return Type $;  #: Return Type $;
503  sub GenusSpecies {  sub GenusSpecies {
504          # Get the parameters.          # Get the parameters.
505          my $self = shift @_;          my ($self, $genomeID) = @_;
         my ($genomeID) = @_;  
506          # Get the data for the specified genome.          # Get the data for the specified genome.
507          my @values = $self->GetEntityValues('Genome', $genomeID, ['Genome(genus)', 'Genome(species)',          my @values = $self->GetEntityValues('Genome', $genomeID, ['Genome(genus)', 'Genome(species)',
508                                                                                                                            'Genome(unique-characterization)']);                                                                                                                            'Genome(unique-characterization)']);
# Line 546  Line 538 
538  #: Return Type @;  #: Return Type @;
539  sub FeaturesOf {  sub FeaturesOf {
540          # Get the parameters.          # Get the parameters.
541          my $self = shift @_;          my ($self, $genomeID,$ftype) = @_;
         my ($genomeID,$ftype) = @_;  
542          # Get the features we want.          # Get the features we want.
543          my @features;          my @features;
544          if (!$ftype) {          if (!$ftype) {
# Line 600  Line 591 
591  #: Return Type $;  #: Return Type $;
592  sub FeatureLocation {  sub FeatureLocation {
593          # Get the parameters.          # Get the parameters.
594          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
595          # Create a query for the feature locations.          # Create a query for the feature locations.
596          my $query = $self->Get(['IsLocatedIn'], "IsLocatedIn(from-link) = ? ORDER BY IsLocatedIn(locN)",          my $query = $self->Get(['IsLocatedIn'], "IsLocatedIn(from-link) = ? ORDER BY IsLocatedIn(locN)",
597                                                     [$featureID]);                                                     [$featureID]);
# Line 661  Line 651 
651  =cut  =cut
652  #: Return Type @;  #: Return Type @;
653  sub ParseLocation {  sub ParseLocation {
654          # Get the parameter.          # Get the parameter. Note that if we're called as an instance method, we ignore
655        # the first parameter.
656        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
657          my ($location) = @_;          my ($location) = @_;
658          # Parse it into segments.          # Parse it into segments.
659          $location =~ /^(.*)_(\d*)([+-_])(\d*)$/;          $location =~ /^(.*)_(\d*)([+-_])(\d*)$/;
# Line 680  Line 672 
672          return ($contigID, $start, $dir, $len);          return ($contigID, $start, $dir, $len);
673  }  }
674    
675    =head3 PointLocation
676    
677    C<< my $found = Sprout::PointLocation($location, $point); >>
678    
679    Return the offset into the specified location of the specified point on the contig. If
680    the specified point is before the location, a negative value will be returned. If it is
681    beyond the location, an undefined value will be returned. It is assumed that the offset
682    is for the location's contig. The location can either be new-style (using a C<+> or C<->
683    and a length) or old-style (using C<_> and start and end positions.
684    
685    =over 4
686    
687    =item location
688    
689    A location specifier (see L</FeatureLocation> for a description).
690    
691    =item point
692    
693    The offset into the contig of the point in which we're interested.
694    
695    =item RETURN
696    
697    Returns the offset inside the specified location of the specified point, a negative
698    number if the point is before the location, or an undefined value if the point is past
699    the location. If the length of the location is 0, this method will B<always> denote
700    that it is outside the location. The offset will always be relative to the left-most
701    position in the location.
702    
703    =back
704    
705    =cut
706    #: Return Type $;
707    sub PointLocation {
708            # Get the parameter. Note that if we're called as an instance method, we ignore
709        # the first parameter.
710        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
711            my ($location, $point) = @_;
712        # Parse out the location elements. Note that this works on both old-style and new-style
713        # locations.
714        my ($contigID, $start, $dir, $len) = ParseLocation($location);
715        # Declare the return variable.
716        my $retVal;
717        # Compute the offset. The computation is dependent on the direction of the location.
718        my $offset = (($dir == '+') ? $point - $start : $point - ($start - $len + 1));
719        # Return the offset if it's valid.
720        if ($offset < $len) {
721            $retVal = $offset;
722        }
723        # Return the offset found.
724        return $retVal;
725    }
726    
727  =head3 DNASeq  =head3 DNASeq
728    
729  C<< my $sequence = $sprout->DNASeq(\@locationList); >>  C<< my $sequence = $sprout->DNASeq(\@locationList); >>
# Line 705  Line 749 
749  #: Return Type $;  #: Return Type $;
750  sub DNASeq {  sub DNASeq {
751          # Get the parameters.          # Get the parameters.
752          my $self = shift @_;          my ($self, $locationList) = @_;
         my ($locationList) = @_;  
753          # Create the return string.          # Create the return string.
754          my $retVal = "";          my $retVal = "";
755          # Loop through the locations.          # Loop through the locations.
# Line 779  Line 822 
822  #: Return Type @;  #: Return Type @;
823  sub AllContigs {  sub AllContigs {
824          # Get the parameters.          # Get the parameters.
825          my $self = shift @_;          my ($self, $genomeID) = @_;
         my ($genomeID) = @_;  
826          # Ask for the genome's Contigs.          # Ask for the genome's Contigs.
827          my @retVal = $self->GetFlat(['HasContig'], "HasContig(from-link) = ?", [$genomeID],          my @retVal = $self->GetFlat(['HasContig'], "HasContig(from-link) = ?", [$genomeID],
828                                                                  'HasContig(to-link)');                                                                  'HasContig(to-link)');
# Line 810  Line 852 
852  #: Return Type $;  #: Return Type $;
853  sub ContigLength {  sub ContigLength {
854          # Get the parameters.          # Get the parameters.
855          my $self = shift @_;          my ($self, $contigID) = @_;
         my ($contigID) = @_;  
856          # Get the contig's last sequence.          # Get the contig's last sequence.
857          my $query = $self->Get(['IsMadeUpOf'],          my $query = $self->Get(['IsMadeUpOf'],
858                  "IsMadeUpOf(from-link) = ? ORDER BY IsMadeUpOf(start-position) DESC",                  "IsMadeUpOf(from-link) = ? ORDER BY IsMadeUpOf(start-position) DESC",
# Line 853  Line 894 
894  Returns a three-element list. The first element is a list of feature IDs for the features that  Returns a three-element list. The first element is a list of feature IDs for the features that
895  overlap the region of interest. The second and third elements are the minimum and maximum  overlap the region of interest. The second and third elements are the minimum and maximum
896  locations of the features provided on the specified contig. These may extend outside  locations of the features provided on the specified contig. These may extend outside
897  the start and stop values.  the start and stop values. The first element (that is, the list of features) is sorted
898    roughly by location.
899    
900  =back  =back
901    
902  =cut  =cut
903  #: Return Type @;  #: Return Type @@;
904  sub GenesInRegion {  sub GenesInRegion {
905          # Get the parameters.          # Get the parameters.
906          my $self = shift @_;          my ($self, $contigID, $start, $stop) = @_;
         my ($contigID, $start, $stop) = @_;  
907          # Get the maximum segment length.          # Get the maximum segment length.
908          my $maximumSegmentLength = $self->MaxSegment;          my $maximumSegmentLength = $self->MaxSegment;
909          # Create a hash to receive the feature list. We use a hash so that we can eliminate          # Create a hash to receive the feature list. We use a hash so that we can eliminate
910          # duplicates easily.          # duplicates easily. The hash key will be the feature ID. The value will be a two-element
911            # containing the minimum and maximum offsets. We will use the offsets to sort the results
912            # when we're building the result set.
913          my %featuresFound = ();          my %featuresFound = ();
914          # Prime the values we'll use for the returned beginning and end.          # Prime the values we'll use for the returned beginning and end.
915          my ($min, $max) = ($self->ContigLength($contigID), 0);          my @initialMinMax = ($self->ContigLength($contigID), 0);
916            my ($min, $max) = @initialMinMax;
917          # Create a table of parameters for each query. Each query looks for features travelling in          # Create a table of parameters for each query. Each query looks for features travelling in
918          # a particular direction. The query parameters include the contig ID, the feature direction,          # a particular direction. The query parameters include the contig ID, the feature direction,
919          # the lowest possible start position, and the highest possible start position. This works          # the lowest possible start position, and the highest possible start position. This works
# Line 899  Line 943 
943                                          $found = 1;                                          $found = 1;
944                                  }                                  }
945                          } elsif ($dir eq '-') {                          } elsif ($dir eq '-') {
946                                  $end = $beg - $len;                                  # Note we switch things around so that the beginning is to the left of the
947                                  if ($end <= $stop) {                                  # ending.
948                                    ($beg, $end) = ($beg - $len, $beg);
949                                    if ($beg <= $stop) {
950                                          # Denote we found a useful feature.                                          # Denote we found a useful feature.
951                                          $found = 1;                                          $found = 1;
952                                  }                                  }
953                          }                          }
954                          if ($found) {                          if ($found) {
955                                  # Here we need to record the feature and update the minimum and maximum.                                  # Here we need to record the feature and update the minima and maxima. First,
956                                  $featuresFound{$featureID} = 1;                                  # get the current entry for the specified feature.
957                                  if ($beg < $min) { $min = $beg; }                                  my ($loc1, $loc2) = (exists $featuresFound{$featureID} ? @{$featuresFound{$featureID}} :
958                                  if ($end < $min) { $min = $end; }                                                                           @initialMinMax);
959                                  if ($beg > $max) { $max = $beg; }                                  # Merge the current segment's begin and end into the feature begin and end and the
960                                  if ($end > $max) { $max = $end; }                                  # global min and max.
961                                    if ($beg < $loc1) {
962                                            $loc1 = $beg;
963                                            $min = $beg if $beg < $min;
964                                    }
965                                    if ($end > $loc2) {
966                                            $loc2 = $end;
967                                            $max = $end if $end > $max;
968                                    }
969                                    # Store the entry back into the hash table.
970                                    $featuresFound{$featureID} = [$loc1, $loc2];
971                          }                          }
972                  }                  }
973          }          }
974          # Compute a list of the IDs for the features found.          # Now we must compute the list of the IDs for the features found. We start with a list
975          my @list = (sort (keys %featuresFound));          # of midpoints / feature ID pairs. (It's not really a midpoint, it's twice the midpoint,
976            # but the result of the sort will be the same.)
977            my @list = map { [$featuresFound{$_}->[0] + $featuresFound{$_}->[1], $_] } keys %featuresFound;
978            # Now we sort by midpoint and yank out the feature IDs.
979            my @retVal = map { $_->[1] } sort { $a->[0] <=> $b->[0] } @list;
980          # Return it along with the min and max.          # Return it along with the min and max.
981          return (\@list, $min, $max);          return (\@retVal, $min, $max);
982  }  }
983    
984  =head3 FType  =head3 FType
# Line 944  Line 1004 
1004  #: Return Type $;  #: Return Type $;
1005  sub FType {  sub FType {
1006          # Get the parameters.          # Get the parameters.
1007          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1008          # Get the specified feature's type.          # Get the specified feature's type.
1009          my ($retVal) = $self->GetEntityValues('Feature', $featureID, ['Feature(feature-type)']);          my ($retVal) = $self->GetEntityValues('Feature', $featureID, ['Feature(feature-type)']);
1010          # Return the result.          # Return the result.
# Line 982  Line 1041 
1041  #: Return Type @%;  #: Return Type @%;
1042  sub FeatureAnnotations {  sub FeatureAnnotations {
1043          # Get the parameters.          # Get the parameters.
1044          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1045          # Create a query to get the feature's annotations and the associated users.          # Create a query to get the feature's annotations and the associated users.
1046          my $query = $self->Get(['IsTargetOfAnnotation', 'Annotation', 'MadeAnnotation'],          my $query = $self->Get(['IsTargetOfAnnotation', 'Annotation', 'MadeAnnotation'],
1047                                                     "IsTargetOfAnnotation(from-link) = ?", [$featureID]);                                                     "IsTargetOfAnnotation(from-link) = ?", [$featureID]);
# Line 1012  Line 1070 
1070  C<< my %functions = $sprout->AllFunctionsOf($featureID); >>  C<< my %functions = $sprout->AllFunctionsOf($featureID); >>
1071    
1072  Return all of the functional assignments for a particular feature. The data is returned as a  Return all of the functional assignments for a particular feature. The data is returned as a
1073  hash of functional assignments to user IDs. A functional assignment is a type of annotation.  hash of functional assignments to user IDs. A functional assignment is a type of annotation,
1074  It has the format "XXXX\nset XXXX function to\nYYYYY". In this instance, XXXX is the user ID  Functional assignments are described in the L</ParseAssignment> function. Its worth noting that
1075  and YYYYY is the functional assignment text. Its worth noting that we cannot filter on the content  we cannot filter on the content of the annotation itself because it's a text field; however,
1076  of the annotation itself because it's a text field; however, this is not a big problem because most  this is not a big problem because most features only have a small number of annotations.
1077  features only have a small number of annotations.  Finally, if a single user has multiple functional assignments, we will only keep the most
1078    recent one.
1079    
1080  =over 4  =over 4
1081    
# Line 1034  Line 1093 
1093  #: Return Type %;  #: Return Type %;
1094  sub AllFunctionsOf {  sub AllFunctionsOf {
1095          # Get the parameters.          # Get the parameters.
1096          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1097          # Get all of the feature's annotations.          # Get all of the feature's annotations.
1098          my @query = $self->GetFlat(['IsTargetOfAnnotation', 'Annotation'],      my @query = $self->GetAll(['IsTargetOfAnnotation', 'Annotation'],
1099                                                      "IsTargetOfAnnotation(from-link) = ?",                                                      "IsTargetOfAnnotation(from-link) = ?",
1100                                                          [$featureID], 'Annotation(annotation)');                              [$featureID], ['Annotation(time)', 'Annotation(annotation)']);
1101          # Declare the return hash.          # Declare the return hash.
1102          my %retVal;          my %retVal;
1103        # Declare a hash for insuring we only make one assignment per user.
1104        my %timeHash = ();
1105        # Now we sort the assignments by timestamp in reverse.
1106        my @sortedQuery = sort { -($a->[0] <=> $b->[0]) } @query;
1107          # Loop until we run out of annotations.          # Loop until we run out of annotations.
1108          for my $text (@query) {      for my $annotation (@sortedQuery) {
1109            # Get the annotation fields.
1110            my ($timeStamp, $text) = @{$annotation};
1111                  # Check to see if this is a functional assignment.                  # Check to see if this is a functional assignment.
1112                  my ($user, $function) = ParseAssignment($text);                  my ($user, $function) = _ParseAssignment($text);
1113                  if ($user) {          if ($user && ! exists $timeHash{$user}) {
1114                          # Here it is, so stuff it in the return hash.              # Here it is a functional assignment and there has been no
1115                # previous assignment for this user, so we stuff it in the
1116                # return hash.
1117                          $retVal{$function} = $user;                          $retVal{$function} = $user;
1118                # Insure we don't assign to this user again.
1119                $timeHash{$user} = 1;
1120                  }                  }
1121          }          }
1122          # Return the hash of assignments found.          # Return the hash of assignments found.
# Line 1063  Line 1131 
1131    
1132  The functional assignment is handled differently depending on the type of feature. If  The functional assignment is handled differently depending on the type of feature. If
1133  the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional  the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional
1134  assignment is a type of annotation. It has the format "XXXX\nset XXXX function to\nYYYYY". In this  assignment is a type of annotation. The format of an assignment is described in
1135  instance, XXXX is the user ID and YYYYY is the functional assignment text. Its worth noting that  L</ParseLocation>. Its worth noting that we cannot filter on the content of the
1136  we cannot filter on the content of the annotation itself because it's a text field; however, this  annotation itself because it's a text field; however, this is not a big problem because
1137  is not a big problem because most features only have a small number of annotations.  most features only have a small number of annotations.
1138    
1139  Each user has an associated list of trusted users. The assignment returned will be the most  Each user has an associated list of trusted users. The assignment returned will be the most
1140  recent one by at least one of the trusted users. If no trusted user list is available, then  recent one by at least one of the trusted users. If no trusted user list is available, then
# Line 1098  Line 1166 
1166  #: Return Type $;  #: Return Type $;
1167  sub FunctionOf {  sub FunctionOf {
1168          # Get the parameters.          # Get the parameters.
1169          my $self = shift @_;          my ($self, $featureID, $userID) = @_;
         my ($featureID, $userID) = @_;  
1170      # Declare the return value.      # Declare the return value.
1171      my $retVal;      my $retVal;
1172      # Determine the ID type.      # Determine the ID type.
# Line 1136  Line 1203 
1203              # Get the annotation text.              # Get the annotation text.
1204              my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);              my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);
1205              # Check to see if this is a functional assignment for a trusted user.              # Check to see if this is a functional assignment for a trusted user.
1206              my ($user, $type, $function) = split(/\n/, $text);              my ($user, $function) = _ParseAssignment($text);
1207              if ($type =~ m/^set $user function to$/i) {              if ($user) {
1208                  # Here it is a functional assignment. Check the time and the user                  # Here it is a functional assignment. Check the time and the user
1209                  # name. The time must be recent and the user must be trusted.                  # name. The time must be recent and the user must be trusted.
1210                  if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {                  if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {
# Line 1184  Line 1251 
1251  #: Return Type %;  #: Return Type %;
1252  sub BBHList {  sub BBHList {
1253          # Get the parameters.          # Get the parameters.
1254          my $self = shift @_;          my ($self, $genomeID, $featureList) = @_;
         my ($genomeID, $featureList) = @_;  
1255          # Create the return structure.          # Create the return structure.
1256          my %retVal = ();          my %retVal = ();
1257          # Loop through the incoming features.          # Loop through the incoming features.
# Line 1228  Line 1294 
1294  #: Return Type @;  #: Return Type @;
1295  sub FeatureAliases {  sub FeatureAliases {
1296          # Get the parameters.          # Get the parameters.
1297          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1298          # Get the desired feature's aliases          # Get the desired feature's aliases
1299          my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(alias)']);          my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(alias)']);
1300          # Return the result.          # Return the result.
# Line 1259  Line 1324 
1324  #: Return Type $;  #: Return Type $;
1325  sub GenomeOf {  sub GenomeOf {
1326          # Get the parameters.          # Get the parameters.
1327          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1328          # Create a query to find the genome associated with the feature.          # Create a query to find the genome associated with the feature.
1329          my $query = $self->Get(['IsLocatedIn', 'HasContig'], "IsLocatedIn(from-link) = ?", [$featureID]);          my $query = $self->Get(['IsLocatedIn', 'HasContig'], "IsLocatedIn(from-link) = ?", [$featureID]);
1330          # Declare the return value.          # Declare the return value.
# Line 1296  Line 1360 
1360  #: Return Type %;  #: Return Type %;
1361  sub CoupledFeatures {  sub CoupledFeatures {
1362          # Get the parameters.          # Get the parameters.
1363          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1364          # Create a query to retrieve the functionally-coupled features. Note that we depend on the          # Create a query to retrieve the functionally-coupled features. Note that we depend on the
1365          # fact that the functional coupling is physically paired. If (A,B) is in the database, then          # fact that the functional coupling is physically paired. If (A,B) is in the database, then
1366          # (B,A) will also be found.          # (B,A) will also be found.
# Line 1333  Line 1396 
1396  #: Return Type @;  #: Return Type @;
1397  sub GetEntityTypes {  sub GetEntityTypes {
1398          # Get the parameters.          # Get the parameters.
1399          my $self = shift @_;          my ($self) = @_;
1400          # Get the underlying database object.          # Get the underlying database object.
1401          my $erdb = $self->{_erdb};          my $erdb = $self->{_erdb};
1402          # Get its entity type list.          # Get its entity type list.
# Line 1409  Line 1472 
1472    
1473  Insure that a list of feature locations is in the Sprout format. The Sprout feature location  Insure that a list of feature locations is in the Sprout format. The Sprout feature location
1474  format is I<contig>_I<beg*len> where I<*> is C<+> for a forward gene and C<-> for a backward  format is I<contig>_I<beg*len> where I<*> is C<+> for a forward gene and C<-> for a backward
1475  gene. The old format is I<contig>_I<beg>_I<end>.  gene. The old format is I<contig>_I<beg>_I<end>. If a feature is in the new format already,
1476    it will not be changed; otherwise, it will be converted. This method can also be used to
1477    perform the reverse task-- insuring that all the locations are in the old format.
1478    
1479  =over 4  =over 4
1480    
# Line 1436  Line 1501 
1501  #: Return Type @;  #: Return Type @;
1502  sub FormatLocations {  sub FormatLocations {
1503          # Get the parameters.          # Get the parameters.
1504          my $self = shift @_;          my ($self, $prefix, $locations, $oldFormat) = @_;
         my ($prefix, $locations, $oldFormat) = @_;  
1505          # Create the return list.          # Create the return list.
1506          my @retVal = ();          my @retVal = ();
1507          # Check to see if any locations were passed in.          # Check to see if any locations were passed in.
1508          if ($locations eq '') {          if ($locations eq '') {
1509              confess "No locations specified.";              Confess("No locations specified.");
1510          } else {          } else {
1511                  # Loop through the locations, converting them to the new format.                  # Loop through the locations, converting them to the new format.
1512                  for my $location (@{$locations}) {                  for my $location (@{$locations}) {
# Line 1477  Line 1541 
1541    
1542  sub DumpData {  sub DumpData {
1543          # Get the parameters.          # Get the parameters.
1544          my $self = shift @_;          my ($self) = @_;
1545          # Get the data directory name.          # Get the data directory name.
1546          my $outputDirectory = $self->{_options}->{dataDir};          my $outputDirectory = $self->{_options}->{dataDir};
1547          # Dump the relations.          # Dump the relations.
# Line 1493  Line 1557 
1557  =cut  =cut
1558  #: Return Type $;  #: Return Type $;
1559  sub XMLFileName {  sub XMLFileName {
1560          my $self = shift @_;          my ($self) = @_;
1561          return $self->{_xmlName};          return $self->{_xmlName};
1562  }  }
1563    
# Line 1531  Line 1595 
1595  #: Return Type ;  #: Return Type ;
1596  sub Insert {  sub Insert {
1597          # Get the parameters.          # Get the parameters.
1598          my $self = shift @_;          my ($self, $objectType, $fieldHash) = @_;
         my ($objectType, $fieldHash) = @_;  
1599          # Call the underlying method.          # Call the underlying method.
1600          $self->{_erdb}->InsertObject($objectType, $fieldHash);          $self->{_erdb}->InsertObject($objectType, $fieldHash);
1601  }  }
# Line 1573  Line 1636 
1636  #: Return Type $;  #: Return Type $;
1637  sub Annotate {  sub Annotate {
1638          # Get the parameters.          # Get the parameters.
1639          my $self = shift @_;          my ($self, $fid, $timestamp, $user, $text) = @_;
         my ($fid, $timestamp, $user, $text) = @_;  
1640          # Create the annotation ID.          # Create the annotation ID.
1641          my $aid = "$fid:$timestamp";          my $aid = "$fid:$timestamp";
1642          # Insert the Annotation object.          # Insert the Annotation object.
# Line 1594  Line 1656 
1656    
1657  =head3 AssignFunction  =head3 AssignFunction
1658    
1659  C<< my $ok = $sprout->AssignFunction($featureID, $user, $function); >>  C<< my $ok = $sprout->AssignFunction($featureID, $user, $function, $assigningUser); >>
1660    
1661  This method assigns a function to a feature. Functions are a special type of annotation. The general  This method assigns a function to a feature. Functions are a special type of annotation. The general
1662  format is "XXXX\nset XXXX function to\nYYYYY" where XXXX is the feature type and YYYY is the functional  format is described in L</ParseAssignment>.
 assignment text.  
1663    
1664  =over 4  =over 4
1665    
# Line 1608  Line 1669 
1669    
1670  =item user  =item user
1671    
1672  Name of the user making the assignment. This is frequently a group name, like C<kegg> or C<fig>.  Name of the user group making the assignment, such as C<kegg> or C<fig>.
1673    
1674  =item function  =item function
1675    
1676  Text of the function being assigned.  Text of the function being assigned.
1677    
1678    =item assigningUser (optional)
1679    
1680    Name of the individual user making the assignment. If omitted, defaults to the user group.
1681    
1682  =item RETURN  =item RETURN
1683    
1684  Returns 1 if successful, 0 if an error occurred.  Returns 1 if successful, 0 if an error occurred.
# Line 1624  Line 1689 
1689  #: Return Type $;  #: Return Type $;
1690  sub AssignFunction {  sub AssignFunction {
1691          # Get the parameters.          # Get the parameters.
1692          my $self = shift @_;          my ($self, $featureID, $user, $function, $assigningUser) = @_;
1693          my ($featureID, $user, $function) = @_;      # Default the assigning user.
1694        if (! $assigningUser) {
1695            $assigningUser = $user;
1696        }
1697          # Create an annotation string from the parameters.          # Create an annotation string from the parameters.
1698          my $annotationText = "$user\nset $user function to\n$function";          my $annotationText = "$assigningUser\nset $user function to\n$function";
1699          # Get the current time.          # Get the current time.
1700          my $now = time;          my $now = time;
1701          # Declare the return variable.          # Declare the return variable.
# Line 1672  Line 1740 
1740  #: Return Type @;  #: Return Type @;
1741  sub FeaturesByAlias {  sub FeaturesByAlias {
1742          # Get the parameters.          # Get the parameters.
1743          my $self = shift @_;          my ($self, $alias) = @_;
         my ($alias) = @_;  
1744          # Declare the return variable.          # Declare the return variable.
1745          my @retVal = ();          my @retVal = ();
1746          # Parse the alias.          # Parse the alias.
# Line 1715  Line 1782 
1782  #: Return Type $;  #: Return Type $;
1783  sub Exists {  sub Exists {
1784          # Get the parameters.          # Get the parameters.
1785          my $self = shift @_;          my ($self, $entityName, $entityID) = @_;
         my ($entityName, $entityID) = @_;  
1786          # Check for the entity instance.          # Check for the entity instance.
1787          my $testInstance = $self->GetEntity($entityName, $entityID);          my $testInstance = $self->GetEntity($entityName, $entityID);
1788          # Return an existence indicator.          # Return an existence indicator.
# Line 1746  Line 1812 
1812  #: Return Type $;  #: Return Type $;
1813  sub FeatureTranslation {  sub FeatureTranslation {
1814          # Get the parameters.          # Get the parameters.
1815          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1816          # Get the specified feature's translation.          # Get the specified feature's translation.
1817          my ($retVal) = $self->GetEntityValues("Feature", $featureID, ['Feature(translation)']);          my ($retVal) = $self->GetEntityValues("Feature", $featureID, ['Feature(translation)']);
1818          return $retVal;          return $retVal;
# Line 1779  Line 1844 
1844  #: Return Type @;  #: Return Type @;
1845  sub Taxonomy {  sub Taxonomy {
1846          # Get the parameters.          # Get the parameters.
1847          my $self = shift @_;          my ($self, $genome) = @_;
         my ($genome) = @_;  
1848          # Find the specified genome's taxonomy string.          # Find the specified genome's taxonomy string.
1849          my ($list) = $self->GetEntityValues('Genome', $genome, ['Genome(taxonomy)']);          my ($list) = $self->GetEntityValues('Genome', $genome, ['Genome(taxonomy)']);
1850          # Declare the return variable.          # Declare the return variable.
# Line 1823  Line 1887 
1887  #: Return Type $;  #: Return Type $;
1888  sub CrudeDistance {  sub CrudeDistance {
1889          # Get the parameters.          # Get the parameters.
1890          my $self = shift @_;          my ($self, $genome1, $genome2) = @_;
         my ($genome1, $genome2) = @_;  
1891          # Insure that the distance is commutative by sorting the genome IDs.          # Insure that the distance is commutative by sorting the genome IDs.
1892          my ($genomeA, $genomeB);          my ($genomeA, $genomeB);
1893          if ($genome2 < $genome2) {          if ($genome2 < $genome2) {
# Line 1871  Line 1934 
1934  #: Return Type $;  #: Return Type $;
1935  sub RoleName {  sub RoleName {
1936          # Get the parameters.          # Get the parameters.
1937          my $self = shift @_;          my ($self, $roleID) = @_;
         my ($roleID) = @_;  
1938          # Get the specified role's name.          # Get the specified role's name.
1939          my ($retVal) = $self->GetEntityValues('Role', $roleID, ['Role(name)']);          my ($retVal) = $self->GetEntityValues('Role', $roleID, ['Role(name)']);
1940          # Use the ID if the role has no name.          # Use the ID if the role has no name.
# Line 1905  Line 1967 
1967  #: Return Type @;  #: Return Type @;
1968  sub RoleDiagrams {  sub RoleDiagrams {
1969          # Get the parameters.          # Get the parameters.
1970          my $self = shift @_;          my ($self, $roleID) = @_;
         my ($roleID) = @_;  
1971          # Query for the diagrams.          # Query for the diagrams.
1972          my @retVal = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],          my @retVal = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],
1973                                                                  'RoleOccursIn(to-link)');                                                                  'RoleOccursIn(to-link)');
# Line 1943  Line 2004 
2004  #: Return Type @@;  #: Return Type @@;
2005  sub FeatureProperties {  sub FeatureProperties {
2006          # Get the parameters.          # Get the parameters.
2007          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
2008          # Get the properties.          # Get the properties.
2009          my @retVal = $self->GetAll(['HasProperty', 'Property'], "HasProperty(from-link) = ?", [$featureID],          my @retVal = $self->GetAll(['HasProperty', 'Property'], "HasProperty(from-link) = ?", [$featureID],
2010                                                          ['Property(property-name)', 'Property(property-value)',                                                          ['Property(property-name)', 'Property(property-value)',
# Line 1975  Line 2035 
2035  #: Return Type $;  #: Return Type $;
2036  sub DiagramName {  sub DiagramName {
2037          # Get the parameters.          # Get the parameters.
2038          my $self = shift @_;          my ($self, $diagramID) = @_;
         my ($diagramID) = @_;  
2039          # Get the specified diagram's name and return it.          # Get the specified diagram's name and return it.
2040          my ($retVal) = $self->GetEntityValues('Diagram', $diagramID, ['Diagram(name)']);          my ($retVal) = $self->GetEntityValues('Diagram', $diagramID, ['Diagram(name)']);
2041          return $retVal;          return $retVal;
# Line 2008  Line 2067 
2067  #: Return Type @;  #: Return Type @;
2068  sub MergedAnnotations {  sub MergedAnnotations {
2069          # Get the parameters.          # Get the parameters.
2070          my $self = shift @_;          my ($self, $list) = @_;
         my ($list) = @_;  
2071          # Create a list to hold the annotation tuples found.          # Create a list to hold the annotation tuples found.
2072          my @tuples = ();          my @tuples = ();
2073          # Loop through the features in the input list.          # Loop through the features in the input list.
# Line 2057  Line 2115 
2115  #: Return Type @;  #: Return Type @;
2116  sub RoleNeighbors {  sub RoleNeighbors {
2117          # Get the parameters.          # Get the parameters.
2118          my $self = shift @_;          my ($self, $roleID) = @_;
         my ($roleID) = @_;  
2119          # Get all the diagrams containing this role.          # Get all the diagrams containing this role.
2120          my @diagrams = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],          my @diagrams = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],
2121                                                                    'RoleOccursIn(to-link)');                                                                    'RoleOccursIn(to-link)');
# Line 2100  Line 2157 
2157  #: Return Type @;  #: Return Type @;
2158  sub FeatureLinks {  sub FeatureLinks {
2159          # Get the parameters.          # Get the parameters.
2160          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
2161          # Get the feature's links.          # Get the feature's links.
2162          my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(link)']);          my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(link)']);
2163          # Return the feature's links.          # Return the feature's links.
# Line 2131  Line 2187 
2187  #: Return Type %;  #: Return Type %;
2188  sub SubsystemsOf {  sub SubsystemsOf {
2189          # Get the parameters.          # Get the parameters.
2190          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
2191          # Use the SSCell to connect features to subsystems.          # Use the SSCell to connect features to subsystems.
2192          my @subsystems = $self->GetAll(['ContainsFeature', 'HasSSCell', 'IsRoleOf'],          my @subsystems = $self->GetAll(['ContainsFeature', 'HasSSCell', 'IsRoleOf'],
2193                                                                          "ContainsFeature(to-link) = ?", [$featureID],                                                                          "ContainsFeature(to-link) = ?", [$featureID],
# Line 2180  Line 2235 
2235  #: Return Type @;  #: Return Type @;
2236  sub RelatedFeatures {  sub RelatedFeatures {
2237          # Get the parameters.          # Get the parameters.
2238          my $self = shift @_;          my ($self, $featureID, $function, $userID) = @_;
         my ($featureID, $function, $userID) = @_;  
2239          # Get a list of the features that are BBHs of the incoming feature.          # Get a list of the features that are BBHs of the incoming feature.
2240          my @bbhFeatures = $self->GetFlat(['IsBidirectionalBestHitOf'],          my @bbhFeatures = $self->GetFlat(['IsBidirectionalBestHitOf'],
2241                                                                           "IsBidirectionalBestHitOf(from-link) = ?", [$featureID],                                                                           "IsBidirectionalBestHitOf(from-link) = ?", [$featureID],
# Line 2229  Line 2283 
2283  #: Return Type @;  #: Return Type @;
2284  sub TaxonomySort {  sub TaxonomySort {
2285          # Get the parameters.          # Get the parameters.
2286          my $self = shift @_;          my ($self, $featureIDs) = @_;
         my ($featureIDs) = @_;  
2287          # Create the working hash table.          # Create the working hash table.
2288          my %hashBuffer = ();          my %hashBuffer = ();
2289          # Loop through the features.          # Loop through the features.
# Line 2239  Line 2292 
2292                  my ($taxonomy) = $self->GetFlat(['IsLocatedIn', 'HasContig', 'Genome'], "IsLocatedIn(from-link) = ?",                  my ($taxonomy) = $self->GetFlat(['IsLocatedIn', 'HasContig', 'Genome'], "IsLocatedIn(from-link) = ?",
2293                                                                                  [$fid], 'Genome(taxonomy)');                                                                                  [$fid], 'Genome(taxonomy)');
2294                  # Add this feature to the hash buffer.                  # Add this feature to the hash buffer.
2295                  if (exists $hashBuffer{$taxonomy}) {          Tracer::AddToListMap(\%hashBuffer, $taxonomy, $fid);
                         push @{$hashBuffer{$taxonomy}}, $fid;  
                 } else {  
                         $hashBuffer{$taxonomy} = [$fid];  
                 }  
2296          }          }
2297          # Sort the keys and get the elements.          # Sort the keys and get the elements.
2298          my @retVal = ();          my @retVal = ();
# Line 2312  Line 2361 
2361  #: Return Type @@;  #: Return Type @@;
2362  sub GetAll {  sub GetAll {
2363          # Get the parameters.          # Get the parameters.
2364          my $self = shift @_;          my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_;
         my ($objectNames, $filterClause, $parameterList, $fields, $count) = @_;  
2365          # Create the query.          # Create the query.
2366          my $query = $self->Get($objectNames, $filterClause, $parameterList);          my $query = $self->Get($objectNames, $filterClause, $parameterList);
2367          # Set up a counter of the number of records read.          # Set up a counter of the number of records read.
# Line 2374  Line 2422 
2422  #: Return Type @;  #: Return Type @;
2423  sub GetFlat {  sub GetFlat {
2424          # Get the parameters.          # Get the parameters.
2425          my $self = shift @_;          my ($self, $objectNames, $filterClause, $parameterList, $field) = @_;
         my ($objectNames, $filterClause, $parameterList, $field) = @_;  
2426          # Construct the query.          # Construct the query.
2427          my $query = $self->Get($objectNames, $filterClause, $parameterList);          my $query = $self->Get($objectNames, $filterClause, $parameterList);
2428          # Create the result list.          # Create the result list.
# Line 2485  Line 2532 
2532  #: Return Type @;  #: Return Type @;
2533  sub LoadInfo {  sub LoadInfo {
2534          # Get the parameters.          # Get the parameters.
2535          my $self = shift @_;          my ($self) = @_;
2536          # Create the return list, priming it with the name of the data directory.          # Create the return list, priming it with the name of the data directory.
2537          my @retVal = ($self->{_options}->{dataDir});          my @retVal = ($self->{_options}->{dataDir});
2538          # Concatenate the table names.          # Concatenate the table names.
# Line 2522  Line 2569 
2569  #: Return Type %;  #: Return Type %;
2570  sub LowBBHs {  sub LowBBHs {
2571          # Get the parsameters.          # Get the parsameters.
2572          my $self = shift @_;          my ($self, $featureID, $cutoff) = @_;
         my ($featureID, $cutoff) = @_;  
2573          # Create the return hash.          # Create the return hash.
2574          my %retVal = ();          my %retVal = ();
2575          # Create a query to get the desired BBHs.          # Create a query to get the desired BBHs.
# Line 2539  Line 2585 
2585          return %retVal;          return %retVal;
2586  }  }
2587    
2588    =head3 GetGroups
2589    
2590    C<< my %groups = $sprout->GetGroups(\@groupList); >>
2591    
2592    Return a hash mapping each group to the IDs of the genomes in the group.
2593    A list of groups may be specified, in which case only those groups will be
2594    shown. Alternatively, if no parameter is supplied, all groups will be
2595    included. Genomes that are not in any group are omitted.
2596    
2597    =cut
2598    #: Return Type %@;
2599    sub GetGroups {
2600        # Get the parameters.
2601        my ($self, $groupList) = @_;
2602        # Declare the return value.
2603        my %retVal = ();
2604        # Determine whether we are getting all the groups or just some.
2605        if (defined $groupList) {
2606            # Here we have a group list. Loop through them individually,
2607            # getting a list of the relevant genomes.
2608            for my $group (@{$groupList}) {
2609                my @genomeIDs = $self->GetFlat(['Genome'], "Genome(group-name) = ?",
2610                    [$group], "Genome(id)");
2611                $retVal{$group} = \@genomeIDs;
2612            }
2613        } else {
2614            # Here we need all of the groups. In this case, we run through all
2615            # of the genome records, putting each one found into the appropriate
2616            # group. Note that we use a filter clause to insure that only genomes
2617            # in groups are included in the return set.
2618            my @genomes = $self->GetAll(['Genome'], "Genome(group-name) > ' '", [],
2619                                        ['Genome(id)', 'Genome(group-name)']);
2620            # Loop through the genomes found.
2621            for my $genome (@genomes) {
2622                # Pop this genome's ID off the current list.
2623                my @groups = @{$genome};
2624                my $genomeID = shift @groups;
2625                # Loop through the groups, adding the genome ID to each group's
2626                # list.
2627                for my $group (@groups) {
2628                    Tracer::AddToListMap(\%retVal, $group, $genomeID);
2629                }
2630            }
2631        }
2632        # Return the hash we just built.
2633        return %retVal;
2634    }
2635    
2636  =head2 Internal Utility Methods  =head2 Internal Utility Methods
2637    
2638  =head3 ParseAssignment  =head3 ParseAssignment
2639    
2640  Parse annotation text to determine whether or not it is a functional assignment. If it is,  Parse annotation text to determine whether or not it is a functional assignment. If it is,
2641  the user and function text will be returned as a 2-element list. If it isn't, an empty list  the user, function text, and assigning user will be returned as a 3-element list. If it
2642  will be returned.  isn't, an empty list will be returned.
2643    
2644    A functional assignment is always of the form
2645    
2646        I<XXXX>C<\nset >I<YYYY>C< function to\n>I<ZZZZZ>
2647    
2648    where I<XXXX> is the B<assigning user>, I<YYYY> is the B<user>, and I<ZZZZ> is the
2649    actual functional role. In most cases, the user and the assigning user will be the
2650    same, but that is not always the case.
2651    
2652  This is a static method.  This is a static method.
2653    
# Line 2564  Line 2666 
2666    
2667  =cut  =cut
2668    
2669  sub ParseAssignment {  sub _ParseAssignment {
2670          # Get the parameters.          # Get the parameters.
2671          my ($text) = @_;          my ($text) = @_;
2672          # Declare the return value.          # Declare the return value.
2673          my @retVal = ();          my @retVal = ();
2674          # Check to see if this is a functional assignment.          # Check to see if this is a functional assignment.
2675          my ($user, $type, $function) = split(/\n/, $text);          my ($user, $type, $function) = split(/\n/, $text);
2676          if ($type =~ m/^set $user function to$/i) {          if ($type =~ m/^set ([^ ]+) function to$/i) {
2677                  # Here it is, so we return the user name and function text.                  # Here it is, so we return the user name (which is in $1), the functional role text,
2678                  @retVal = ($user, $function);          # and the assigning user.
2679                    @retVal = ($1, $function, $user);
2680          }          }
2681          # Return the result list.          # Return the result list.
2682          return @retVal;          return @retVal;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3