[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.9, Mon Feb 7 00:32:07 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 = shift @_;
128          return $self->{_options}->{maxSegmentLength};          return $self->{_options}->{maxSegmentLength};
# 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 = shift @_;
143          return $self->{_options}->{maxSequenceLength};          return $self->{_options}->{maxSequenceLength};
# Line 305  Line 306 
306  =back  =back
307    
308  =cut  =cut
309    #: Return Type @;
310  sub GetEntityValues {  sub GetEntityValues {
311          # Get the parameters.          # Get the parameters.
312          my $self = shift @_;          my $self = shift @_;
# Line 378  Line 379 
379  =back  =back
380    
381  =cut  =cut
382    #: Return Type %;
383  sub Load {  sub Load {
384          # Get the parameters.          # Get the parameters.
385          my $self = shift @_;          my $self = shift @_;
# Line 422  Line 423 
423  =back  =back
424    
425  =cut  =cut
426    #: Return Type $%;
427  sub LoadUpdate {  sub LoadUpdate {
428          # Get the parameters.          # Get the parameters.
429          my $self = shift @_;          my $self = shift @_;
# Line 459  Line 460 
460  changed.  changed.
461    
462  =cut  =cut
463    #: Return Type ;
464  sub Build {  sub Build {
465          # Get the parameters.          # Get the parameters.
466          my $self = shift @_;          my $self = shift @_;
# Line 474  Line 475 
475  Return a list of all the genome IDs.  Return a list of all the genome IDs.
476    
477  =cut  =cut
478    #: Return Type @;
479  sub Genomes {  sub Genomes {
480          # Get the parameters.          # Get the parameters.
481          my $self = shift @_;          my $self = shift @_;
# Line 504  Line 505 
505  =back  =back
506    
507  =cut  =cut
508    #: Return Type $;
509  sub GenusSpecies {  sub GenusSpecies {
510          # Get the parameters.          # Get the parameters.
511          my $self = shift @_;          my $self = shift @_;
# Line 541  Line 542 
542  =back  =back
543    
544  =cut  =cut
545    #: Return Type @;
546  sub FeaturesOf {  sub FeaturesOf {
547          # Get the parameters.          # Get the parameters.
548          my $self = shift @_;          my $self = shift @_;
# Line 594  Line 595 
595  =back  =back
596    
597  =cut  =cut
598    #: Return Type @;
599    #: Return Type $;
600  sub FeatureLocation {  sub FeatureLocation {
601          # Get the parameters.          # Get the parameters.
602          my $self = shift @_;          my $self = shift @_;
# Line 656  Line 658 
658  =back  =back
659    
660  =cut  =cut
661    #: Return Type @;
662  sub ParseLocation {  sub ParseLocation {
663          # Get the parameter.          # Get the parameter.
664          my ($location) = @_;          my ($location) = @_;
# Line 699  Line 701 
701  =back  =back
702    
703  =cut  =cut
704    #: Return Type $;
705  sub DNASeq {  sub DNASeq {
706          # Get the parameters.          # Get the parameters.
707          my $self = shift @_;          my $self = shift @_;
# Line 773  Line 775 
775  =back  =back
776    
777  =cut  =cut
778    #: Return Type @;
779  sub AllContigs {  sub AllContigs {
780          # Get the parameters.          # Get the parameters.
781          my $self = shift @_;          my $self = shift @_;
# Line 797  Line 799 
799    
800  ID of the contig whose length is desired.  ID of the contig whose length is desired.
801    
802    =item RETURN
803    
804    Returns the number of positions in the contig.
805    
806  =back  =back
807    
808  =cut  =cut
809    #: Return Type $;
810  sub ContigLength {  sub ContigLength {
811          # Get the parameters.          # Get the parameters.
812          my $self = shift @_;          my $self = shift @_;
# Line 846  Line 852 
852  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
853  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
854  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
855  the start and stop values.  the start and stop values. The first element (that is, the list of features) is sorted
856    roughly by location.
857    
858  =back  =back
859    
860  =cut  =cut
861    #: Return Type @@;
862  sub GenesInRegion {  sub GenesInRegion {
863          # Get the parameters.          # Get the parameters.
864          my $self = shift @_;          my $self = shift @_;
# Line 859  Line 866 
866          # Get the maximum segment length.          # Get the maximum segment length.
867          my $maximumSegmentLength = $self->MaxSegment;          my $maximumSegmentLength = $self->MaxSegment;
868          # 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
869          # duplicates easily.          # duplicates easily. The hash key will be the feature ID. The value will be a two-element
870            # containing the minimum and maximum offsets. We will use the offsets to sort the results
871            # when we're building the result set.
872          my %featuresFound = ();          my %featuresFound = ();
873          # Prime the values we'll use for the returned beginning and end.          # Prime the values we'll use for the returned beginning and end.
874          my ($min, $max) = ($self->ContigLength($contigID), 0);          my @initialMinMax = ($self->ContigLength($contigID), 0);
875            my ($min, $max) = @initialMinMax;
876          # 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
877          # 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,
878          # 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 902 
902                                          $found = 1;                                          $found = 1;
903                                  }                                  }
904                          } elsif ($dir eq '-') {                          } elsif ($dir eq '-') {
905                                  $end = $beg - $len;                                  # Note we switch things around so that the beginning is to the left of the
906                                  if ($end <= $stop) {                                  # ending.
907                                    ($beg, $end) = ($beg - $len, $beg);
908                                    if ($beg <= $stop) {
909                                          # Denote we found a useful feature.                                          # Denote we found a useful feature.
910                                          $found = 1;                                          $found = 1;
911                                  }                                  }
912                          }                          }
913                          if ($found) {                          if ($found) {
914                                  # 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,
915                                  $featuresFound{$featureID} = 1;                                  # get the current entry for the specified feature.
916                                  if ($beg < $min) { $min = $beg; }                                  my ($loc1, $loc2) = (exists $featuresFound{$featureID} ? @{$featuresFound{$featureID}} :
917                                  if ($end < $min) { $min = $end; }                                                                           @initialMinMax);
918                                  if ($beg > $max) { $max = $beg; }                                  # Merge the current segment's begin and end into the feature begin and end and the
919                                  if ($end > $max) { $max = $end; }                                  # global min and max.
920                                    if ($beg < $loc1) {
921                                            $loc1 = $beg;
922                                            $min = $beg if $beg < $min;
923                                    }
924                                    if ($end > $loc2) {
925                                            $loc2 = $end;
926                                            $max = $end if $end > $max;
927                                    }
928                                    # Store the entry back into the hash table.
929                                    $featuresFound{$featureID} = [$loc1, $loc2];
930                          }                          }
931                  }                  }
932          }          }
933          # 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
934          my @list = (sort (keys %featuresFound));          # of midpoints / feature ID pairs. (It's not really a midpoint, it's twice the midpoint,
935            # but the result of the sort will be the same.)
936            my @list = map { [$featuresFound{$_}->[0] + $featuresFound{$_}->[1], $_] } keys %featuresFound;
937            # Now we sort by midpoint and yank out the feature IDs.
938            my @retVal = map { $_->[1] } sort { $a->[0] <=> $b->[0] } @list;
939          # Return it along with the min and max.          # Return it along with the min and max.
940          return (\@list, $min, $max);          return (\@retVal, $min, $max);
941  }  }
942    
943  =head3 FType  =head3 FType
# Line 934  Line 960 
960  =back  =back
961    
962  =cut  =cut
963    #: Return Type $;
964  sub FType {  sub FType {
965          # Get the parameters.          # Get the parameters.
966          my $self = shift @_;          my $self = shift @_;
# Line 963  Line 989 
989    
990  * B<featureID> ID of the relevant feature.  * B<featureID> ID of the relevant feature.
991    
992  * B<timeStamp> time the annotation was made.  * B<timeStamp> time the annotation was made, in user-friendly format.
993    
994  * B<user> ID of the user who made the annotation  * B<user> ID of the user who made the annotation
995    
# Line 972  Line 998 
998  =back  =back
999    
1000  =cut  =cut
1001    #: Return Type @%;
1002  sub FeatureAnnotations {  sub FeatureAnnotations {
1003          # Get the parameters.          # Get the parameters.
1004          my $self = shift @_;          my $self = shift @_;
# Line 990  Line 1016 
1016                                                                   'Annotation(time)', 'MadeAnnotation(from-link)',                                                                   'Annotation(time)', 'MadeAnnotation(from-link)',
1017                                                                   'Annotation(annotation)']);                                                                   'Annotation(annotation)']);
1018                  # Assemble them into a hash.                  # Assemble them into a hash.
1019                  my $annotationHash = { featureID => $featureID, timeStamp => $timeStamp,          my $annotationHash = { featureID => $featureID,
1020                                   timeStamp => FriendlyTimestamp($timeStamp),
1021                                                             user => $user, text => $text };                                                             user => $user, text => $text };
1022                  # Add it to the return list.                  # Add it to the return list.
1023                  push @retVal, $annotationHash;                  push @retVal, $annotationHash;
# Line 1008  Line 1035 
1035  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
1036  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
1037  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
1038  features only have a small number of annotations.  features only have a small number of annotations. Finally, if a single user has multiple
1039    functional assignments, we will only keep the most recent one.
1040    
1041  =over 4  =over 4
1042    
# Line 1016  Line 1044 
1044    
1045  ID of the feature whose functional assignments are desired.  ID of the feature whose functional assignments are desired.
1046    
1047    =item RETURN
1048    
1049    Returns a hash mapping the functional assignment IDs to user IDs.
1050    
1051  =back  =back
1052    
1053  =cut  =cut
1054    #: Return Type %;
1055  sub AllFunctionsOf {  sub AllFunctionsOf {
1056          # Get the parameters.          # Get the parameters.
1057          my $self = shift @_;          my $self = shift @_;
1058          my ($featureID) = @_;          my ($featureID) = @_;
1059          # Get all of the feature's annotations.          # Get all of the feature's annotations.
1060          my @query = $self->GetFlat(['IsTargetOfAnnotation', 'Annotation'],      my @query = $self->GetAll(['IsTargetOfAnnotation', 'Annotation'],
1061                                                      "IsTargetOfAnnotation(from-link) = ?",                                                      "IsTargetOfAnnotation(from-link) = ?",
1062                                                          [$featureID], 'Annotation(annotation)');                              [$featureID], ['Annotation(time)', 'Annotation(annotation)']);
1063          # Declare the return hash.          # Declare the return hash.
1064          my %retVal;          my %retVal;
1065        # Declare a hash for insuring we only make one assignment per user.
1066        my %timeHash = ();
1067        # Now we sort the assignments by timestamp in reverse.
1068        my @sortedQuery = sort { -($a->[0] <=> $b->[0]) } @query;
1069          # Loop until we run out of annotations.          # Loop until we run out of annotations.
1070          for my $text (@query) {      for my $annotation (@sortedQuery) {
1071            # Get the annotation fields.
1072            my ($timeStamp, $text) = @{$annotation};
1073                  # Check to see if this is a functional assignment.                  # Check to see if this is a functional assignment.
1074                  my ($user, $function) = ParseAssignment($text);                  my ($user, $function) = ParseAssignment($text);
1075                  if ($user) {          if ($user && ! exists $timeHash{$user}) {
1076                          # Here it is, so stuff it in the return hash.              # Here it is a functional assignment and there has been no
1077                # previous assignment for this user, so we stuff it in the
1078                # return hash.
1079                          $retVal{$function} = $user;                          $retVal{$function} = $user;
1080                # Insure we don't assign to this user again.
1081                $timeHash{$user} = 1;
1082                  }                  }
1083          }          }
1084          # Return the hash of assignments found.          # Return the hash of assignments found.
# Line 1047  Line 1089 
1089    
1090  C<< my $functionText = $sprout->FunctionOf($featureID, $userID); >>  C<< my $functionText = $sprout->FunctionOf($featureID, $userID); >>
1091    
1092  Return the most recently-determined functional assignment of a particular feature. A functional  Return the most recently-determined functional assignment of a particular feature.
1093    
1094    The functional assignment is handled differently depending on the type of feature. If
1095    the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional
1096  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
1097  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
1098  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
1099  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.
1100    
1101    Each user has an associated list of trusted users. The assignment returned will be the most
1102    recent one by at least one of the trusted users. If no trusted user list is available, then
1103    the specified user and FIG are considered trusted. If the user ID is omitted, only FIG
1104    is trusted.
1105    
1106    If the feature is B<not> identified by a FIG ID, then the functional assignment
1107    information is taken from the B<ExternalAliasFunc> table. If the table does
1108    not contain an entry for the feature, an undefined value is returned.
1109    
1110  =over 4  =over 4
1111    
1112  =item featureID  =item featureID
# Line 1061  Line 1115 
1115    
1116  =item userID (optional)  =item userID (optional)
1117    
1118  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
1119    C<FIG> assignment will be returned.
1120    
1121  =item RETURN  =item RETURN
1122    
# Line 1070  Line 1125 
1125  =back  =back
1126    
1127  =cut  =cut
1128    #: Return Type $;
1129  sub FunctionOf {  sub FunctionOf {
1130          # Get the parameters.          # Get the parameters.
1131          my $self = shift @_;          my $self = shift @_;
1132          my ($featureID, $userID) = @_;          my ($featureID, $userID) = @_;
1133          if (!$userID) { $userID = 'FIG'; }      # Declare the return value.
         # 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.  
1134          my $retVal;          my $retVal;
1135        # Determine the ID type.
1136        if ($featureID =~ m/^fig\|/) {
1137            # Here we have a FIG feature ID. We must build the list of trusted
1138            # users.
1139            my %trusteeTable = ();
1140            # Check the user ID.
1141            if (!$userID) {
1142                # No user ID, so only FIG is trusted.
1143                $trusteeTable{FIG} = 1;
1144            } else {
1145                # Add this user's ID.
1146                $trusteeTable{$userID} = 1;
1147                # Look for the trusted users in the database.
1148                my @trustees = $self->GetFlat(['IsTrustedBy'], 'IsTrustedBy(from-link) = ?', [$userID], 'IsTrustedBy(to-link)');
1149                if (! @trustees) {
1150                    # None were found, so build a default list.
1151                    $trusteeTable{FIG} = 1;
1152                } else {
1153                    # Otherwise, put all the trustees in.
1154                    for my $trustee (@trustees) {
1155                        $trusteeTable{$trustee} = 1;
1156                    }
1157                }
1158            }
1159            # Build a query for all of the feature's annotations, sorted by date.
1160            my $query = $self->Get(['IsTargetOfAnnotation', 'Annotation'],
1161                                   "IsTargetOfAnnotation(from-link) = ? ORDER BY Annotation(time) DESC",
1162                                   [$featureID]);
1163          my $timeSelected = 0;          my $timeSelected = 0;
1164          # Loop until we run out of annotations.          # Loop until we run out of annotations.
1165          while (my $annotation = $query->Fetch()) {          while (my $annotation = $query->Fetch()) {
1166                  # Get the annotation text.                  # Get the annotation text.
1167                  my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);                  my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);
1168                  # 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.
1169                  my ($user, $type, $function) = split(/\n/, $text);                  my ($user, $type, $function) = split(/\n/, $text);
1170                  if ($type =~ m/^set $userID function to$/i) {              if ($type =~ m/^set $user function to$/i) {
1171                          # 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
1172                          if ($time > $timeSelected) {                  # name. The time must be recent and the user must be trusted.
1173                    if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {
1174                                  $retVal = $function;                                  $retVal = $function;
1175                                  $timeSelected = $time;                                  $timeSelected = $time;
1176                          }                          }
1177                  }                  }
1178          }          }
1179        } else {
1180            # Here we have a non-FIG feature ID. In this case the user ID does not
1181            # matter. We simply get the information from the External Alias Function
1182            # table.
1183            ($retVal) = $self->GetEntityValues('ExternalAliasFunc', $featureID, ['ExternalAliasFunc(func)']);
1184        }
1185          # Return the assignment found.          # Return the assignment found.
1186          return $retVal;          return $retVal;
1187  }  }
# Line 1126  Line 1211 
1211  =back  =back
1212    
1213  =cut  =cut
1214    #: Return Type %;
1215  sub BBHList {  sub BBHList {
1216          # Get the parameters.          # Get the parameters.
1217          my $self = shift @_;          my $self = shift @_;
# Line 1170  Line 1255 
1255  =back  =back
1256    
1257  =cut  =cut
1258    #: Return Type @;
1259  sub FeatureAliases {  sub FeatureAliases {
1260          # Get the parameters.          # Get the parameters.
1261          my $self = shift @_;          my $self = shift @_;
# Line 1201  Line 1286 
1286  =back  =back
1287    
1288  =cut  =cut
1289    #: Return Type $;
1290  sub GenomeOf {  sub GenomeOf {
1291          # Get the parameters.          # Get the parameters.
1292          my $self = shift @_;          my $self = shift @_;
# Line 1238  Line 1323 
1323  =back  =back
1324    
1325  =cut  =cut
1326    #: Return Type %;
1327  sub CoupledFeatures {  sub CoupledFeatures {
1328          # Get the parameters.          # Get the parameters.
1329          my $self = shift @_;          my $self = shift @_;
# Line 1275  Line 1360 
1360  Return the list of supported entity types.  Return the list of supported entity types.
1361    
1362  =cut  =cut
1363    #: Return Type @;
1364  sub GetEntityTypes {  sub GetEntityTypes {
1365          # Get the parameters.          # Get the parameters.
1366          my $self = shift @_;          my $self = shift @_;
# Line 1310  Line 1395 
1395  =back  =back
1396    
1397  =cut  =cut
1398    #: Return Type %;
1399  sub ReadFasta {  sub ReadFasta {
1400          # Get the parameters.          # Get the parameters.
1401          my ($fileName, $prefix) = @_;          my ($fileName, $prefix) = @_;
# Line 1378  Line 1463 
1463  =back  =back
1464    
1465  =cut  =cut
1466    #: Return Type @;
1467  sub FormatLocations {  sub FormatLocations {
1468          # Get the parameters.          # Get the parameters.
1469          my $self = shift @_;          my $self = shift @_;
# Line 1436  Line 1521 
1521  Return the name of this database's XML definition file.  Return the name of this database's XML definition file.
1522    
1523  =cut  =cut
1524    #: Return Type $;
1525  sub XMLFileName {  sub XMLFileName {
1526          my $self = shift @_;          my $self = shift @_;
1527          return $self->{_xmlName};          return $self->{_xmlName};
# Line 1473  Line 1558 
1558  =back  =back
1559    
1560  =cut  =cut
1561    #: Return Type ;
1562  sub Insert {  sub Insert {
1563          # Get the parameters.          # Get the parameters.
1564          my $self = shift @_;          my $self = shift @_;
# Line 1515  Line 1600 
1600  =back  =back
1601    
1602  =cut  =cut
1603    #: Return Type $;
1604  sub Annotate {  sub Annotate {
1605          # Get the parameters.          # Get the parameters.
1606          my $self = shift @_;          my $self = shift @_;
# Line 1566  Line 1651 
1651  =back  =back
1652    
1653  =cut  =cut
1654    #: Return Type $;
1655  sub AssignFunction {  sub AssignFunction {
1656          # Get the parameters.          # Get the parameters.
1657          my $self = shift @_;          my $self = shift @_;
# Line 1614  Line 1699 
1699  =back  =back
1700    
1701  =cut  =cut
1702    #: Return Type @;
1703  sub FeaturesByAlias {  sub FeaturesByAlias {
1704          # Get the parameters.          # Get the parameters.
1705          my $self = shift @_;          my $self = shift @_;
# Line 1657  Line 1742 
1742  =back  =back
1743    
1744  =cut  =cut
1745    #: Return Type $;
1746  sub Exists {  sub Exists {
1747          # Get the parameters.          # Get the parameters.
1748          my $self = shift @_;          my $self = shift @_;
# Line 1688  Line 1773 
1773  =back  =back
1774    
1775  =cut  =cut
1776    #: Return Type $;
1777  sub FeatureTranslation {  sub FeatureTranslation {
1778          # Get the parameters.          # Get the parameters.
1779          my $self = shift @_;          my $self = shift @_;
# Line 1721  Line 1806 
1806  =back  =back
1807    
1808  =cut  =cut
1809    #: Return Type @;
1810  sub Taxonomy {  sub Taxonomy {
1811          # Get the parameters.          # Get the parameters.
1812          my $self = shift @_;          my $self = shift @_;
# Line 1765  Line 1850 
1850  =back  =back
1851    
1852  =cut  =cut
1853    #: Return Type $;
1854  sub CrudeDistance {  sub CrudeDistance {
1855          # Get the parameters.          # Get the parameters.
1856          my $self = shift @_;          my $self = shift @_;
# Line 1813  Line 1898 
1898  =back  =back
1899    
1900  =cut  =cut
1901    #: Return Type $;
1902  sub RoleName {  sub RoleName {
1903          # Get the parameters.          # Get the parameters.
1904          my $self = shift @_;          my $self = shift @_;
# Line 1847  Line 1932 
1932  =back  =back
1933    
1934  =cut  =cut
1935    #: Return Type @;
1936  sub RoleDiagrams {  sub RoleDiagrams {
1937          # Get the parameters.          # Get the parameters.
1938          my $self = shift @_;          my $self = shift @_;
# Line 1885  Line 1970 
1970  =back  =back
1971    
1972  =cut  =cut
1973    #: Return Type @@;
1974  sub FeatureProperties {  sub FeatureProperties {
1975          # Get the parameters.          # Get the parameters.
1976          my $self = shift @_;          my $self = shift @_;
# Line 1917  Line 2002 
2002  =back  =back
2003    
2004  =cut  =cut
2005    #: Return Type $;
2006  sub DiagramName {  sub DiagramName {
2007          # Get the parameters.          # Get the parameters.
2008          my $self = shift @_;          my $self = shift @_;
# Line 1950  Line 2035 
2035  =back  =back
2036    
2037  =cut  =cut
2038    #: Return Type @;
2039  sub MergedAnnotations {  sub MergedAnnotations {
2040          # Get the parameters.          # Get the parameters.
2041          my $self = shift @_;          my $self = shift @_;
# Line 1969  Line 2054 
2054          }          }
2055          # Sort the result list by timestamp.          # Sort the result list by timestamp.
2056          my @retVal = sort { $a->[1] <=> $b->[1] } @tuples;          my @retVal = sort { $a->[1] <=> $b->[1] } @tuples;
2057        # Loop through and make the time stamps friendly.
2058        for my $tuple (@retVal) {
2059            $tuple->[1] = FriendlyTimestamp($tuple->[1]);
2060        }
2061          # Return the sorted list.          # Return the sorted list.
2062          return @retVal;          return @retVal;
2063  }  }
# Line 1995  Line 2084 
2084  =back  =back
2085    
2086  =cut  =cut
2087    #: Return Type @;
2088  sub RoleNeighbors {  sub RoleNeighbors {
2089          # Get the parameters.          # Get the parameters.
2090          my $self = shift @_;          my $self = shift @_;
# Line 2038  Line 2127 
2127  =back  =back
2128    
2129  =cut  =cut
2130    #: Return Type @;
2131  sub FeatureLinks {  sub FeatureLinks {
2132          # Get the parameters.          # Get the parameters.
2133          my $self = shift @_;          my $self = shift @_;
# Line 2069  Line 2158 
2158  =back  =back
2159    
2160  =cut  =cut
2161    #: Return Type %;
2162  sub SubsystemsOf {  sub SubsystemsOf {
2163          # Get the parameters.          # Get the parameters.
2164          my $self = shift @_;          my $self = shift @_;
# Line 2118  Line 2207 
2207  =back  =back
2208    
2209  =cut  =cut
2210    #: Return Type @;
2211  sub RelatedFeatures {  sub RelatedFeatures {
2212          # Get the parameters.          # Get the parameters.
2213          my $self = shift @_;          my $self = shift @_;
# Line 2167  Line 2256 
2256  =back  =back
2257    
2258  =cut  =cut
2259    #: Return Type @;
2260  sub TaxonomySort {  sub TaxonomySort {
2261          # Get the parameters.          # Get the parameters.
2262          my $self = shift @_;          my $self = shift @_;
# Line 2250  Line 2339 
2339  =back  =back
2340    
2341  =cut  =cut
2342    #: Return Type @@;
2343  sub GetAll {  sub GetAll {
2344          # Get the parameters.          # Get the parameters.
2345          my $self = shift @_;          my $self = shift @_;
# Line 2312  Line 2401 
2401  =back  =back
2402    
2403  =cut  =cut
2404    #: Return Type @;
2405  sub GetFlat {  sub GetFlat {
2406          # Get the parameters.          # Get the parameters.
2407          my $self = shift @_;          my $self = shift @_;
# Line 2423  Line 2512 
2512  to load the entire database.  to load the entire database.
2513    
2514  =cut  =cut
2515    #: Return Type @;
2516  sub LoadInfo {  sub LoadInfo {
2517          # Get the parameters.          # Get the parameters.
2518          my $self = shift @_;          my $self = shift @_;
# Line 2460  Line 2549 
2549  =back  =back
2550    
2551  =cut  =cut
2552    #: Return Type %;
2553  sub LowBBHs {  sub LowBBHs {
2554          # Get the parsameters.          # Get the parsameters.
2555          my $self = shift @_;          my $self = shift @_;
# Line 2480  Line 2569 
2569          return %retVal;          return %retVal;
2570  }  }
2571    
2572    =head3 GetGroups
2573    
2574    C<< my %groups = $sprout->GetGroups(\@groupList); >>
2575    
2576    Return a hash mapping each group to the IDs of the genomes in the group.
2577    A list of groups may be specified, in which case only those groups will be
2578    shown. Alternatively, if no parameter is supplied, all groups will be
2579    included. Genomes that are not in any group are omitted.
2580    
2581    =cut
2582    #: Return Type %@;
2583    sub GetGroups {
2584        # Get the parameters.
2585        my $self = shift @_;
2586        my ($groupList) = @_;
2587        # Declare the return value.
2588        my %retVal = ();
2589        # Determine whether we are getting all the groups or just some.
2590        if (defined $groupList) {
2591            # Here we have a group list. Loop through them individually,
2592            # getting a list of the relevant genomes.
2593            for my $group (@{$groupList}) {
2594                my @genomeIDs = $self->GetFlat(['Genome'], "Genome(group-name) = ?",
2595                    [$group], "Genome(id)");
2596                $retVal{$group} = \@genomeIDs;
2597            }
2598        } else {
2599            # Here we need all of the groups. In this case, we run through all
2600            # of the genome records, putting each one found into the appropriate
2601            # group. Note that we use a filter clause to insure that only genomes
2602            # in groups are included in the return set.
2603            my @genomes = $self->GetAll(['Genome'], "Genome(group-name) > ' '", [],
2604                                        ['Genome(id)', 'Genome(group-name)']);
2605            # Loop through the genomes found.
2606            for my $genome (@genomes) {
2607                # Pop this genome's ID off the current list.
2608                my @groups = @{$genome};
2609                my $genomeID = shift @groups;
2610                # Loop through the groups, adding the genome ID to each group's
2611                # list.
2612                for my $group (@groups) {
2613                    if (exists $retVal{$group}) {
2614                        push @{$retVal{$group}}, $genomeID;
2615                    } else {
2616                        $retVal{$group} = [$genomeID];
2617                    }
2618                }
2619            }
2620        }
2621        # Return the hash we just built.
2622        return %retVal;
2623    }
2624    
2625  =head2 Internal Utility Methods  =head2 Internal Utility Methods
2626    
2627  =head3 ParseAssignment  =head3 ParseAssignment
# Line 2520  Line 2662 
2662          return @retVal;          return @retVal;
2663  }  }
2664    
2665    =head3 FriendlyTimestamp
2666    
2667    Convert a time number to a user-friendly time stamp for display.
2668    
2669    This is a static method.
2670    
2671    =over 4
2672    
2673    =item timeValue
2674    
2675    Numeric time value.
2676    
2677    =item RETURN
2678    
2679    Returns a string containing the same time in user-readable format.
2680    
2681    =back
2682    
2683    =cut
2684    
2685    sub FriendlyTimestamp {
2686        my ($timeValue) = @_;
2687        my $retVal = strftime("%a %b %e %H:%M:%S %Y", localtime($timeValue));
2688        return $retVal;
2689    }
2690    
2691  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3