[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.1, Sun Jan 23 16:12:29 2005 UTC revision 1.4, Tue Jan 25 01:36:09 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    
40  =head2 Public Methods  =head2 Public Methods
41    
# Line 121  Line 123 
123  and 10999.  and 10999.
124    
125  =cut  =cut
126    #: Return Type $;
127  sub MaxSegment {  sub MaxSegment {
128          my $self = shift @_;          my $self = shift @_;
129          return $self->{_options}->{maxSegmentLength};          return $self->{_options}->{maxSegmentLength};
# Line 136  Line 138 
138  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.
139    
140  =cut  =cut
141    #: Return Type $;
142  sub MaxSequence {  sub MaxSequence {
143          my $self = shift @_;          my $self = shift @_;
144          return $self->{_options}->{maxSequenceLength};          return $self->{_options}->{maxSequenceLength};
# Line 305  Line 307 
307  =back  =back
308    
309  =cut  =cut
310    #: Return Type @;
311  sub GetEntityValues {  sub GetEntityValues {
312          # Get the parameters.          # Get the parameters.
313          my $self = shift @_;          my $self = shift @_;
# Line 378  Line 380 
380  =back  =back
381    
382  =cut  =cut
383    #: Return Type %;
384  sub Load {  sub Load {
385          # Get the parameters.          # Get the parameters.
386          my $self = shift @_;          my $self = shift @_;
# Line 422  Line 424 
424  =back  =back
425    
426  =cut  =cut
427    #: Return Type %;
428  sub LoadUpdate {  sub LoadUpdate {
429          # Get the parameters.          # Get the parameters.
430          my $self = shift @_;          my $self = shift @_;
# Line 459  Line 461 
461  changed.  changed.
462    
463  =cut  =cut
464    #: Return Type ;
465  sub Build {  sub Build {
466          # Get the parameters.          # Get the parameters.
467          my $self = shift @_;          my $self = shift @_;
# Line 474  Line 476 
476  Return a list of all the genome IDs.  Return a list of all the genome IDs.
477    
478  =cut  =cut
479    #: Return Type @;
480  sub Genomes {  sub Genomes {
481          # Get the parameters.          # Get the parameters.
482          my $self = shift @_;          my $self = shift @_;
# Line 504  Line 506 
506  =back  =back
507    
508  =cut  =cut
509    #: Return Type $;
510  sub GenusSpecies {  sub GenusSpecies {
511          # Get the parameters.          # Get the parameters.
512          my $self = shift @_;          my $self = shift @_;
# Line 541  Line 543 
543  =back  =back
544    
545  =cut  =cut
546    #: Return Type @;
547  sub FeaturesOf {  sub FeaturesOf {
548          # Get the parameters.          # Get the parameters.
549          my $self = shift @_;          my $self = shift @_;
# Line 594  Line 596 
596  =back  =back
597    
598  =cut  =cut
599    #: Return Type @;
600    #: Return Type $;
601  sub FeatureLocation {  sub FeatureLocation {
602          # Get the parameters.          # Get the parameters.
603          my $self = shift @_;          my $self = shift @_;
# Line 656  Line 659 
659  =back  =back
660    
661  =cut  =cut
662    #: Return Type @;
663  sub ParseLocation {  sub ParseLocation {
664          # Get the parameter.          # Get the parameter.
665          my ($location) = @_;          my ($location) = @_;
# Line 682  Line 685 
685  C<< my $sequence = $sprout->DNASeq(\@locationList); >>  C<< my $sequence = $sprout->DNASeq(\@locationList); >>
686    
687  This method returns the DNA sequence represented by a list of locations. The list of locations  This method returns the DNA sequence represented by a list of locations. The list of locations
688  should be of the form returned by L</feature_location> when in a list context. In other words,  should be of the form returned by L</featureLocation> when in a list context. In other words,
689  each location is of the form I<contigID>C<_>I<begin>I<dir>I<end>.  each location is of the form I<contigID>C<_>I<begin>I<dir>I<end>.
690    
691  =over 4  =over 4
# Line 699  Line 702 
702  =back  =back
703    
704  =cut  =cut
705    #: Return Type $;
706  sub DNASeq {  sub DNASeq {
707          # Get the parameters.          # Get the parameters.
708          my $self = shift @_;          my $self = shift @_;
# Line 773  Line 776 
776  =back  =back
777    
778  =cut  =cut
779    #: Return Type @;
780  sub AllContigs {  sub AllContigs {
781          # Get the parameters.          # Get the parameters.
782          my $self = shift @_;          my $self = shift @_;
# Line 797  Line 800 
800    
801  ID of the contig whose length is desired.  ID of the contig whose length is desired.
802    
803    =item RETURN
804    
805    Returns the number of positions in the contig.
806    
807  =back  =back
808    
809  =cut  =cut
810    #: Return Type $;
811  sub ContigLength {  sub ContigLength {
812          # Get the parameters.          # Get the parameters.
813          my $self = shift @_;          my $self = shift @_;
# Line 851  Line 858 
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 934  Line 941 
941  =back  =back
942    
943  =cut  =cut
944    #: Return Type $;
945  sub FType {  sub FType {
946          # Get the parameters.          # Get the parameters.
947          my $self = shift @_;          my $self = shift @_;
# Line 963  Line 970 
970    
971  * B<featureID> ID of the relevant feature.  * B<featureID> ID of the relevant feature.
972    
973  * B<timeStamp> time the annotation was made.  * B<timeStamp> time the annotation was made, in user-friendly format.
974    
975  * B<user> ID of the user who made the annotation  * B<user> ID of the user who made the annotation
976    
# Line 972  Line 979 
979  =back  =back
980    
981  =cut  =cut
982    #: Return Type @%;
983  sub FeatureAnnotations {  sub FeatureAnnotations {
984          # Get the parameters.          # Get the parameters.
985          my $self = shift @_;          my $self = shift @_;
# Line 990  Line 997 
997                                                                   'Annotation(time)', 'MadeAnnotation(from-link)',                                                                   'Annotation(time)', 'MadeAnnotation(from-link)',
998                                                                   'Annotation(annotation)']);                                                                   'Annotation(annotation)']);
999                  # Assemble them into a hash.                  # Assemble them into a hash.
1000                  my $annotationHash = { featureID => $featureID, timeStamp => $timeStamp,          my $annotationHash = { featureID => $featureID,
1001                                   timeStamp => FriendlyTimestamp($timeStamp),
1002                                                             user => $user, text => $text };                                                             user => $user, text => $text };
1003                  # Add it to the return list.                  # Add it to the return list.
1004                  push @retVal, $annotationHash;                  push @retVal, $annotationHash;
# Line 1016  Line 1024 
1024    
1025  ID of the feature whose functional assignments are desired.  ID of the feature whose functional assignments are desired.
1026    
1027    =item RETURN
1028    
1029    Returns a hash mapping the functional assignment IDs to user IDs.
1030    
1031  =back  =back
1032    
1033  =cut  =cut
1034    #: Return Type %;
1035  sub AllFunctionsOf {  sub AllFunctionsOf {
1036          # Get the parameters.          # Get the parameters.
1037          my $self = shift @_;          my $self = shift @_;
# Line 1047  Line 1059 
1059    
1060  C<< my $functionText = $sprout->FunctionOf($featureID, $userID); >>  C<< my $functionText = $sprout->FunctionOf($featureID, $userID); >>
1061    
1062  Return the most recently-determined functional assignment of a particular feature. A functional  Return the most recently-determined functional assignment of a particular feature.
1063    
1064    The functional assignment is handled differently depending on the type of feature. If
1065    the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional
1066  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
1067  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
1068  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
1069  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.
1070    
1071    Each user has an associated list of trusted users. The assignment returned will be the most
1072    recent one by at least one of the trusted users. If no trusted user list is available, then
1073    the specified user and FIG are considered trusted. If the user ID is omitted, only FIG
1074    is trusted.
1075    
1076    If the feature is B<not> identified by a FIG ID, then the functional assignment
1077    information is taken from the B<ExternalAliasFunc> table. If the table does
1078    not contain an entry for the feature, an undefined value is returned.
1079    
1080  =over 4  =over 4
1081    
1082  =item featureID  =item featureID
# Line 1061  Line 1085 
1085    
1086  =item userID (optional)  =item userID (optional)
1087    
1088  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
1089    C<FIG> assignment will be returned.
1090    
1091  =item RETURN  =item RETURN
1092    
# Line 1070  Line 1095 
1095  =back  =back
1096    
1097  =cut  =cut
1098    #: Return Type $;
1099  sub FunctionOf {  sub FunctionOf {
1100          # Get the parameters.          # Get the parameters.
1101          my $self = shift @_;          my $self = shift @_;
1102          my ($featureID, $userID) = @_;          my ($featureID, $userID) = @_;
1103          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.  
1104          my $retVal;          my $retVal;
1105        # Determine the ID type.
1106        if ($featureID =~ m/^fig\|/) {
1107            # Here we have a FIG feature ID. We must build the list of trusted
1108            # users.
1109            my %trusteeTable = ();
1110            # Check the user ID.
1111            if (!$userID) {
1112                # No user ID, so only FIG is trusted.
1113                $trusteeTable{FIG} = 1;
1114            } else {
1115                # Add this user's ID.
1116                $trusteeTable{$userID} = 1;
1117                # Look for the trusted users in the database.
1118                my @trustees = $self->GetFlat(['IsTrustedBy'], 'IsTrustedBy(from-link) = ?', [$userID], 'IsTrustedBy(to-link)');
1119                if (! @trustees) {
1120                    # None were found, so build a default list.
1121                    $trusteeTable{FIG} = 1;
1122                } else {
1123                    # Otherwise, put all the trustees in.
1124                    for my $trustee (@trustees) {
1125                        $trusteeTable{$trustee} = 1;
1126                    }
1127                }
1128            }
1129            # Build a query for all of the feature's annotations, sorted by date.
1130            my $query = $self->Get(['IsTargetOfAnnotation', 'Annotation'],
1131                                   "IsTargetOfAnnotation(from-link) = ? ORDER BY Annotation(time) DESC",
1132                                   [$featureID]);
1133          my $timeSelected = 0;          my $timeSelected = 0;
1134          # Loop until we run out of annotations.          # Loop until we run out of annotations.
1135          while (my $annotation = $query->Fetch()) {          while (my $annotation = $query->Fetch()) {
1136                  # Get the annotation text.                  # Get the annotation text.
1137                  my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);                  my ($text, $time) = $annotation->Values(['Annotation(annotation)','Annotation(time)']);
1138                  # 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.
1139                  my ($user, $type, $function) = split(/\n/, $text);                  my ($user, $type, $function) = split(/\n/, $text);
1140                  if ($type =~ m/^set $userID function to$/i) {              if ($type =~ m/^set $user function to$/i) {
1141                          # 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
1142                          if ($time > $timeSelected) {                  # name. The time must be recent and the user must be trusted.
1143                    if ((exists $trusteeTable{$user}) && ($time > $timeSelected)) {
1144                                  $retVal = $function;                                  $retVal = $function;
1145                                  $timeSelected = $time;                                  $timeSelected = $time;
1146                          }                          }
1147                  }                  }
1148          }          }
1149        } else {
1150            # Here we have a non-FIG feature ID. In this case the user ID does not
1151            # matter. We simply get the information from the External Alias Function
1152            # table.
1153            ($retVal) = $self->GetEntityValues('ExternalAliasFunc', $featureID, ['ExternalAliasFunc(func)']);
1154        }
1155          # Return the assignment found.          # Return the assignment found.
1156          return $retVal;          return $retVal;
1157  }  }
# Line 1126  Line 1181 
1181  =back  =back
1182    
1183  =cut  =cut
1184    #: Return Type %;
1185  sub BBHList {  sub BBHList {
1186          # Get the parameters.          # Get the parameters.
1187          my $self = shift @_;          my $self = shift @_;
# Line 1170  Line 1225 
1225  =back  =back
1226    
1227  =cut  =cut
1228    #: Return Type @;
1229  sub FeatureAliases {  sub FeatureAliases {
1230          # Get the parameters.          # Get the parameters.
1231          my $self = shift @_;          my $self = shift @_;
# Line 1201  Line 1256 
1256  =back  =back
1257    
1258  =cut  =cut
1259    #: Return Type $;
1260  sub GenomeOf {  sub GenomeOf {
1261          # Get the parameters.          # Get the parameters.
1262          my $self = shift @_;          my $self = shift @_;
# Line 1238  Line 1293 
1293  =back  =back
1294    
1295  =cut  =cut
1296    #: Return Type %;
1297  sub CoupledFeatures {  sub CoupledFeatures {
1298          # Get the parameters.          # Get the parameters.
1299          my $self = shift @_;          my $self = shift @_;
# Line 1275  Line 1330 
1330  Return the list of supported entity types.  Return the list of supported entity types.
1331    
1332  =cut  =cut
1333    #: Return Type @;
1334  sub GetEntityTypes {  sub GetEntityTypes {
1335          # Get the parameters.          # Get the parameters.
1336          my $self = shift @_;          my $self = shift @_;
# Line 1310  Line 1365 
1365  =back  =back
1366    
1367  =cut  =cut
1368    #: Return Type %;
1369  sub ReadFasta {  sub ReadFasta {
1370          # Get the parameters.          # Get the parameters.
1371          my ($fileName, $prefix) = @_;          my ($fileName, $prefix) = @_;
# Line 1378  Line 1433 
1433  =back  =back
1434    
1435  =cut  =cut
1436    #: Return Type @;
1437  sub FormatLocations {  sub FormatLocations {
1438          # Get the parameters.          # Get the parameters.
1439          my $self = shift @_;          my $self = shift @_;
# Line 1436  Line 1491 
1491  Return the name of this database's XML definition file.  Return the name of this database's XML definition file.
1492    
1493  =cut  =cut
1494    #: Return Type $;
1495  sub XMLFileName {  sub XMLFileName {
1496          my $self = shift @_;          my $self = shift @_;
1497          return $self->{_xmlName};          return $self->{_xmlName};
# Line 1473  Line 1528 
1528  =back  =back
1529    
1530  =cut  =cut
1531    #: Return Type ;
1532  sub Insert {  sub Insert {
1533          # Get the parameters.          # Get the parameters.
1534          my $self = shift @_;          my $self = shift @_;
# Line 1515  Line 1570 
1570  =back  =back
1571    
1572  =cut  =cut
1573    #: Return Type $;
1574  sub Annotate {  sub Annotate {
1575          # Get the parameters.          # Get the parameters.
1576          my $self = shift @_;          my $self = shift @_;
# Line 1566  Line 1621 
1621  =back  =back
1622    
1623  =cut  =cut
1624    #: Return Type $;
1625  sub AssignFunction {  sub AssignFunction {
1626          # Get the parameters.          # Get the parameters.
1627          my $self = shift @_;          my $self = shift @_;
# Line 1614  Line 1669 
1669  =back  =back
1670    
1671  =cut  =cut
1672    #: Return Type @;
1673  sub FeaturesByAlias {  sub FeaturesByAlias {
1674          # Get the parameters.          # Get the parameters.
1675          my $self = shift @_;          my $self = shift @_;
# Line 1657  Line 1712 
1712  =back  =back
1713    
1714  =cut  =cut
1715    #: Return Type $;
1716  sub Exists {  sub Exists {
1717          # Get the parameters.          # Get the parameters.
1718          my $self = shift @_;          my $self = shift @_;
# Line 1688  Line 1743 
1743  =back  =back
1744    
1745  =cut  =cut
1746    #: Return Type $;
1747  sub FeatureTranslation {  sub FeatureTranslation {
1748          # Get the parameters.          # Get the parameters.
1749          my $self = shift @_;          my $self = shift @_;
# Line 1721  Line 1776 
1776  =back  =back
1777    
1778  =cut  =cut
1779    #: Return Type @;
1780  sub Taxonomy {  sub Taxonomy {
1781          # Get the parameters.          # Get the parameters.
1782          my $self = shift @_;          my $self = shift @_;
# Line 1765  Line 1820 
1820  =back  =back
1821    
1822  =cut  =cut
1823    #: Return Type $;
1824  sub CrudeDistance {  sub CrudeDistance {
1825          # Get the parameters.          # Get the parameters.
1826          my $self = shift @_;          my $self = shift @_;
# Line 1813  Line 1868 
1868  =back  =back
1869    
1870  =cut  =cut
1871    #: Return Type $;
1872  sub RoleName {  sub RoleName {
1873          # Get the parameters.          # Get the parameters.
1874          my $self = shift @_;          my $self = shift @_;
# Line 1847  Line 1902 
1902  =back  =back
1903    
1904  =cut  =cut
1905    #: Return Type @;
1906  sub RoleDiagrams {  sub RoleDiagrams {
1907          # Get the parameters.          # Get the parameters.
1908          my $self = shift @_;          my $self = shift @_;
# Line 1885  Line 1940 
1940  =back  =back
1941    
1942  =cut  =cut
1943    #: Return Type @@;
1944  sub FeatureProperties {  sub FeatureProperties {
1945          # Get the parameters.          # Get the parameters.
1946          my $self = shift @_;          my $self = shift @_;
# Line 1917  Line 1972 
1972  =back  =back
1973    
1974  =cut  =cut
1975    #: Return Type $;
1976  sub DiagramName {  sub DiagramName {
1977          # Get the parameters.          # Get the parameters.
1978          my $self = shift @_;          my $self = shift @_;
# Line 1950  Line 2005 
2005  =back  =back
2006    
2007  =cut  =cut
2008    #: Return Type @;
2009  sub MergedAnnotations {  sub MergedAnnotations {
2010          # Get the parameters.          # Get the parameters.
2011          my $self = shift @_;          my $self = shift @_;
# Line 1969  Line 2024 
2024          }          }
2025          # Sort the result list by timestamp.          # Sort the result list by timestamp.
2026          my @retVal = sort { $a->[1] <=> $b->[1] } @tuples;          my @retVal = sort { $a->[1] <=> $b->[1] } @tuples;
2027        # Loop through and make the time stamps friendly.
2028        for my $tuple (@retVal) {
2029            $tuple->[1] = FriendlyTimestamp($tuple->[1]);
2030        }
2031          # Return the sorted list.          # Return the sorted list.
2032          return @retVal;          return @retVal;
2033  }  }
# Line 1995  Line 2054 
2054  =back  =back
2055    
2056  =cut  =cut
2057    #: Return Type @;
2058  sub RoleNeighbors {  sub RoleNeighbors {
2059          # Get the parameters.          # Get the parameters.
2060          my $self = shift @_;          my $self = shift @_;
# Line 2038  Line 2097 
2097  =back  =back
2098    
2099  =cut  =cut
2100    #: Return Type @;
2101  sub FeatureLinks {  sub FeatureLinks {
2102          # Get the parameters.          # Get the parameters.
2103          my $self = shift @_;          my $self = shift @_;
# Line 2069  Line 2128 
2128  =back  =back
2129    
2130  =cut  =cut
2131    #: Return Type %;
2132  sub SubsystemsOf {  sub SubsystemsOf {
2133          # Get the parameters.          # Get the parameters.
2134          my $self = shift @_;          my $self = shift @_;
# Line 2118  Line 2177 
2177  =back  =back
2178    
2179  =cut  =cut
2180    #: Return Type @;
2181  sub RelatedFeatures {  sub RelatedFeatures {
2182          # Get the parameters.          # Get the parameters.
2183          my $self = shift @_;          my $self = shift @_;
# Line 2167  Line 2226 
2226  =back  =back
2227    
2228  =cut  =cut
2229    #: Return Type @;
2230  sub TaxonomySort {  sub TaxonomySort {
2231          # Get the parameters.          # Get the parameters.
2232          my $self = shift @_;          my $self = shift @_;
# Line 2250  Line 2309 
2309  =back  =back
2310    
2311  =cut  =cut
2312    #: Return Type @@;
2313  sub GetAll {  sub GetAll {
2314          # Get the parameters.          # Get the parameters.
2315          my $self = shift @_;          my $self = shift @_;
# Line 2312  Line 2371 
2371  =back  =back
2372    
2373  =cut  =cut
2374    #: Return Type @;
2375  sub GetFlat {  sub GetFlat {
2376          # Get the parameters.          # Get the parameters.
2377          my $self = shift @_;          my $self = shift @_;
# Line 2423  Line 2482 
2482  to load the entire database.  to load the entire database.
2483    
2484  =cut  =cut
2485    #: Return Type @;
2486  sub LoadInfo {  sub LoadInfo {
2487          # Get the parameters.          # Get the parameters.
2488          my $self = shift @_;          my $self = shift @_;
# Line 2460  Line 2519 
2519  =back  =back
2520    
2521  =cut  =cut
2522    #: Return Type %;
2523  sub LowBBHs {  sub LowBBHs {
2524          # Get the parsameters.          # Get the parsameters.
2525          my $self = shift @_;          my $self = shift @_;
# Line 2520  Line 2579 
2579          return @retVal;          return @retVal;
2580  }  }
2581    
2582    =head3 FriendlyTimestamp
2583    
2584    Convert a time number to a user-friendly time stamp for display.
2585    
2586    This is a static method.
2587    
2588    =over 4
2589    
2590    =item timeValue
2591    
2592    Numeric time value.
2593    
2594    =item RETURN
2595    
2596    Returns a string containing the same time in user-readable format.
2597    
2598    =back
2599    
2600    =cut
2601    
2602    sub FriendlyTimestamp {
2603        my ($timeValue) = @_;
2604        my $retVal = strftime("%a %b %e %H:%M:%S %Y", localtime($timeValue));
2605        return $retVal;
2606    }
2607    
2608  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3