--- Sprout.pm 2006/09/14 14:11:09 1.84 +++ Sprout.pm 2006/10/16 07:41:50 1.92 @@ -131,6 +131,8 @@ # Add the option table and XML file name. $retVal->{_options} = $optionTable; $retVal->{_xmlName} = $xmlFileName; + # Set up space for the group file data. + $retVal->{groupHash} = undef; # Return it. return $retVal; } @@ -340,7 +342,7 @@ =head3 GeneMenu -C<< my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params); >> +C<< my $selectHtml = $sprout->GeneMenu(\%attributes, $filterString, \@params, $selected); >> Return an HTML select menu of genomes. Each genome will be an option in the menu, and will be displayed by name with the ID and a contig count attached. The selection @@ -362,6 +364,14 @@ Reference to a list of values to be substituted in for the parameter marks in the filter string. +=item selected (optional) + +ID of the genome to be initially selected. + +=item fast (optional) + +If specified and TRUE, the contig counts will be omitted to improve performance. + =item RETURN Returns an HTML select menu with the specified genomes as selectable options. @@ -372,7 +382,12 @@ sub GeneMenu { # Get the parameters. - my ($self, $attributes, $filterString, $params) = @_; + my ($self, $attributes, $filterString, $params, $selected, $fast) = @_; + my $slowMode = ! $fast; + # Default to nothing selected. This prevents an execution warning if "$selected" + # is undefined. + $selected = "" unless defined $selected; + Trace("Gene Menu called with slow mode \"$slowMode\" and selection \"$selected\".") if T(3); # Start the menu. my $retVal = "\n"; # Return the result. return $retVal; } + =head3 Build C<< $sprout->Build(); >> @@ -634,6 +655,8 @@ return ($contigID, $start, $dir, $len); } + + =head3 PointLocation C<< my $found = Sprout::PointLocation($location, $point); >> @@ -2656,6 +2679,42 @@ return $retVal; } +=head3 PropertyID + +C<< my $id = $sprout->PropertyID($propName, $propValue); >> + +Return the ID of the specified property name and value pair, if the +pair exists. + +=over 4 + +=item propName + +Name of the desired property. + +=item propValue + +Value expected for the desired property. + +=item RETURN + +Returns the ID of the name/value pair, or C if the pair does not exist. + +=back + +=cut + +sub PropertyID { + # Get the parameters. + my ($self, $propName, $propValue) = @_; + # Try to find the ID. + my ($retVal) = $self->GetFlat(['Property'], + "Property(property-name) = ? AND Property(property-value) = ?", + [$propName, $propValue], 'Property(id)'); + # Return the result. + return $retVal; +} + =head3 MergedAnnotations C<< my @annotationList = $sprout->MergedAnnotations(\@list); >> @@ -2853,10 +2912,10 @@ # Get the parameters. my ($self, $featureID) = @_; # Get the list of names. - my @retVal = $self->GetFlat(['ContainsFeature', 'HasSSCell'], "ContainsFeature(to-link) = ?", - [$featureID], 'HasSSCell(from-link)'); - # Return the result. - return @retVal; + my @retVal = $self->GetFlat(['HasRoleInSubsystem'], "HasRoleInSubsystem(from-link) = ?", + [$featureID], 'HasRoleInSubsystem(to-link)'); + # Return the result, sorted. + return sort @retVal; } =head3 GenomeSubsystemData @@ -3090,8 +3149,9 @@ # Loop through the input triples. my $n = length $sequence; for (my $i = 0; $i < $n; $i += 3) { - # Get the current triple from the sequence. - my $triple = substr($sequence, $i, 3); + # Get the current triple from the sequence. Note we convert to + # upper case to insure a match. + my $triple = uc substr($sequence, $i, 3); # Translate it using the table. my $protein = "X"; if (exists $table->{$triple}) { $protein = $table->{$triple}; } @@ -3230,6 +3290,55 @@ return $retVal; } +=head3 IsAllGenomes + +C<< my $flag = $sprout->IsAllGenomes(\@list, \@checkList); >> + +Return TRUE if all genomes in the second list are represented in the first list at +least one. Otherwise, return FALSE. If the second list is omitted, the first list is +compared to a list of all the genomes. + +=over 4 + +=item list + +Reference to the list to be compared to the second list. + +=item checkList (optional) + +Reference to the comparison target list. Every genome ID in this list must occur at +least once in the first list. If this parameter is omitted, a list of all the genomes +is used. + +=item RETURN + +Returns TRUE if every item in the second list appears at least once in the +first list, else FALSE. + +=back + +=cut + +sub IsAllGenomes { + # Get the parameters. + my ($self, $list, $checkList) = @_; + # Supply the checklist if it was omitted. + $checkList = [$self->Genomes()] if ! defined($checkList); + # Create a hash of the original list. + my %testList = map { $_ => 1 } @{$list}; + # Declare the return variable. We assume that the representation + # is complete and stop at the first failure. + my $retVal = 1; + my $n = scalar @{$checkList}; + for (my $i = 0; $retVal && $i < $n; $i++) { + if (! $testList{$checkList->[$i]}) { + $retVal = 0; + } + } + # Return the result. + return $retVal; +} + =head3 GetGroups C<< my %groups = $sprout->GetGroups(\@groupList); >> @@ -3251,7 +3360,7 @@ # Here we have a group list. Loop through them individually, # getting a list of the relevant genomes. for my $group (@{$groupList}) { - my @genomeIDs = $self->GetFlat(['Genome'], "Genome(group-name) = ?", + my @genomeIDs = $self->GetFlat(['Genome'], "Genome(primary-group) = ?", [$group], "Genome(id)"); $retVal{$group} = \@genomeIDs; } @@ -3259,9 +3368,9 @@ # Here we need all of the groups. In this case, we run through all # of the genome records, putting each one found into the appropriate # group. Note that we use a filter clause to insure that only genomes - # in groups are included in the return set. - my @genomes = $self->GetAll(['Genome'], "Genome(group-name) > ' '", [], - ['Genome(id)', 'Genome(group-name)']); + # in real NMPDR groups are included in the return set. + my @genomes = $self->GetAll(['Genome'], "Genome(primary-group) <> ?", + [$FIG_Config::otherGroup], ['Genome(id)', 'Genome(primary-group)']); # Loop through the genomes found. for my $genome (@genomes) { # Pop this genome's ID off the current list. @@ -3429,6 +3538,50 @@ return %retVal; } +=head3 GroupPageName + +C<< my $name = $sprout->GroupPageName($group); >> + +Return the name of the page for the specified NMPDR group. + +=over 4 + +=item group + +Name of the relevant group. + +=item RETURN + +Returns the relative page name (e.g. C<../content/campy.php>). If the group file is not in +memory it will be read in. + +=back + +=cut + +sub GroupPageName { + # Get the parameters. + my ($self, $group) = @_; + # Declare the return variable. + my $retVal; + # Check for the group file data. + if (! defined $self->{groupHash}) { + # Read the group file. + my %groupData = Sprout::ReadGroupFile($self->{_options}->{dataDir} . "/groups.tbl"); + # Store it in our object. + $self->{groupHash} = \%groupData; + } + # Compute the real group name. + my $realGroup = $group; + if ($group =~ /([A-Z]\w+)/) { + $realGroup = $1; + } + # Return the page name. + $retVal = "../content/" . $self->{groupHash}->{$realGroup}->[1]; + # Return the result. + return $retVal; +} + =head3 ReadGroupFile C<< my %groupData = Sprout::ReadGroupFile($groupFileName); >> @@ -3490,6 +3643,107 @@ return %retVal; } +=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. A property represents a key/value +pair. If the particular key/value pair coming in is not already in the database, a new +B 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 }); +} + +=head2 Virtual Methods + +=head3 CleanKeywords + +C<< my $cleanedString = $sprout->CleanKeywords($searchExpression); >> + +Clean up a search expression or keyword list. This involves converting the periods +in EC numbers to underscores, converting non-leading minus signs to underscores, +a vertical bar or colon to an apostrophe, and forcing lower case for all alphabetic +characters. In addition, any extra spaces are removed. + +=over 4 + +=item searchExpression + +Search expression or keyword list to clean. Note that a search expression may +contain boolean operators which need to be preserved. This includes leading +minus signs. + +=item RETURN + +Cleaned expression or keyword list. + +=back + +=cut + +sub CleanKeywords { + # Get the parameters. + my ($self, $searchExpression) = @_; + # Perform the standard cleanup. + my $retVal = $self->ERDB::CleanKeywords($searchExpression); + # Fix the periods in EC and TC numbers. + $retVal =~ s/(\d+|\-)\.(\d+|-)\.(\d+|-)\.(\d+|-)/$1_$2_$3_$4/g; + # Fix non-trailing periods. + $retVal =~ s/\.(\w)/_$1/g; + # Fix non-leading minus signs. + $retVal =~ s/(\w)[\-]/$1_/g; + # Fix the vertical bars and colons + $retVal =~ s/(\w)[|:](\w)/$1'$2/g; + # Return the result. + return $retVal; +} + =head2 Internal Utility Methods =head3 ParseAssignment @@ -3579,62 +3833,5 @@ return $retVal; } -=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. A property represents a key/value -pair. If the particular key/value pair coming in is not already in the database, a new -B 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 }); -} - 1;