[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.2, Sun Jan 23 22:31:29 2005 UTC revision 1.10, Fri Feb 25 18:41:45 2005 UTC
# Line 11  Line 11 
11          use Tracer;          use Tracer;
12          use FIGRules;          use FIGRules;
13          use Stats;          use Stats;
14        use POSIX qw(strftime);
15    
16    
17  =head1 Sprout Database Manipulation Object  =head1 Sprout Database Manipulation Object
# Line 33  Line 34 
34    
35  =cut  =cut
36    
37  #  #: Constructor SFXlate->new_sprout_only();
38    
39  =head2 Public Methods  =head2 Public Methods
40    
# Line 121  Line 122 
122  and 10999.  and 10999.
123    
124  =cut  =cut
125    #: 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 136  Line 137 
137  we generally only need a few sequences in memory rather than the entire contig.  we generally only need a few sequences in memory rather than the entire contig.
138    
139  =cut  =cut
140    #: 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 231  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 268  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 305  Line 304 
304  =back  =back
305    
306  =cut  =cut
307    #: 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 340  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 378  Line 375 
375  =back  =back
376    
377  =cut  =cut
378    #: 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 422  Line 418 
418  =back  =back
419    
420  =cut  =cut
421    #: 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 459  Line 454 
454  changed.  changed.
455    
456  =cut  =cut
457    #: 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 474  Line 469 
469  Return a list of all the genome IDs.  Return a list of all the genome IDs.
470    
471  =cut  =cut
472    #: 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 504  Line 499 
499  =back  =back
500    
501  =cut  =cut
502    #: 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 541  Line 535 
535  =back  =back
536    
537  =cut  =cut
538    #: 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 594  Line 587 
587  =back  =back
588    
589  =cut  =cut
590    #: Return Type @;
591    #: 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 656  Line 649 
649  =back  =back
650    
651  =cut  =cut
652    #: 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 677  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 699  Line 746 
746  =back  =back
747    
748  =cut  =cut
749    #: 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 773  Line 819 
819  =back  =back
820    
821  =cut  =cut
822    #: 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 797  Line 842 
842    
843  ID of the contig whose length is desired.  ID of the contig whose length is desired.
844    
845    =item RETURN
846    
847    Returns the number of positions in the contig.
848    
849  =back  =back
850    
851  =cut  =cut
852    #: 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 846  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 @@;
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 892  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 934  Line 1001 
1001  =back  =back
1002    
1003  =cut  =cut
1004    #: 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 963  Line 1029 
1029    
1030  * B<featureID> ID of the relevant feature.  * B<featureID> ID of the relevant feature.
1031    
1032  * B<timeStamp> time the annotation was made.  * B<timeStamp> time the annotation was made, in user-friendly format.
1033    
1034  * B<user> ID of the user who made the annotation  * B<user> ID of the user who made the annotation
1035    
# Line 972  Line 1038 
1038  =back  =back
1039    
1040  =cut  =cut
1041    #: 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 990  Line 1055 
1055                                                                   'Annotation(time)', 'MadeAnnotation(from-link)',                                                                   'Annotation(time)', 'MadeAnnotation(from-link)',
1056                                                                   'Annotation(annotation)']);                                                                   'Annotation(annotation)']);
1057                  # Assemble them into a hash.                  # Assemble them into a hash.
1058                  my $annotationHash = { featureID => $featureID, timeStamp => $timeStamp,          my $annotationHash = { featureID => $featureID,
1059                                   timeStamp => FriendlyTimestamp($timeStamp),
1060                                                             user => $user, text => $text };                                                             user => $user, text => $text };
1061                  # Add it to the return list.                  # Add it to the return list.
1062                  push @retVal, $annotationHash;                  push @retVal, $annotationHash;
# Line 1008  Line 1074 
1074  It has the format "XXXX\nset XXXX function to\nYYYYY". In this instance, XXXX is the user ID  It has the format "XXXX\nset XXXX function to\nYYYYY". In this instance, XXXX is the user ID
1075  and YYYYY is the functional assignment text. Its worth noting that we cannot filter on the content  and YYYYY is the functional assignment text. Its worth noting that we cannot filter on the content
1076  of the annotation itself because it's a text field; however, this is not a big problem because most  of the annotation itself because it's a text field; however, this is not a big problem because most
1077  features only have a small number of annotations.  features only have a small number of annotations. Finally, if a single user has multiple
1078    functional assignments, we will only keep the most recent one.
1079    
1080  =over 4  =over 4
1081    
# Line 1016  Line 1083 
1083    
1084  ID of the feature whose functional assignments are desired.  ID of the feature whose functional assignments are desired.
1085    
1086    =item RETURN
1087    
1088    Returns a hash mapping the functional assignment IDs to user IDs.
1089    
1090  =back  =back
1091    
1092  =cut  =cut
1093    #: 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 1047  Line 1127 
1127    
1128  C<< my $functionText = $sprout->FunctionOf($featureID, $userID); >>  C<< my $functionText = $sprout->FunctionOf($featureID, $userID); >>
1129    
1130  Return the most recently-determined functional assignment of a particular feature. A functional  Return the most recently-determined functional assignment of a particular feature.
1131    
1132    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
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. It has the format "XXXX\nset XXXX function to\nYYYYY". In this
1135  instance, XXXX is the user ID and YYYYY is the functional assignment text. Its worth noting that  instance, XXXX is the user ID and YYYYY is the functional assignment text. Its worth noting that
1136  we cannot filter on the content of the annotation itself because it's a text field; however, this  we cannot filter on the content of the annotation itself because it's a text field; however, this
1137  is not a big problem because most features only have a small number of annotations.  is not a big problem because 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
1140    recent one by at least one of the trusted users. If no trusted user list is available, then
1141    the specified user and FIG are considered trusted. If the user ID is omitted, only FIG
1142    is trusted.
1143    
1144    If the feature is B<not> identified by a FIG ID, then the functional assignment
1145    information is taken from the B<ExternalAliasFunc> table. If the table does
1146    not contain an entry for the feature, an undefined value is returned.
1147    
1148  =over 4  =over 4
1149    
1150  =item featureID  =item featureID
# Line 1061  Line 1153 
1153    
1154  =item userID (optional)  =item userID (optional)
1155    
1156  ID of the user whose function determination is desired. If omitted, C<FIG> is assumed.  ID of the user whose function determination is desired. If omitted, only the latest
1157    C<FIG> assignment will be returned.
1158    
1159  =item RETURN  =item RETURN
1160    
# Line 1070  Line 1163 
1163  =back  =back
1164    
1165  =cut  =cut
1166    #: Return Type $;
1167  sub FunctionOf {  sub FunctionOf {
1168          # Get the parameters.          # Get the parameters.
1169          my $self = shift @_;          my ($self, $featureID, $userID) = @_;
1170          my ($featureID, $userID) = @_;      # Declare the return value.
         if (!$userID) { $userID = 'FIG'; }  
         # Build a query for all of the feature's annotation, sorted by date.  
         my $query = $self->Get(['IsTargetOfAnnotation', 'Annotation'],  
                                                     "IsTargetOfAnnotation(from-link) = ?", [$featureID]);  
         # Declare the return value. We'll set this to the most recent annotation for the  
         # specified user.  
1171          my $retVal;          my $retVal;
1172        # Determine the ID type.
1173        if ($featureID =~ m/^fig\|/) {
1174            # Here we have a FIG feature ID. We must build the list of trusted
1175            # users.
1176            my %trusteeTable = ();
1177            # Check the user ID.
1178            if (!$userID) {
1179                # No user ID, so only FIG is trusted.
1180                $trusteeTable{FIG} = 1;
1181            } else {
1182                # Add this user's ID.
1183                $trusteeTable{$userID} = 1;
1184                # Look for the trusted users in the database.
1185                my @trustees = $self->GetFlat(['IsTrustedBy'], 'IsTrustedBy(from-link) = ?', [$userID], 'IsTrustedBy(to-link)');
1186                if (! @trustees) {
1187                    # None were found, so build a default list.
1188                    $trusteeTable{FIG} = 1;
1189                } else {
1190                    # Otherwise, put all the trustees in.
1191                    for my $trustee (@trustees) {
1192                        $trusteeTable{$trustee} = 1;
1193                    }
1194                }
1195            }
1196            # Build a query for all of the feature's annotations, sorted by date.
1197            my $query = $self->Get(['IsTargetOfAnnotation', 'Annotation'],
1198                                   "IsTargetOfAnnotation(from-link) = ? ORDER BY Annotation(time) DESC",
1199                                   [$featureID]);
1200          my $timeSelected = 0;          my $timeSelected = 0;
1201          # Loop until we run out of annotations.          # Loop until we run out of annotations.
1202          while (my $annotation = $query->Fetch()) {          while (my $annotation = $query->Fetch()) {
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 the desired user.              # Check to see if this is a functional assignment for a trusted user.
1206                  my ($user, $type, $function) = split(/\n/, $text);                  my ($user, $type, $function) = split(/\n/, $text);
1207                  if ($type =~ m/^set $userID function to$/i) {              if ($type =~ m/^set $user function to$/i) {
1208                          # Here it is, so we check the time and save the assignment value.                  # Here it is a functional assignment. Check the time and the user
1209                          if ($time > $timeSelected) {                  # name. The time must be recent and the user must be trusted.
1210                    if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {
1211                                  $retVal = $function;                                  $retVal = $function;
1212                                  $timeSelected = $time;                                  $timeSelected = $time;
1213                          }                          }
1214                  }                  }
1215          }          }
1216        } else {
1217            # Here we have a non-FIG feature ID. In this case the user ID does not
1218            # matter. We simply get the information from the External Alias Function
1219            # table.
1220            ($retVal) = $self->GetEntityValues('ExternalAliasFunc', $featureID, ['ExternalAliasFunc(func)']);
1221        }
1222          # Return the assignment found.          # Return the assignment found.
1223          return $retVal;          return $retVal;
1224  }  }
# Line 1126  Line 1248 
1248  =back  =back
1249    
1250  =cut  =cut
1251    #: 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 1170  Line 1291 
1291  =back  =back
1292    
1293  =cut  =cut
1294    #: 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 1201  Line 1321 
1321  =back  =back
1322    
1323  =cut  =cut
1324    #: 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 1238  Line 1357 
1357  =back  =back
1358    
1359  =cut  =cut
1360    #: 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 1275  Line 1393 
1393  Return the list of supported entity types.  Return the list of supported entity types.
1394    
1395  =cut  =cut
1396    #: 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 1310  Line 1428 
1428  =back  =back
1429    
1430  =cut  =cut
1431    #: Return Type %;
1432  sub ReadFasta {  sub ReadFasta {
1433          # Get the parameters.          # Get the parameters.
1434          my ($fileName, $prefix) = @_;          my ($fileName, $prefix) = @_;
# Line 1354  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 1378  Line 1498 
1498  =back  =back
1499    
1500  =cut  =cut
1501    #: 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 1422  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 1436  Line 1555 
1555  Return the name of this database's XML definition file.  Return the name of this database's XML definition file.
1556    
1557  =cut  =cut
1558    #: Return Type $;
1559  sub XMLFileName {  sub XMLFileName {
1560          my $self = shift @_;          my ($self) = @_;
1561          return $self->{_xmlName};          return $self->{_xmlName};
1562  }  }
1563    
# Line 1473  Line 1592 
1592  =back  =back
1593    
1594  =cut  =cut
1595    #: 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 1515  Line 1633 
1633  =back  =back
1634    
1635  =cut  =cut
1636    #: 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 1566  Line 1683 
1683  =back  =back
1684    
1685  =cut  =cut
1686    #: Return Type $;
1687  sub AssignFunction {  sub AssignFunction {
1688          # Get the parameters.          # Get the parameters.
1689          my $self = shift @_;          my ($self, $featureID, $user, $function) = @_;
         my ($featureID, $user, $function) = @_;  
1690          # Create an annotation string from the parameters.          # Create an annotation string from the parameters.
1691          my $annotationText = "$user\nset $user function to\n$function";          my $annotationText = "$user\nset $user function to\n$function";
1692          # Get the current time.          # Get the current time.
# Line 1614  Line 1730 
1730  =back  =back
1731    
1732  =cut  =cut
1733    #: Return Type @;
1734  sub FeaturesByAlias {  sub FeaturesByAlias {
1735          # Get the parameters.          # Get the parameters.
1736          my $self = shift @_;          my ($self, $alias) = @_;
         my ($alias) = @_;  
1737          # Declare the return variable.          # Declare the return variable.
1738          my @retVal = ();          my @retVal = ();
1739          # Parse the alias.          # Parse the alias.
# Line 1657  Line 1772 
1772  =back  =back
1773    
1774  =cut  =cut
1775    #: Return Type $;
1776  sub Exists {  sub Exists {
1777          # Get the parameters.          # Get the parameters.
1778          my $self = shift @_;          my ($self, $entityName, $entityID) = @_;
         my ($entityName, $entityID) = @_;  
1779          # Check for the entity instance.          # Check for the entity instance.
1780          my $testInstance = $self->GetEntity($entityName, $entityID);          my $testInstance = $self->GetEntity($entityName, $entityID);
1781          # Return an existence indicator.          # Return an existence indicator.
# Line 1688  Line 1802 
1802  =back  =back
1803    
1804  =cut  =cut
1805    #: Return Type $;
1806  sub FeatureTranslation {  sub FeatureTranslation {
1807          # Get the parameters.          # Get the parameters.
1808          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
1809          # Get the specified feature's translation.          # Get the specified feature's translation.
1810          my ($retVal) = $self->GetEntityValues("Feature", $featureID, ['Feature(translation)']);          my ($retVal) = $self->GetEntityValues("Feature", $featureID, ['Feature(translation)']);
1811          return $retVal;          return $retVal;
# Line 1721  Line 1834 
1834  =back  =back
1835    
1836  =cut  =cut
1837    #: Return Type @;
1838  sub Taxonomy {  sub Taxonomy {
1839          # Get the parameters.          # Get the parameters.
1840          my $self = shift @_;          my ($self, $genome) = @_;
         my ($genome) = @_;  
1841          # Find the specified genome's taxonomy string.          # Find the specified genome's taxonomy string.
1842          my ($list) = $self->GetEntityValues('Genome', $genome, ['Genome(taxonomy)']);          my ($list) = $self->GetEntityValues('Genome', $genome, ['Genome(taxonomy)']);
1843          # Declare the return variable.          # Declare the return variable.
# Line 1765  Line 1877 
1877  =back  =back
1878    
1879  =cut  =cut
1880    #: Return Type $;
1881  sub CrudeDistance {  sub CrudeDistance {
1882          # Get the parameters.          # Get the parameters.
1883          my $self = shift @_;          my ($self, $genome1, $genome2) = @_;
         my ($genome1, $genome2) = @_;  
1884          # Insure that the distance is commutative by sorting the genome IDs.          # Insure that the distance is commutative by sorting the genome IDs.
1885          my ($genomeA, $genomeB);          my ($genomeA, $genomeB);
1886          if ($genome2 < $genome2) {          if ($genome2 < $genome2) {
# Line 1813  Line 1924 
1924  =back  =back
1925    
1926  =cut  =cut
1927    #: Return Type $;
1928  sub RoleName {  sub RoleName {
1929          # Get the parameters.          # Get the parameters.
1930          my $self = shift @_;          my ($self, $roleID) = @_;
         my ($roleID) = @_;  
1931          # Get the specified role's name.          # Get the specified role's name.
1932          my ($retVal) = $self->GetEntityValues('Role', $roleID, ['Role(name)']);          my ($retVal) = $self->GetEntityValues('Role', $roleID, ['Role(name)']);
1933          # Use the ID if the role has no name.          # Use the ID if the role has no name.
# Line 1847  Line 1957 
1957  =back  =back
1958    
1959  =cut  =cut
1960    #: Return Type @;
1961  sub RoleDiagrams {  sub RoleDiagrams {
1962          # Get the parameters.          # Get the parameters.
1963          my $self = shift @_;          my ($self, $roleID) = @_;
         my ($roleID) = @_;  
1964          # Query for the diagrams.          # Query for the diagrams.
1965          my @retVal = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],          my @retVal = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],
1966                                                                  'RoleOccursIn(to-link)');                                                                  'RoleOccursIn(to-link)');
# Line 1885  Line 1994 
1994  =back  =back
1995    
1996  =cut  =cut
1997    #: Return Type @@;
1998  sub FeatureProperties {  sub FeatureProperties {
1999          # Get the parameters.          # Get the parameters.
2000          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
2001          # Get the properties.          # Get the properties.
2002          my @retVal = $self->GetAll(['HasProperty', 'Property'], "HasProperty(from-link) = ?", [$featureID],          my @retVal = $self->GetAll(['HasProperty', 'Property'], "HasProperty(from-link) = ?", [$featureID],
2003                                                          ['Property(property-name)', 'Property(property-value)',                                                          ['Property(property-name)', 'Property(property-value)',
# Line 1917  Line 2025 
2025  =back  =back
2026    
2027  =cut  =cut
2028    #: Return Type $;
2029  sub DiagramName {  sub DiagramName {
2030          # Get the parameters.          # Get the parameters.
2031          my $self = shift @_;          my ($self, $diagramID) = @_;
         my ($diagramID) = @_;  
2032          # Get the specified diagram's name and return it.          # Get the specified diagram's name and return it.
2033          my ($retVal) = $self->GetEntityValues('Diagram', $diagramID, ['Diagram(name)']);          my ($retVal) = $self->GetEntityValues('Diagram', $diagramID, ['Diagram(name)']);
2034          return $retVal;          return $retVal;
# Line 1950  Line 2057 
2057  =back  =back
2058    
2059  =cut  =cut
2060    #: Return Type @;
2061  sub MergedAnnotations {  sub MergedAnnotations {
2062          # Get the parameters.          # Get the parameters.
2063          my $self = shift @_;          my ($self, $list) = @_;
         my ($list) = @_;  
2064          # Create a list to hold the annotation tuples found.          # Create a list to hold the annotation tuples found.
2065          my @tuples = ();          my @tuples = ();
2066          # Loop through the features in the input list.          # Loop through the features in the input list.
# Line 1969  Line 2075 
2075          }          }
2076          # Sort the result list by timestamp.          # Sort the result list by timestamp.
2077          my @retVal = sort { $a->[1] <=> $b->[1] } @tuples;          my @retVal = sort { $a->[1] <=> $b->[1] } @tuples;
2078        # Loop through and make the time stamps friendly.
2079        for my $tuple (@retVal) {
2080            $tuple->[1] = FriendlyTimestamp($tuple->[1]);
2081        }
2082          # Return the sorted list.          # Return the sorted list.
2083          return @retVal;          return @retVal;
2084  }  }
# Line 1995  Line 2105 
2105  =back  =back
2106    
2107  =cut  =cut
2108    #: Return Type @;
2109  sub RoleNeighbors {  sub RoleNeighbors {
2110          # Get the parameters.          # Get the parameters.
2111          my $self = shift @_;          my ($self, $roleID) = @_;
         my ($roleID) = @_;  
2112          # Get all the diagrams containing this role.          # Get all the diagrams containing this role.
2113          my @diagrams = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],          my @diagrams = $self->GetFlat(['RoleOccursIn'], "RoleOccursIn(from-link) = ?", [$roleID],
2114                                                                    'RoleOccursIn(to-link)');                                                                    'RoleOccursIn(to-link)');
# Line 2038  Line 2147 
2147  =back  =back
2148    
2149  =cut  =cut
2150    #: Return Type @;
2151  sub FeatureLinks {  sub FeatureLinks {
2152          # Get the parameters.          # Get the parameters.
2153          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
2154          # Get the feature's links.          # Get the feature's links.
2155          my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(link)']);          my @retVal = $self->GetEntityValues('Feature', $featureID, ['Feature(link)']);
2156          # Return the feature's links.          # Return the feature's links.
# Line 2069  Line 2177 
2177  =back  =back
2178    
2179  =cut  =cut
2180    #: Return Type %;
2181  sub SubsystemsOf {  sub SubsystemsOf {
2182          # Get the parameters.          # Get the parameters.
2183          my $self = shift @_;          my ($self, $featureID) = @_;
         my ($featureID) = @_;  
2184          # Use the SSCell to connect features to subsystems.          # Use the SSCell to connect features to subsystems.
2185          my @subsystems = $self->GetAll(['ContainsFeature', 'HasSSCell', 'IsRoleOf'],          my @subsystems = $self->GetAll(['ContainsFeature', 'HasSSCell', 'IsRoleOf'],
2186                                                                          "ContainsFeature(to-link) = ?", [$featureID],                                                                          "ContainsFeature(to-link) = ?", [$featureID],
# Line 2118  Line 2225 
2225  =back  =back
2226    
2227  =cut  =cut
2228    #: Return Type @;
2229  sub RelatedFeatures {  sub RelatedFeatures {
2230          # Get the parameters.          # Get the parameters.
2231          my $self = shift @_;          my ($self, $featureID, $function, $userID) = @_;
         my ($featureID, $function, $userID) = @_;  
2232          # 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.
2233          my @bbhFeatures = $self->GetFlat(['IsBidirectionalBestHitOf'],          my @bbhFeatures = $self->GetFlat(['IsBidirectionalBestHitOf'],
2234                                                                           "IsBidirectionalBestHitOf(from-link) = ?", [$featureID],                                                                           "IsBidirectionalBestHitOf(from-link) = ?", [$featureID],
# Line 2167  Line 2273 
2273  =back  =back
2274    
2275  =cut  =cut
2276    #: Return Type @;
2277  sub TaxonomySort {  sub TaxonomySort {
2278          # Get the parameters.          # Get the parameters.
2279          my $self = shift @_;          my ($self, $featureIDs) = @_;
         my ($featureIDs) = @_;  
2280          # Create the working hash table.          # Create the working hash table.
2281          my %hashBuffer = ();          my %hashBuffer = ();
2282          # Loop through the features.          # Loop through the features.
# Line 2180  Line 2285 
2285                  my ($taxonomy) = $self->GetFlat(['IsLocatedIn', 'HasContig', 'Genome'], "IsLocatedIn(from-link) = ?",                  my ($taxonomy) = $self->GetFlat(['IsLocatedIn', 'HasContig', 'Genome'], "IsLocatedIn(from-link) = ?",
2286                                                                                  [$fid], 'Genome(taxonomy)');                                                                                  [$fid], 'Genome(taxonomy)');
2287                  # Add this feature to the hash buffer.                  # Add this feature to the hash buffer.
2288                  if (exists $hashBuffer{$taxonomy}) {          Tracer::AddToListMap(\%hashBuffer, $taxonomy, $fid);
                         push @{$hashBuffer{$taxonomy}}, $fid;  
                 } else {  
                         $hashBuffer{$taxonomy} = [$fid];  
                 }  
2289          }          }
2290          # Sort the keys and get the elements.          # Sort the keys and get the elements.
2291          my @retVal = ();          my @retVal = ();
# Line 2250  Line 2351 
2351  =back  =back
2352    
2353  =cut  =cut
2354    #: Return Type @@;
2355  sub GetAll {  sub GetAll {
2356          # Get the parameters.          # Get the parameters.
2357          my $self = shift @_;          my ($self, $objectNames, $filterClause, $parameterList, $fields, $count) = @_;
         my ($objectNames, $filterClause, $parameterList, $fields, $count) = @_;  
2358          # Create the query.          # Create the query.
2359          my $query = $self->Get($objectNames, $filterClause, $parameterList);          my $query = $self->Get($objectNames, $filterClause, $parameterList);
2360          # Set up a counter of the number of records read.          # Set up a counter of the number of records read.
# Line 2312  Line 2412 
2412  =back  =back
2413    
2414  =cut  =cut
2415    #: Return Type @;
2416  sub GetFlat {  sub GetFlat {
2417          # Get the parameters.          # Get the parameters.
2418          my $self = shift @_;          my ($self, $objectNames, $filterClause, $parameterList, $field) = @_;
         my ($objectNames, $filterClause, $parameterList, $field) = @_;  
2419          # Construct the query.          # Construct the query.
2420          my $query = $self->Get($objectNames, $filterClause, $parameterList);          my $query = $self->Get($objectNames, $filterClause, $parameterList);
2421          # Create the result list.          # Create the result list.
# Line 2423  Line 2522 
2522  to load the entire database.  to load the entire database.
2523    
2524  =cut  =cut
2525    #: Return Type @;
2526  sub LoadInfo {  sub LoadInfo {
2527          # Get the parameters.          # Get the parameters.
2528          my $self = shift @_;          my ($self) = @_;
2529          # 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.
2530          my @retVal = ($self->{_options}->{dataDir});          my @retVal = ($self->{_options}->{dataDir});
2531          # Concatenate the table names.          # Concatenate the table names.
# Line 2460  Line 2559 
2559  =back  =back
2560    
2561  =cut  =cut
2562    #: Return Type %;
2563  sub LowBBHs {  sub LowBBHs {
2564          # Get the parsameters.          # Get the parsameters.
2565          my $self = shift @_;          my ($self, $featureID, $cutoff) = @_;
         my ($featureID, $cutoff) = @_;  
2566          # Create the return hash.          # Create the return hash.
2567          my %retVal = ();          my %retVal = ();
2568          # Create a query to get the desired BBHs.          # Create a query to get the desired BBHs.
# Line 2480  Line 2578 
2578          return %retVal;          return %retVal;
2579  }  }
2580    
2581    =head3 GetGroups
2582    
2583    C<< my %groups = $sprout->GetGroups(\@groupList); >>
2584    
2585    Return a hash mapping each group to the IDs of the genomes in the group.
2586    A list of groups may be specified, in which case only those groups will be
2587    shown. Alternatively, if no parameter is supplied, all groups will be
2588    included. Genomes that are not in any group are omitted.
2589    
2590    =cut
2591    #: Return Type %@;
2592    sub GetGroups {
2593        # Get the parameters.
2594        my ($self, $groupList) = @_;
2595        # Declare the return value.
2596        my %retVal = ();
2597        # Determine whether we are getting all the groups or just some.
2598        if (defined $groupList) {
2599            # Here we have a group list. Loop through them individually,
2600            # getting a list of the relevant genomes.
2601            for my $group (@{$groupList}) {
2602                my @genomeIDs = $self->GetFlat(['Genome'], "Genome(group-name) = ?",
2603                    [$group], "Genome(id)");
2604                $retVal{$group} = \@genomeIDs;
2605            }
2606        } else {
2607            # Here we need all of the groups. In this case, we run through all
2608            # of the genome records, putting each one found into the appropriate
2609            # group. Note that we use a filter clause to insure that only genomes
2610            # in groups are included in the return set.
2611            my @genomes = $self->GetAll(['Genome'], "Genome(group-name) > ' '", [],
2612                                        ['Genome(id)', 'Genome(group-name)']);
2613            # Loop through the genomes found.
2614            for my $genome (@genomes) {
2615                # Pop this genome's ID off the current list.
2616                my @groups = @{$genome};
2617                my $genomeID = shift @groups;
2618                # Loop through the groups, adding the genome ID to each group's
2619                # list.
2620                for my $group (@groups) {
2621                    Tracer::AddToListMap(\%retVal, $group, $genomeID);
2622                }
2623            }
2624        }
2625        # Return the hash we just built.
2626        return %retVal;
2627    }
2628    
2629  =head2 Internal Utility Methods  =head2 Internal Utility Methods
2630    
2631  =head3 ParseAssignment  =head3 ParseAssignment
# Line 2520  Line 2666 
2666          return @retVal;          return @retVal;
2667  }  }
2668    
2669    =head3 FriendlyTimestamp
2670    
2671    Convert a time number to a user-friendly time stamp for display.
2672    
2673    This is a static method.
2674    
2675    =over 4
2676    
2677    =item timeValue
2678    
2679    Numeric time value.
2680    
2681    =item RETURN
2682    
2683    Returns a string containing the same time in user-readable format.
2684    
2685    =back
2686    
2687    =cut
2688    
2689    sub FriendlyTimestamp {
2690        my ($timeValue) = @_;
2691        my $retVal = strftime("%a %b %e %H:%M:%S %Y", localtime($timeValue));
2692        return $retVal;
2693    }
2694    
2695  1;  1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.10

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3