[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.86, Sun Sep 24 17:14:16 2006 UTC revision 1.93, Sun Oct 22 05:15:56 2006 UTC
# Line 438  Line 438 
438      $self->CreateTables();      $self->CreateTables();
439  }  }
440    
 =head3 NmpdrGenomeMenu  
   
 C<< my $htmlText = $sprout->NmpdrGenomeMenu(\%options, \@selected); >>  
   
 This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The  
 category indicates the low-level NMPDR group. Organizing the genomes in this way makes it  
 easier to select all genomes from a particular category.  
   
 =over 4  
   
 =item options  
   
 Reference to a hash containing the options to be applied to the C<SELECT> tag form the menu.  
 Typical options would include C<name> to specify the field name, C<multiple> to specify  
 that multiple selections are allowed, and C<size> to set the number of rows to display  
 in the menu.  
   
 =item selected  
   
 Reference to a list containing the IDs of the genomes to be pre-selected. If the menu  
 is not intended to allow multiple selections, the list should be a singleton. If the  
 list is empty, nothing will be pre-selected.  
   
 =item RETURN  
   
 Returns the HTML text to generate a C<SELECT> menu inside a form.  
   
 =back  
   
 =cut  
   
 sub NmpdrGenomeMenu {  
     # Get the parameters.  
     my ($self, $options, $selected) = @_;  
     # Get a list of all the genomes in group order. In fact, we only need them ordered  
     # by name (genus,species,strain), but putting primary-group in front enables us to  
     # take advantage of an existing index.  
     my @genomeList = $self->GetAll(['Genome'],  
                                    "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",  
                                    [], ['Genome(primary-group)', 'Genome(id)',  
                                         'Genome(genus)', 'Genome(species)',  
                                         'Genome(unique-characterization)']);  
     # Create a hash to organize the genomes by group. Each group will contain a list of  
     # 2-tuples, the first element being the genome ID and the second being the genome  
     # name.  
     my %groupHash = ();  
     for my $genome (@genomeList) {  
         # Get the genome data.  
         my ($group, $genomeID, $genus, $species, $strain) = @{$genome};  
         # Form the genome name.  
         my $name = "$genus $species";  
         if ($strain) {  
             $name .= " $strain";  
         }  
         # Push the genome into the group's list.  
         push @{$groupHash{$group}}, [$genomeID, $name];  
     }  
     # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting  
     # the supporting-genome group last.  
     my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;  
     push @groups, $FIG_Config::otherGroup;  
     # Next, create a hash that specifies the pre-selected entries.  
     my %selectedHash = map { $_ => 1 } @{$selected};  
     # Create the SELECT tag and stuff it into the output array.  
     my $select = "<" . join(" ", 'SELECT', map { "$_=\"$options->{$_}\"" } keys %{$options}) . ">";  
     my @lines = ($select);  
     # Loop through the groups.  
     for my $group (@groups) {  
         # Create the option group tag.  
         my $tag = "<OPTGROUP name=\"$group\">";  
         push @lines, "  $tag";  
         # Get the genomes in the group.  
         for my $genome (@{$groupHash{$group}}) {  
             my ($genomeID, $name) = @{$genome};  
             # See if it's selected.  
             my $select = ($selectedHash{$genomeID} ? " selected" : "");  
             # Generate the option tag.  
             my $optionTag = "<OPTION value=\"$genomeID\"$select>$name</OPTION>";  
             push @lines, "    $optionTag";  
         }  
         # Close the option group.  
         push @lines, "  </OPTGROUP>";  
     }  
     # Close the SELECT tag.  
     push @lines, "</SELECT>";  
     # Assemble the lines into a string.  
     my $retVal = join("\n", @lines, "");  
     # Return the result.  
     return $retVal;  
 }  
   
441  =head3 Genomes  =head3 Genomes
442    
443  C<< my @genomes = $sprout->Genomes(); >>  C<< my @genomes = $sprout->Genomes(); >>
# Line 1012  Line 921 
921      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
922      # Declare the return variable.      # Declare the return variable.
923      my $retVal = {};      my $retVal = {};
924      # Query the genome's features and annotations. We'll put the oldest annotations      # Query the genome's features.
925      # first so that the last assignment to go into the hash will be the correct one.      my $query = $self->Get(['HasFeature', 'Feature'], "HasFeature(from-link) = ?",
     my $query = $self->Get(['HasFeature', 'IsTargetOfAnnotation', 'Annotation'],  
                            "HasFeature(from-link) = ? ORDER BY Annotation(time)",  
926                             [$genomeID]);                             [$genomeID]);
927      # Loop through the annotations.      # Loop through the features.
928      while (my $data = $query->Fetch) {      while (my $data = $query->Fetch) {
929          # Get the feature ID and annotation text.          # Get the feature ID and assignment.
930          my ($fid, $annotation) = $data->Values(['HasFeature(to-link)',          my ($fid, $assignment) = $data->Values(['Feature(id)', 'Feature(assignment)']);
931                                                  'Annotation(annotation)']);          if ($assignment) {
         # Check to see if this is an assignment. Note that the user really  
         # doesn't matter to us, other than we use it to determine whether or  
         # not this is an assignment.  
         my ($user, $assignment) = _ParseAssignment('fig', $annotation);  
         if ($user) {  
             # Here it's an assignment. We put it in the return hash, overwriting  
             # any older assignment that might be present.  
932              $retVal->{$fid} = $assignment;              $retVal->{$fid} = $assignment;
933          }          }
934      }      }
# Line 1390  Line 1290 
1290  Return the most recently-determined functional assignment of a particular feature.  Return the most recently-determined functional assignment of a particular feature.
1291    
1292  The functional assignment is handled differently depending on the type of feature. If  The functional assignment is handled differently depending on the type of feature. If
1293  the feature is identified by a FIG ID (begins with the string C<fig|>), then a functional  the feature is identified by a FIG ID (begins with the string C<fig|>), then the functional
1294  assignment is a type of annotation. The format of an assignment is described in  assignment is taken from the B<Feature> or C<Annotation> table, depending.
 L</ParseAssignment>. Its worth noting that we cannot filter on the content of the  
 annotation itself because it's a text field; however, this is not a big problem because  
 most features only have a small number of annotations.  
1295    
1296  Each user has an associated list of trusted users. The assignment returned will be the most  Each user has an associated list of trusted users. The assignment returned will be the most
1297  recent one by at least one of the trusted users. If no trusted user list is available, then  recent one by at least one of the trusted users. If no trusted user list is available, then
# Line 1413  Line 1310 
1310    
1311  =item userID (optional)  =item userID (optional)
1312    
1313  ID of the user whose function determination is desired. If omitted, only the latest  ID of the user whose function determination is desired. If omitted, the primary
1314  C<FIG> assignment will be returned.  functional assignment in the B<Feature> table will be returned.
1315    
1316  =item RETURN  =item RETURN
1317    
# Line 1431  Line 1328 
1328      my $retVal;      my $retVal;
1329      # Determine the ID type.      # Determine the ID type.
1330      if ($featureID =~ m/^fig\|/) {      if ($featureID =~ m/^fig\|/) {
1331          # Here we have a FIG feature ID. We must build the list of trusted          # Here we have a FIG feature ID.
1332          # users.          if (!$userID) {
1333                # Use the primary assignment.
1334                ($retVal) = $self->GetEntityValues('Feature', $featureID, ['Feature(assignment)']);
1335            } else {
1336                # We must build the list of trusted users.
1337          my %trusteeTable = ();          my %trusteeTable = ();
1338          # Check the user ID.          # Check the user ID.
1339          if (!$userID) {          if (!$userID) {
# Line 1475  Line 1376 
1376                  }                  }
1377              }              }
1378          }          }
1379            }
1380      } else {      } else {
1381          # Here we have a non-FIG feature ID. In this case the user ID does not          # Here we have a non-FIG feature ID. In this case the user ID does not
1382          # matter. We simply get the information from the External Alias Function          # matter. We simply get the information from the External Alias Function
# Line 2770  Line 2672 
2672      return $retVal;      return $retVal;
2673  }  }
2674    
2675    =head3 PropertyID
2676    
2677    C<< my $id = $sprout->PropertyID($propName, $propValue); >>
2678    
2679    Return the ID of the specified property name and value pair, if the
2680    pair exists.
2681    
2682    =over 4
2683    
2684    =item propName
2685    
2686    Name of the desired property.
2687    
2688    =item propValue
2689    
2690    Value expected for the desired property.
2691    
2692    =item RETURN
2693    
2694    Returns the ID of the name/value pair, or C<undef> if the pair does not exist.
2695    
2696    =back
2697    
2698    =cut
2699    
2700    sub PropertyID {
2701        # Get the parameters.
2702        my ($self, $propName, $propValue) = @_;
2703        # Try to find the ID.
2704        my ($retVal) = $self->GetFlat(['Property'],
2705                                      "Property(property-name) = ? AND Property(property-value) = ?",
2706                                      [$propName, $propValue], 'Property(id)');
2707        # Return the result.
2708        return $retVal;
2709    }
2710    
2711  =head3 MergedAnnotations  =head3 MergedAnnotations
2712    
2713  C<< my @annotationList = $sprout->MergedAnnotations(\@list); >>  C<< my @annotationList = $sprout->MergedAnnotations(\@list); >>
# Line 2967  Line 2905 
2905      # Get the parameters.      # Get the parameters.
2906      my ($self, $featureID) = @_;      my ($self, $featureID) = @_;
2907      # Get the list of names.      # Get the list of names.
2908      my @retVal = $self->GetFlat(['ContainsFeature', 'HasSSCell'], "ContainsFeature(to-link) = ?",      my @retVal = $self->GetFlat(['HasRoleInSubsystem'], "HasRoleInSubsystem(from-link) = ?",
2909                                  [$featureID], 'HasSSCell(from-link)');                                  [$featureID], 'HasRoleInSubsystem(to-link)');
2910      # Return the result.      # Return the result, sorted.
2911      return @retVal;      return sort @retVal;
2912  }  }
2913    
2914  =head3 GenomeSubsystemData  =head3 GenomeSubsystemData
# Line 3204  Line 3142 
3142      # Loop through the input triples.      # Loop through the input triples.
3143      my $n = length $sequence;      my $n = length $sequence;
3144      for (my $i = 0; $i < $n; $i += 3) {      for (my $i = 0; $i < $n; $i += 3) {
3145          # Get the current triple from the sequence.          # Get the current triple from the sequence. Note we convert to
3146          my $triple = substr($sequence, $i, 3);          # upper case to insure a match.
3147            my $triple = uc substr($sequence, $i, 3);
3148          # Translate it using the table.          # Translate it using the table.
3149          my $protein = "X";          my $protein = "X";
3150          if (exists $table->{$triple}) { $protein = $table->{$triple}; }          if (exists $table->{$triple}) { $protein = $table->{$triple}; }
# Line 3344  Line 3283 
3283      return $retVal;      return $retVal;
3284  }  }
3285    
3286    =head3 IsAllGenomes
3287    
3288    C<< my $flag = $sprout->IsAllGenomes(\@list, \@checkList); >>
3289    
3290    Return TRUE if all genomes in the second list are represented in the first list at
3291    least one. Otherwise, return FALSE. If the second list is omitted, the first list is
3292    compared to a list of all the genomes.
3293    
3294    =over 4
3295    
3296    =item list
3297    
3298    Reference to the list to be compared to the second list.
3299    
3300    =item checkList (optional)
3301    
3302    Reference to the comparison target list. Every genome ID in this list must occur at
3303    least once in the first list. If this parameter is omitted, a list of all the genomes
3304    is used.
3305    
3306    =item RETURN
3307    
3308    Returns TRUE if every item in the second list appears at least once in the
3309    first list, else FALSE.
3310    
3311    =back
3312    
3313    =cut
3314    
3315    sub IsAllGenomes {
3316        # Get the parameters.
3317        my ($self, $list, $checkList) = @_;
3318        # Supply the checklist if it was omitted.
3319        $checkList = [$self->Genomes()] if ! defined($checkList);
3320        # Create a hash of the original list.
3321        my %testList = map { $_ => 1 } @{$list};
3322        # Declare the return variable. We assume that the representation
3323        # is complete and stop at the first failure.
3324        my $retVal = 1;
3325        my $n = scalar @{$checkList};
3326        for (my $i = 0; $retVal && $i < $n; $i++) {
3327            if (! $testList{$checkList->[$i]}) {
3328                $retVal = 0;
3329            }
3330        }
3331        # Return the result.
3332        return $retVal;
3333    }
3334    
3335  =head3 GetGroups  =head3 GetGroups
3336    
3337  C<< my %groups = $sprout->GetGroups(\@groupList); >>  C<< my %groups = $sprout->GetGroups(\@groupList); >>
# Line 3648  Line 3636 
3636      return %retVal;      return %retVal;
3637  }  }
3638    
3639    =head3 AddProperty
3640    
3641    C<< my  = $sprout->AddProperty($featureID, $key, $value, $url); >>
3642    
3643    Add a new attribute value (Property) to a feature. In the SEED system, attributes can
3644    be added to almost any object. In Sprout, they can only be added to features. In
3645    Sprout, attributes are implemented using I<properties>. A property represents a key/value
3646    pair. If the particular key/value pair coming in is not already in the database, a new
3647    B<Property> record is created to hold it.
3648    
3649    =over 4
3650    
3651    =item peg
3652    
3653    ID of the feature to which the attribute is to be replied.
3654    
3655    =item key
3656    
3657    Name of the attribute (key).
3658    
3659    =item value
3660    
3661    Value of the attribute.
3662    
3663    =item url
3664    
3665    URL or text citation from which the property was obtained.
3666    
3667    =back
3668    
3669    =cut
3670    #: Return Type ;
3671    sub AddProperty {
3672        # Get the parameters.
3673        my ($self, $featureID, $key, $value, $url) = @_;
3674        # Declare the variable to hold the desired property ID.
3675        my $propID;
3676        # Attempt to find a property record for this key/value pair.
3677        my @properties = $self->GetFlat(['Property'],
3678                                       "Property(property-name) = ? AND Property(property-value) = ?",
3679                                       [$key, $value], 'Property(id)');
3680        if (@properties) {
3681            # Here the property is already in the database. We save its ID.
3682            $propID = $properties[0];
3683            # Here the property value does not exist. We need to generate an ID. It will be set
3684            # to a number one greater than the maximum value in the database. This call to
3685            # GetAll will stop after one record.
3686            my @maxProperty = $self->GetAll(['Property'], "ORDER BY Property(id) DESC", [], ['Property(id)'],
3687                                            1);
3688            $propID = $maxProperty[0]->[0] + 1;
3689            # Insert the new property value.
3690            $self->Insert('Property', { 'property-name' => $key, 'property-value' => $value, id => $propID });
3691        }
3692        # Now we connect the incoming feature to the property.
3693        $self->Insert('HasProperty', { 'from-link' => $featureID, 'to-link' => $propID, evidence => $url });
3694    }
3695    
3696    =head2 Virtual Methods
3697    
3698    =head3 CleanKeywords
3699    
3700    C<< my $cleanedString = $sprout->CleanKeywords($searchExpression); >>
3701    
3702    Clean up a search expression or keyword list. This involves converting the periods
3703    in EC numbers to underscores, converting non-leading minus signs to underscores,
3704    a vertical bar or colon to an apostrophe, and forcing lower case for all alphabetic
3705    characters. In addition, any extra spaces are removed.
3706    
3707    =over 4
3708    
3709    =item searchExpression
3710    
3711    Search expression or keyword list to clean. Note that a search expression may
3712    contain boolean operators which need to be preserved. This includes leading
3713    minus signs.
3714    
3715    =item RETURN
3716    
3717    Cleaned expression or keyword list.
3718    
3719    =back
3720    
3721    =cut
3722    
3723    sub CleanKeywords {
3724        # Get the parameters.
3725        my ($self, $searchExpression) = @_;
3726        # Perform the standard cleanup.
3727        my $retVal = $self->ERDB::CleanKeywords($searchExpression);
3728        # Fix the periods in EC and TC numbers.
3729        $retVal =~ s/(\d+|\-)\.(\d+|-)\.(\d+|-)\.(\d+|-)/$1_$2_$3_$4/g;
3730        # Fix non-trailing periods.
3731        $retVal =~ s/\.(\w)/_$1/g;
3732        # Fix non-leading minus signs.
3733        $retVal =~ s/(\w)[\-]/$1_/g;
3734        # Fix the vertical bars and colons
3735        $retVal =~ s/(\w)[|:](\w)/$1'$2/g;
3736        # Return the result.
3737        return $retVal;
3738    }
3739    
3740  =head2 Internal Utility Methods  =head2 Internal Utility Methods
3741    
3742  =head3 ParseAssignment  =head3 ParseAssignment
# Line 3737  Line 3826 
3826      return $retVal;      return $retVal;
3827  }  }
3828    
 =head3 AddProperty  
   
 C<< my  = $sprout->AddProperty($featureID, $key, $value, $url); >>  
   
 Add a new attribute value (Property) to a feature. In the SEED system, attributes can  
 be added to almost any object. In Sprout, they can only be added to features. In  
 Sprout, attributes are implemented using I<properties>. A property represents a key/value  
 pair. If the particular key/value pair coming in is not already in the database, a new  
 B<Property> record is created to hold it.  
   
 =over 4  
   
 =item peg  
   
 ID of the feature to which the attribute is to be replied.  
   
 =item key  
   
 Name of the attribute (key).  
   
 =item value  
   
 Value of the attribute.  
   
 =item url  
   
 URL or text citation from which the property was obtained.  
   
 =back  
   
 =cut  
 #: Return Type ;  
 sub AddProperty {  
     # Get the parameters.  
     my ($self, $featureID, $key, $value, $url) = @_;  
     # Declare the variable to hold the desired property ID.  
     my $propID;  
     # Attempt to find a property record for this key/value pair.  
     my @properties = $self->GetFlat(['Property'],  
                                    "Property(property-name) = ? AND Property(property-value) = ?",  
                                    [$key, $value], 'Property(id)');  
     if (@properties) {  
         # Here the property is already in the database. We save its ID.  
         $propID = $properties[0];  
         # Here the property value does not exist. We need to generate an ID. It will be set  
         # to a number one greater than the maximum value in the database. This call to  
         # GetAll will stop after one record.  
         my @maxProperty = $self->GetAll(['Property'], "ORDER BY Property(id) DESC", [], ['Property(id)'],  
                                         1);  
         $propID = $maxProperty[0]->[0] + 1;  
         # Insert the new property value.  
         $self->Insert('Property', { 'property-name' => $key, 'property-value' => $value, id => $propID });  
     }  
     # Now we connect the incoming feature to the property.  
     $self->Insert('HasProperty', { 'from-link' => $featureID, 'to-link' => $propID, evidence => $url });  
 }  
   
3829    
3830  1;  1;

Legend:
Removed from v.1.86  
changed lines
  Added in v.1.93

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3