[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.84, Thu Sep 14 14:11:09 2006 UTC revision 1.93, Sun Oct 22 05:15:56 2006 UTC
# Line 131  Line 131 
131      # Add the option table and XML file name.      # Add the option table and XML file name.
132      $retVal->{_options} = $optionTable;      $retVal->{_options} = $optionTable;
133      $retVal->{_xmlName} = $xmlFileName;      $retVal->{_xmlName} = $xmlFileName;
134        # Set up space for the group file data.
135        $retVal->{groupHash} = undef;
136      # Return it.      # Return it.
137      return $retVal;      return $retVal;
138  }  }
# Line 340  Line 342 
342    
343  =head3 GeneMenu  =head3 GeneMenu
344    
345  C<< my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params); >>  C<< my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params, $selected); >>
346    
347  Return an HTML select menu of genomes. Each genome will be an option in the menu,  Return an HTML select menu of genomes. Each genome will be an option in the menu,
348  and will be displayed by name with the ID and a contig count attached. The selection  and will be displayed by name with the ID and a contig count attached. The selection
# Line 362  Line 364 
364  Reference to a list of values to be substituted in for the parameter marks in  Reference to a list of values to be substituted in for the parameter marks in
365  the filter string.  the filter string.
366    
367    =item selected (optional)
368    
369    ID of the genome to be initially selected.
370    
371    =item fast (optional)
372    
373    If specified and TRUE, the contig counts will be omitted to improve performance.
374    
375  =item RETURN  =item RETURN
376    
377  Returns an HTML select menu with the specified genomes as selectable options.  Returns an HTML select menu with the specified genomes as selectable options.
# Line 372  Line 382 
382    
383  sub GeneMenu {  sub GeneMenu {
384      # Get the parameters.      # Get the parameters.
385      my ($self, $attributes, $filterString, $params) = @_;      my ($self, $attributes, $filterString, $params, $selected, $fast) = @_;
386        my $slowMode = ! $fast;
387        # Default to nothing selected. This prevents an execution warning if "$selected"
388        # is undefined.
389        $selected = "" unless defined $selected;
390        Trace("Gene Menu called with slow mode \"$slowMode\" and selection \"$selected\".") if T(3);
391      # Start the menu.      # Start the menu.
392      my $retVal = "<select " .      my $retVal = "<select " .
393          join(" ", map { "$_=\"$attributes->{$_}\"" } keys %{$attributes}) .          join(" ", map { "$_=\"$attributes->{$_}\"" } keys %{$attributes}) .
# Line 389  Line 404 
404          # Get the data for this genome.          # Get the data for this genome.
405          my ($genomeID, $genus, $species, $strain) = @{$genomeData};          my ($genomeID, $genus, $species, $strain) = @{$genomeData};
406          # Get the contig count.          # Get the contig count.
407            my $contigInfo = "";
408            if ($slowMode) {
409          my $count = $self->ContigCount($genomeID);          my $count = $self->ContigCount($genomeID);
410          my $counting = ($count == 1 ? "contig" : "contigs");          my $counting = ($count == 1 ? "contig" : "contigs");
411                $contigInfo = "[$count $counting]";
412            }
413            # Find out if we're selected.
414            my $selectOption = ($selected eq $genomeID ? " selected" : "");
415          # Build the option tag.          # Build the option tag.
416          $retVal .= "<option value=\"$genomeID\">$genus $species $strain ($genomeID) [$count $counting]</option>\n";          $retVal .= "<option value=\"$genomeID\"$selectOption>$genus $species $strain ($genomeID)$contigInfo</option>\n";
         Trace("Option tag built for $genomeID: $genus $species $strain.") if T(3);  
417      }      }
418      # Close the SELECT tag.      # Close the SELECT tag.
419      $retVal .= "</select>\n";      $retVal .= "</select>\n";
420      # Return the result.      # Return the result.
421      return $retVal;      return $retVal;
422  }  }
423    
424  =head3 Build  =head3 Build
425    
426  C<< $sprout->Build(); >>  C<< $sprout->Build(); >>
# Line 634  Line 655 
655      return ($contigID, $start, $dir, $len);      return ($contigID, $start, $dir, $len);
656  }  }
657    
658    
659    
660  =head3 PointLocation  =head3 PointLocation
661    
662  C<< my $found = Sprout::PointLocation($location, $point); >>  C<< my $found = Sprout::PointLocation($location, $point); >>
# Line 898  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 1276  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 1299  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 1317  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 1361  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 2656  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 2853  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 3090  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 3230  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 3251  Line 3353 
3353          # Here we have a group list. Loop through them individually,          # Here we have a group list. Loop through them individually,
3354          # getting a list of the relevant genomes.          # getting a list of the relevant genomes.
3355          for my $group (@{$groupList}) {          for my $group (@{$groupList}) {
3356              my @genomeIDs = $self->GetFlat(['Genome'], "Genome(group-name) = ?",              my @genomeIDs = $self->GetFlat(['Genome'], "Genome(primary-group) = ?",
3357                  [$group], "Genome(id)");                  [$group], "Genome(id)");
3358              $retVal{$group} = \@genomeIDs;              $retVal{$group} = \@genomeIDs;
3359          }          }
# Line 3259  Line 3361 
3361          # Here we need all of the groups. In this case, we run through all          # Here we need all of the groups. In this case, we run through all
3362          # of the genome records, putting each one found into the appropriate          # of the genome records, putting each one found into the appropriate
3363          # group. Note that we use a filter clause to insure that only genomes          # group. Note that we use a filter clause to insure that only genomes
3364          # in groups are included in the return set.          # in real NMPDR groups are included in the return set.
3365          my @genomes = $self->GetAll(['Genome'], "Genome(group-name) > ' '", [],          my @genomes = $self->GetAll(['Genome'], "Genome(primary-group) <> ?",
3366                                      ['Genome(id)', 'Genome(group-name)']);                                      [$FIG_Config::otherGroup], ['Genome(id)', 'Genome(primary-group)']);
3367          # Loop through the genomes found.          # Loop through the genomes found.
3368          for my $genome (@genomes) {          for my $genome (@genomes) {
3369              # Pop this genome's ID off the current list.              # Pop this genome's ID off the current list.
# Line 3429  Line 3531 
3531      return %retVal;      return %retVal;
3532  }  }
3533    
3534    =head3 GroupPageName
3535    
3536    C<< my $name = $sprout->GroupPageName($group); >>
3537    
3538    Return the name of the page for the specified NMPDR group.
3539    
3540    =over 4
3541    
3542    =item group
3543    
3544    Name of the relevant group.
3545    
3546    =item RETURN
3547    
3548    Returns the relative page name (e.g. C<../content/campy.php>). If the group file is not in
3549    memory it will be read in.
3550    
3551    =back
3552    
3553    =cut
3554    
3555    sub GroupPageName {
3556        # Get the parameters.
3557        my ($self, $group) = @_;
3558        # Declare the return variable.
3559        my $retVal;
3560        # Check for the group file data.
3561        if (! defined $self->{groupHash}) {
3562            # Read the group file.
3563            my %groupData = Sprout::ReadGroupFile($self->{_options}->{dataDir} . "/groups.tbl");
3564            # Store it in our object.
3565            $self->{groupHash} = \%groupData;
3566        }
3567        # Compute the real group name.
3568        my $realGroup = $group;
3569        if ($group =~ /([A-Z]\w+)/) {
3570            $realGroup = $1;
3571        }
3572        # Return the page name.
3573        $retVal = "../content/" . $self->{groupHash}->{$realGroup}->[1];
3574        # Return the result.
3575        return $retVal;
3576    }
3577    
3578  =head3 ReadGroupFile  =head3 ReadGroupFile
3579    
3580  C<< my %groupData = Sprout::ReadGroupFile($groupFileName); >>  C<< my %groupData = Sprout::ReadGroupFile($groupFileName); >>
# Line 3490  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 3579  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.84  
changed lines
  Added in v.1.93

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3