--- SearchHelper.pm 2006/11/30 23:04:37 1.21 +++ SearchHelper.pm 2009/03/07 18:07:36 1.46 @@ -10,15 +10,17 @@ use File::Path; use File::stat; use LWP::UserAgent; - use Time::HiRes 'gettimeofday'; + use FIGRules; use Sprout; use SFXlate; use FIGRules; use HTML; use BasicLocation; - use FeatureQuery; use URI::Escape; use PageBuilder; + use AliasAnalysis; + use CGI::Cookie; + use FreezeThaw qw(freeze thaw); =head1 Search Helper Base Class @@ -65,7 +67,8 @@ =item orgs -Reference to a hash mapping genome IDs to organism names. +Reference to a hash mapping genome IDs to organism data. (Used to +improve performance.) =item name @@ -83,10 +86,9 @@ List of the parameters that are used to select multiple genomes. -=item filtered +=item notices -TRUE if this is a feature-filtered search, else FALSE. B that this -field is updated by the B object. +A list of messages to be put in the notice file. =back @@ -103,7 +105,8 @@ =item 2 Create a new subclass of this object and implement each of the virtual methods. The -name of the subclass must be CI. +name of the subclass must be CI, where I is the +type of search. =item 3 @@ -113,7 +116,9 @@ =item 4 -In the C script and add a C statement for your search tool. +If your search produces a result for which a helper does not exist, you +must create a new subclass of B. Its name must be +CI, where I is the type of result. =back @@ -149,46 +154,25 @@ Several helper methods are provided for particular purposes. -=over 4 - -=item 1 - L generates a control for selecting one or more genomes. Use L to retrieve all the genomes passed in for a specified parameter name. Note that as an assist to people working with GET-style links, if no genomes are specified and the incoming request style is GET, all genomes will be returned. -=item 2 - -L formats several rows of controls for filtering features. -When you start building the code for the L method, you can use a -B object to automatically filter each genome's features using -the values from the filter controls. - -=item 3 - L allows you to queue JavaScript statements for execution after the form is fully generated. If you are using very complicated form controls, the L method allows you to perform JavaScript initialization. The L control uses this facility to display a list of the pre-selected genomes. -=back - -If you are doing a feature search, you can also change the list of feature -columns displayed and their display order by overriding -L. - Finally, when generating the code for your controls, be sure to use any incoming query parameters as default values so that the search request is persistent. =head3 Finding Search Results -The L method is used to create the search results. For a search that -wants to return features (which is most of them), the basic code structure -would work as follows. It is assumed that the L method -has been used to create feature filtering parameters. +The L method is used to create the search results. The basic code +structure would work as follows. sub Find { my ($self) = @_; @@ -201,21 +185,30 @@ ... validate the parameters ... if (... invalid parameters...) { $self->SetMessage(...appropriate message...); - } elsif (FeatureQuery::Valid($self)) { + } else { + # Determine the result type. + my $rhelp = SearchHelper::GetHelper($self, RH => $resultType); + # Specify the columns. + $self->DefaultColumns($rhelp); + # You may want to add extra columns. $name is the column name and + # $loc is its location. The other parameters take their names from the + # corresponding column methods. + $rhelp->AddExtraColumn($name => $loc, style => $style, download => $flag, + title => $title); + # Some searches require optional columns that are configured by the + # user or by the search query itself. There are some special methods + # for this in the result helpers, but there's also the direct approach + # shown below. + $rhelp->AddOptionalColumn($name => $loc); # Initialize the session file. - $self->OpenSession(); + $self->OpenSession($rhelp); # Initialize the result counter. $retVal = 0; - ... get a list of genomes ... - for my $genomeID (... each genome ...) { - my $fq = FeatureQuery->new($self, $genomeID); - while (my $feature = $fq->Fetch()) { - ... examine the feature ... - if (... we want to keep it ...) { - $self->PutFeature($fq); - $retVal++; - } - } + ... set up to loop through the results ... + while (...more results...) { + ...compute extra columns and call PutExtraColumns... + $rhelp->PutData($sortKey, $objectID, $record); + $retVal++; } # Close the session file. $self->CloseSession(); @@ -225,15 +218,17 @@ } A Find method is of course much more complicated than generating a form, and there -are variations on the above theme. For example, you could eschew feature filtering -entirely in favor of your own custom filtering, you could include extra columns -in the output, or you could search for something that's not a feature at all. The -above code is just a loose framework. +are variations on the above theme. -If you wish to add your own extra columns to the output, use the B -method of the feature query object. +In addition to the finding and filtering, it is necessary to send status messages +to the output so that the user does not get bored waiting for results. The L +method performs this function. The single parameter should be text to be +output to the browser. In general, you'll invoke it as follows. - $fq->AddExtraColumns(score => $sc); + $self->PrintLine("...my message text...
"); + +The break tag is optional. When the Find method gets control, a paragraph will +have been started so that everything is XHTML-compliant. The L method must return C if the search parameters are invalid. If this is the case, then a message describing the problem should be passed to the framework @@ -251,7 +246,7 @@ =head3 new -C<< my $shelp = SearchHelper->new($query); >> + my $shelp = SearchHelper->new($cgi); Construct a new SearchHelper object. @@ -268,16 +263,37 @@ sub new { # Get the parameters. my ($class, $cgi) = @_; - # Check for a session ID. + # Check for a session ID. First we look in the CGI parameters. my $session_id = $cgi->param("SessionID"); my $type = "old"; if (! $session_id) { - # Here we're starting a new session. We create the session ID and - # store it in the query object. - $session_id = NewSessionID(); + # We need a session ID. Try to get it from the cookies. + my %cookies = fetch CGI::Cookie; + my $session_cookie = $cookies{$class}; + if (! $session_cookie) { + Trace("No session ID found.") if T(3); + # Here we're starting a new session. We create the session ID and + # store it in a cookie. + $session_id = FIGRules::NewSessionID(); + Trace("New session ID is $session_id.") if T(3); + $session_cookie = new CGI::Cookie(-name => $class, + -value => $session_id); + $session_cookie->bake(); + } else { + # Here we're recovering an old session. The session ID is + # used to find any old search options lying around, but we're + # still considered a new session. + $session_id = $session_cookie->value(); + Trace("Session $session_id recovered from cookie.") if T(3); + } + # Denote this is a new session. $type = "new"; + # Put the session ID in the parameters. $cgi->param(-name => 'SessionID', -value => $session_id); + } else { + Trace("Session ID is $session_id.") if T(3); } + Trace("Computing subclass.") if T(3); # Compute the subclass name. my $subClass; if ($class =~ /SH(.+)$/) { @@ -288,11 +304,13 @@ # process search results. $subClass = 'SearchHelper'; } + Trace("Subclass name is $subClass.") if T(3); # Insure everybody knows we're in Sprout mode. $cgi->param(-name => 'SPROUT', -value => 1); # Generate the form name. my $formName = "$class$formCount"; $formCount++; + Trace("Creating helper.") if T(3); # Create the shelp object. It contains the query object (with the session ID) # as well as an indicator as to whether or not the session is new, plus the # class name and a placeholder for the Sprout object. @@ -306,7 +324,7 @@ scriptQueue => [], genomeList => undef, genomeParms => [], - filtered => 0, + notices => [], }; # Bless and return it. bless $retVal, $class; @@ -315,7 +333,7 @@ =head3 Q -C<< my $query = $shelp->Q(); >> + my $query = $shelp->Q(); Return the CGI query object. @@ -329,10 +347,9 @@ } - =head3 DB -C<< my $sprout = $shelp->DB(); >> + my $sprout = $shelp->DB(); Return the Sprout database object. @@ -353,7 +370,7 @@ =head3 IsNew -C<< my $flag = $shelp->IsNew(); >> + my $flag = $shelp->IsNew(); Return TRUE if this is a new session, FALSE if this is an old session. An old session already has search results ready to process. @@ -369,7 +386,7 @@ =head3 ID -C<< my $sessionID = $shelp->ID(); >> + my $sessionID = $shelp->ID(); Return the current session ID. @@ -384,7 +401,7 @@ =head3 FormName -C<< my $name = $shelp->FormName(); >> + my $name = $shelp->FormName(); Return the name of the form this helper object will generate. @@ -399,7 +416,7 @@ =head3 QueueFormScript -C<< $shelp->QueueFormScript($statement); >> + $shelp->QueueFormScript($statement); Add the specified statement to the queue of JavaScript statements that are to be executed when the form has been fully defined. This is necessary because until @@ -434,7 +451,7 @@ =head3 FormStart -C<< my $html = $shelp->FormStart($title); >> + my $html = $shelp->FormStart($title); Return the initial section of a form designed to perform another search of the same type. The form header is included along with hidden fields to persist the @@ -464,22 +481,15 @@ # Start the form. Note we use the override option on the Class value, in # case the Advanced button was used. my $retVal = "
\n" . - $cgi->start_form(-method => 'POST', - -action => $cgi->url(-relative => 1), - -name => $self->FormName()) . - $cgi->hidden(-name => 'Class', - -value => $self->{class}, - -override => 1) . - $cgi->hidden(-name => 'SPROUT', + CGI::start_form(-method => 'POST', + -action => "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/search", + -name => $self->FormName(), + -id => $self->FormName()) . + CGI::hidden(-name => 'Class', + -value => $self->{class}) . + CGI::hidden(-name => 'SPROUT', -value => 1) . - $cgi->h3($title); - # If tracing is on, add it to the form. - if ($cgi->param('Trace')) { - $retVal .= $cgi->hidden(-name => 'Trace', - -value => $cgi->param('Trace')) . - $cgi->hidden(-name => 'TF', - -value => ($cgi->param('TF') ? 1 : 0)); - } + CGI::h3("$title" . Hint($self->{class}, "Click here for more information.")); # Put in an anchor tag in case there's a table of contents. my $anchorName = $self->FormName(); $retVal .= "\n"; @@ -489,7 +499,7 @@ =head3 FormEnd -C<< my $htmlText = $shelp->FormEnd(); >> + my $htmlText = $shelp->FormEnd(); Return the HTML text for closing a search form. This closes both the C
and C
tags. @@ -521,7 +531,7 @@ =head3 SetMessage -C<< $shelp->SetMessage($msg); >> + $shelp->SetMessage($msg); Store the specified text as the result message. The result message is displayed if an invalid parameter value is specified. @@ -545,7 +555,7 @@ =head3 Message -C<< my $text = $shelp->Message(); >> + my $text = $shelp->Message(); Return the result message. The result message is displayed if an invalid parameter value is specified. @@ -561,23 +571,42 @@ =head3 OpenSession -C<< $shelp->OpenSession(); >> + $shelp->OpenSession($rhelp); + +Set up the session cache file and write out the column headers. +This method should not be called until all the columns have +been configured, including the extra columns. + +=over 4 + +=item rhelp -Set up to open the session cache file for writing. Note we don't actually -open the file until after we know the column headers. +Result helper for formatting the output. This has the column +headers stored in it. + +=back =cut sub OpenSession { # Get the parameters. - my ($self) = @_; - # Denote we have not yet written out the column headers. - $self->{cols} = undef; + my ($self, $rhelp) = @_; + # Insure the result helper is valid. + if (! defined($rhelp)) { + Confess("No result type specified for $self->{class}."); + } elsif(! $rhelp->isa('ResultHelper')) { + Confess("Invalid result type specified for $self->{class}."); + } else { + # Get the column headers and write them out. + my $colHdrs = $rhelp->GetColumnHeaders(); + Trace(scalar(@{$colHdrs}) . " column headers written to output.") if T(3); + $self->WriteColumnHeaders(@{$colHdrs}); + } } =head3 GetCacheFileName -C<< my $fileName = $shelp->GetCacheFileName(); >> + my $fileName = $shelp->GetCacheFileName(); Return the name to be used for this session's cache file. @@ -592,7 +621,7 @@ =head3 GetTempFileName -C<< my $fileName = $shelp->GetTempFileName($type); >> + my $fileName = $shelp->GetTempFileName($type); Return the name to be used for a temporary file of the specified type. The name is computed from the session name with the type as a suffix. @@ -616,126 +645,109 @@ my ($self, $type) = @_; # Compute the file name. Note it gets stuffed in the FIG temporary # directory. - my $retVal = "$FIG_Config::temp/tmp_" . $self->ID() . ".$type"; + my $retVal = FIGRules::GetTempFileName(sessionID => $self->ID(), extension => $type); # Return the result. return $retVal; } -=head3 PutFeature +=head3 WriteColumnHeaders -C<< $shelp->PutFeature($fdata); >> + $shelp->WriteColumnHeaders(@colNames); -Store a feature in the result cache. This is the workhorse method for most -searches, since the primary data item in the database is features. +Write out the column headers for the current search session. The column headers +are sent to the cache file, and then the cache is re-opened as a sort pipe and +the handle saved. + +=over 4 -For each feature, there are certain columns that are standard: the feature name, the -GBrowse and protein page links, the functional assignment, and so forth. If additional -columns are required by a particular search subclass, they should be stored in -the feature query object using the B method. For example, the following -code adds columns for essentiality and virulence. +=item colNames - $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor); - $shelp->PutFeature($fd); +A list of column names in the desired presentation order. For extra columns, +the column name is the hash supplied as the column definition. -For correct results, all values should be specified for all extra columns in all calls to -B. (In particular, the column header names are computed on the first -call.) If a column is to be blank for the current feature, its value can be given -as C. +=back - if (! $essentialFlag) { - $essentialFlag = undef; - } - $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor); - $shelp->PutFeature($fd); +=cut + +sub WriteColumnHeaders { + # Get the parameters. + my ($self, @colNames) = @_; + # Get the cache file name and open it for output. + my $fileName = $self->GetCacheFileName(); + my $handle1 = Open(undef, ">$fileName"); + # Freeze the column headers. + my @colHdrs = map { freeze($_) } @colNames; + # Write the column headers and close the file. + Tracer::PutLine($handle1, \@colHdrs); + close $handle1; + # Now open the sort pipe and save the file handle. Note how we append the + # sorted data to the column header row already in place. The output will + # contain a sort key followed by the real columns. The sort key is + # hacked off before going to the output file. + $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName"); +} + +=head3 SetNotice + + $shelp->SetNotice($message); + +This method creates a notice that will be displayed on the search results +page. After the search is complete, notices are placed in a small temporary +file that is checked by the results display engine. =over 4 -=item fdata +=item message -B object containing the current feature data. +Message to write to the notice file. =back =cut -sub PutFeature { +sub SetNotice { # Get the parameters. - my ($self, $fd) = @_; - # Get the CGI query object. - my $cgi = $self->Q(); - # Get the feature data. - my $record = $fd->Feature(); - my $extraCols = $fd->ExtraCols(); - # Check for a first-call situation. - if (! defined $self->{cols}) { - Trace("Setting up the columns.") if T(3); - # Here we need to set up the column information. Start with the extras, - # sorted by column name. - my @colNames = (); - for my $col (sort keys %{$extraCols}) { - push @colNames, "X=$col"; - } - # Add the default columns. - push @colNames, $self->DefaultFeatureColumns(); - # Add any additional columns requested by the feature filter. - push @colNames, FeatureQuery::AdditionalColumns($self); - # Save the full list. - $self->{cols} = \@colNames; - # Write out the column headers. This also prepares the cache file to receive - # output. - $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}}); - } - # Get the feature ID. - my $fid = $fd->FID(); - # Loop through the column headers, producing the desired data. - my @output = (); - for my $colName (@{$self->{cols}}) { - push @output, $self->FeatureColumnValue($colName, $record, $extraCols); - } - # Compute the sort key. The sort key usually floats NMPDR organism features to the - # top of the return list. - my $key = $self->SortKey($fd); - # Write the feature data. - $self->WriteColumnData($key, @output); + my ($self, $message) = @_; + # Save the message. + push @{$self->{notices}}, $message; } -=head3 WriteColumnHeaders -C<< $shelp->WriteColumnHeaders(@colNames); >> +=head3 ReadColumnHeaders -Write out the column headers for the current search session. The column headers -are sent to the cache file, and then the cache is re-opened as a sort pipe and -the handle saved. + my @colHdrs = $shelp->ReadColumnHeaders($fh); + +Read the column headers from the specified file handle. The column headers are +frozen strings intermixed with frozen hash references. The strings represent +column names defined in the result helper. The hash references represent the +definitions of the extra columns. =over 4 -=item colNames +=item fh + +File handle from which the column headers are to be read. + +=item RETURN -A list of column names in the desired presentation order. +Returns a list of the column headers pulled from the specified file's first line. =back =cut -sub WriteColumnHeaders { +sub ReadColumnHeaders { # Get the parameters. - my ($self, @colNames) = @_; - # Get the cache file name and open it for output. - my $fileName = $self->GetCacheFileName(); - my $handle1 = Open(undef, ">$fileName"); - # Write the column headers and close the file. - Tracer::PutLine($handle1, \@colNames); - close $handle1; - # Now open the sort pipe and save the file handle. Note how we append the - # sorted data to the column header row already in place. The output will - # contain a sort key followed by the real columns. The sort key is - # hacked off before going to the output file. - $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName"); + my ($self, $fh) = @_; + # Read and thaw the columns. + my @retVal = map { thaw($_) } Tracer::GetLine($fh); + # Return them to the caller. + return @retVal; } =head3 WriteColumnData -C<< $shelp->WriteColumnData($key, @colValues); >> + $shelp->WriteColumnData($key, @colValues); Write a row of column values to the current search session. It is assumed that the session file is already open for output. @@ -759,11 +771,12 @@ my ($self, $key, @colValues) = @_; # Write them to the cache file. Tracer::PutLine($self->{fileHandle}, [$key, @colValues]); + Trace("Column data is " . join("; ", $key, @colValues) . ".") if T(4); } =head3 CloseSession -C<< $shelp->CloseSession(); >> + $shelp->CloseSession(); Close the session file. @@ -777,35 +790,25 @@ # We found one, so close it. Trace("Closing session file.") if T(2); close $self->{fileHandle}; + # Tell the user. + my $cgi = $self->Q(); + $self->PrintLine("Output formatting complete.
"); + } + # Check for notices. + my @notices = @{$self->{notices}}; + if (scalar @notices) { + # We have some, so put then in a notice file. + my $noticeFile = $self->GetTempFileName('notices'); + my $nh = Open(undef, ">$noticeFile"); + print $nh join("\n", @notices, ""); + close $nh; + $self->PrintLine(scalar(@notices) . " notices saved.
"); } -} - -=head3 NewSessionID - -C<< my $id = SearchHelpers::NewSessionID(); >> - -Generate a new session ID for the current user. - -=cut - -sub NewSessionID { - # Declare the return variable. - my $retVal; - # Get a digest encoder. - my $md5 = Digest::MD5->new(); - # Add the PID, the IP, and the time stamp. Note that the time stamp is - # actually two numbers, and we get them both because we're in list - # context. - $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday()); - # Hash up all this identifying data. - $retVal = $md5->hexdigest(); - # Return the result. - return $retVal; } =head3 OrganismData -C<< my ($orgName, $group) = $shelp->Organism($genomeID); >> + my ($orgName, $group) = $shelp->Organism($genomeID); Return the name and status of the organism corresponding to the specified genome ID. For performance reasons, this information is cached in a special hash table, so we @@ -819,9 +822,9 @@ =item RETURN -Returns a list of two items. The first item in the list is the organism name, +Returns a list of three items. The first item in the list is the organism name, and the second is the name of the NMPDR group, or an empty string if the -organism is not in an NMPDR group. +organism is not in an NMPDR group. The third item is the organism's domain. =back @@ -831,29 +834,33 @@ # Get the parameters. my ($self, $genomeID) = @_; # Declare the return variables. - my ($orgName, $group); + my ($orgName, $group, $domain); # Check the cache. my $cache = $self->{orgs}; if (exists $cache->{$genomeID}) { - ($orgName, $group) = @{$cache->{$genomeID}}; + ($orgName, $group, $domain) = @{$cache->{$genomeID}}; + Trace("Cached organism $genomeID has group \"$group\".") if T(4); } else { # Here we have to use the database. my $sprout = $self->DB(); - my ($genus, $species, $strain, $group) = $sprout->GetEntityValues('Genome', $genomeID, - ['Genome(genus)', 'Genome(species)', - 'Genome(unique-characterization)', - 'Genome(primary-group)']); + my ($genus, $species, $strain, $newGroup, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID, + ['Genome(genus)', 'Genome(species)', + 'Genome(unique-characterization)', + 'Genome(primary-group)', + 'Genome(taxonomy)']); # Format and cache the name and display group. - ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species, - $strain); + Trace("Caching organism $genomeID with group \"$newGroup\".") if T(4); + ($orgName, $group, $domain) = $self->SaveOrganismData($newGroup, $genomeID, $genus, $species, + $strain, $taxonomy); + Trace("Returning group $group.") if T(4); } # Return the result. - return ($orgName, $group); + return ($orgName, $group, $domain); } =head3 Organism -C<< my $orgName = $shelp->Organism($genomeID); >> + my $orgName = $shelp->Organism($genomeID); Return the name of the relevant organism. The name is computed from the genus, species, and unique characterization. A cache is used to improve performance. @@ -876,95 +883,24 @@ # Get the parameters. my ($self, $genomeID) = @_; # Get the organism data. - my ($retVal, $group) = $self->OrganismData($genomeID); - # Return the result. - return $retVal; -} - -=head3 FeatureGroup - -C<< my $groupName = $shelp->FeatureGroup($fid); >> - -Return the group name for the specified feature. - -=over 4 - -=item fid - -ID of the relevant feature. - -=item RETURN - -Returns the name of the NMPDR group to which the feature belongs, or an empty -string if it is not part of an NMPDR group. - -=back - -=cut - -sub FeatureGroup { - # Get the parameters. - my ($self, $fid) = @_; - # Parse the feature ID to get the genome ID. - my ($genomeID) = FIGRules::ParseFeatureID($fid); - # Get the organism data. - my (undef, $retVal) = $self->OrganismData($genomeID); - # Return the result. - return $retVal; -} - -=head3 FeatureName - -C<< my $fidName = $shelp->FeatureName($fid); >> - -Return the display name of the specified feature. - -=over 4 - -=item fid - -ID of the feature whose name is desired. - -=item RETURN - -A displayable feature name, consisting of the organism name plus some feature -type and location information. - -=back - -=cut - -sub FeatureName { - # Get the parameters. - my ($self, $fid) = @_; - # Declare the return variable - my $retVal; - # Parse the feature ID. - my ($genomeID, $type, $num) = FIGRules::ParseFeatureID($fid); - if (! defined $genomeID) { - # Here the feature ID has an invalid format. - $retVal = "External: $fid"; - } else { - # Here we can get its genome data. - $retVal = $self->Organism($genomeID); - # Append the FIG ID. - $retVal .= " [$fid]"; - } + my ($retVal) = $self->OrganismData($genomeID); # Return the result. return $retVal; } =head3 ComputeFASTA -C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >> + my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth, $comments); -Parse a sequence input and convert it into a FASTA string of the desired type. +Parse a sequence input and convert it into a FASTA string of the desired type with +the desired flanking width. =over 4 =item desiredType -C to return a DNA sequence, C to return a protein sequence. +C to return a DNA sequence, C to return a protein sequence, C +to return a DNA search pattern, C to return a protein search pattern. =item sequence @@ -974,6 +910,17 @@ if the input does not begin with a greater-than sign (FASTA label line), a default label line will be provided. +=item flankingWidth + +If the DNA FASTA of a feature is desired, the number of base pairs to either side of the +feature that should be included. Currently we can't do this for Proteins because the +protein translation of a feature doesn't always match the DNA and is taken directly +from the database. + +=item comments + +Comment string to be added to the FASTA header. + =item RETURN Returns a string in FASTA format representing the content of the desired sequence with @@ -986,7 +933,7 @@ sub ComputeFASTA { # Get the parameters. - my ($self, $desiredType, $sequence) = @_; + my ($self, $desiredType, $sequence, $flankingWidth, $comment) = @_; # Declare the return variable. If an error occurs, it will remain undefined. my $retVal; # This variable will be cleared if an error is detected. @@ -994,10 +941,9 @@ # Create variables to hold the FASTA label and data. my ($fastaLabel, $fastaData); Trace("FASTA desired type is $desiredType.") if T(4); - # Check for a feature specification. + # Check for a feature specification. The smoking gun for that is a vertical bar. if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) { - # Here we have a feature ID in $1. We'll need the Sprout object to process - # it. + # Here we have a feature ID in $1. We'll need a Sprout object to process it. my $fid = $1; Trace("Feature ID for fasta is $fid.") if T(3); my $sprout = $self->DB(); @@ -1009,18 +955,59 @@ $self->SetMessage("No gene found with the ID \"$fid\"."); $okFlag = 0; } else { - # Set the FASTA label. - my $fastaLabel = $fid; + # Set the FASTA label. The ID is the first favored alias. + my $favored = $self->Q()->param('FavoredAlias') || 'fig'; + my $favorLen = length $favored; + ($fastaLabel) = grep { substr($_, 0, $favorLen) eq $favored } $sprout->FeatureAliases($fid); + if (! $fastaLabel) { + # In an emergency, fall back to the original ID. + $fastaLabel = $fid; + } + # Add any specified comments. + if ($comment) { + $fastaLabel .= " $comment"; + } # Now proceed according to the sequence type. - if ($desiredType eq 'prot') { + if ($desiredType =~ /prot/) { # We want protein, so get the translation. $fastaData = $sprout->FeatureTranslation($figID); Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3); - } else { - # We want DNA, so get the DNA sequence. This is a two-step process. + } elsif ($desiredType =~ /dna/) { + # We want DNA, so get the DNA sequence. This is a two-step process. First, we get the + # locations. my @locList = $sprout->FeatureLocation($figID); - $fastaData = $sprout->DNASeq(\@locList); - Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3); + if ($flankingWidth > 0) { + # Here we need to add flanking data. Convert the locations to a list + # of location objects. + my @locObjects = map { BasicLocation->new($_) } @locList; + # Initialize the return variable. We will put the DNA in here segment by segment. + $fastaData = ""; + # Now we widen each location by the flanking width and stash the results. This + # requires getting the contig length for each contig so we don't fall off the end. + for my $locObject (@locObjects) { + Trace("Current location is " . $locObject->String . ".") if T(4); + # Remember the current start and length. + my ($start, $len) = ($locObject->Left, $locObject->Length); + # Get the contig length. + my $contigLen = $sprout->ContigLength($locObject->Contig); + # Widen the location and get its DNA. + $locObject->Widen($flankingWidth, $contigLen); + my $fastaSegment = $sprout->DNASeq([$locObject->String()]); + # Now we need to do some case changing. The main DNA is upper case and + # the flanking DNA is lower case. + my $leftFlank = $start - $locObject->Left; + my $rightFlank = $leftFlank + $len; + Trace("Wide location is " . $locObject->String . ". Flanks are $leftFlank and $rightFlank. Contig len is $contigLen.") if T(4); + my $fancyFastaSegment = lc(substr($fastaSegment, 0, $leftFlank)) . + uc(substr($fastaSegment, $leftFlank, $rightFlank - $leftFlank)) . + lc(substr($fastaSegment, $rightFlank)); + $fastaData .= $fancyFastaSegment; + } + } else { + # Here we have just the raw sequence. + $fastaData = $sprout->DNASeq(\@locList); + } + Trace((length $fastaData) . " characters returned for DNA of $fastaLabel.") if T(3); } } } else { @@ -1035,28 +1022,36 @@ Trace("No label found in match to sequence:\n$sequence") if T(4); # Here we have no label, so we create one and use the entire sequence # as data. - $fastaLabel = "User-specified $desiredType sequence"; + $fastaLabel = "$desiredType sequence specified by user"; $fastaData = $sequence; } - # The next step is to clean the junk out of the sequence. - $fastaData =~ s/\n//g; - $fastaData =~ s/\s+//g; + # If we are not doing a pattern search, we need to clean the junk out of the sequence. + if ($desiredType !~ /pattern/i) { + $fastaData =~ s/\n//g; + $fastaData =~ s/\s+//g; + $fastaData =~ s/\d+//g; + } # Finally, verify that it's DNA if we're doing DNA stuff. - if ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) { - $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?"); + if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) { + $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?"); $okFlag = 0; } } Trace("FASTA data sequence: $fastaData") if T(4); # Only proceed if no error was detected. if ($okFlag) { - # We need to format the sequence into 60-byte chunks. We use the infamous - # grep-split trick. The split, because of the presence of the parentheses, - # includes the matched delimiters in the output list. The grep strips out - # the empty list items that appear between the so-called delimiters, since - # the delimiters are what we want. - my @chunks = grep { $_ } split /(.{1,60})/, $fastaData; - $retVal = join("\n", ">$fastaLabel", @chunks, ""); + if ($desiredType =~ /pattern/i) { + # For a scan, there is no label and no breakup. + $retVal = $fastaData; + } else { + # We need to format the sequence into 60-byte chunks. We use the infamous + # grep-split trick. The split, because of the presence of the parentheses, + # includes the matched delimiters in the output list. The grep strips out + # the empty list items that appear between the so-called delimiters, since + # the delimiters are what we want. + my @chunks = grep { $_ } split /(.{1,60})/, $fastaData; + $retVal = join("\n", ">$fastaLabel", @chunks, ""); + } } # Return the result. return $retVal; @@ -1064,7 +1059,7 @@ =head3 SubsystemTree -C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >> + my $tree = SearchHelper::SubsystemTree($sprout, %options); This method creates a subsystem selection tree suitable for passing to L. Each leaf node in the tree will have a link to the @@ -1114,6 +1109,17 @@ # Read in the subsystems. my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [], ['Subsystem(classification)', 'Subsystem(id)']); + # Put any unclassified subsystems at the end. They will always be at the beginning, so if one + # is at the end, ALL subsystems are unclassified and we don't bother. + if ($#subs >= 0 && $subs[$#subs]->[0] ne '') { + while ($subs[0]->[0] eq '') { + my $classLess = shift @subs; + push @subs, $classLess; + } + } + # Get the seedviewer URL. + my $svURL = $FIG_Config::linkinSV || "$FIG_Config::cgi_url/seedviewer.cgi"; + Trace("Seed Viewer URL is $svURL.") if T(3); # Declare the return variable. my @retVal = (); # Each element in @subs represents a leaf node, so as we loop through it we will be @@ -1188,7 +1194,7 @@ if ($optionThing->{links}) { # Compute the link value. my $linkable = uri_escape($id); - $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1"; + $nodeContent->{link} = "$svURL?page=Subsystems;subsystem=$linkable"; } if ($optionThing->{radio}) { # Compute the radio value. @@ -1206,7 +1212,7 @@ =head3 NmpdrGenomeMenu -C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >> + my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); 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 @@ -1235,10 +1241,7 @@ =item crossMenu (optional) -If specified, is presumed to be the name of another genome menu whose contents -are to be mutually exclusive with the contents of this menu. As a result, instead -of the standard onChange event, the onChange event will deselect any entries in -the other menu. +This is currently not supported. =item RETURN @@ -1258,185 +1261,23 @@ if (! defined $rows) { $rows = ($multiple ? 10 : 1); } - # Create the multiple tag. - my $multipleTag = ($multiple ? " multiple" : ""); - # Get the form name. - my $formName = $self->FormName(); - # Check to see if we already have a genome list in memory. - my $genomes = $self->{genomeList}; - my $groupHash; - if (defined $genomes) { - # We have a list ready to use. - $groupHash = $genomes; - } else { - # 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 = $sprout->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 %gHash = (); - for my $genome (@genomeList) { - # Get the genome data. - my ($group, $genomeID, $genus, $species, $strain) = @{$genome}; - # Compute and cache its name and display group. - my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species, - $strain); - # Push the genome into the group's list. Note that we use the real group - # name here, not the display group name. - push @{$gHash{$group}}, [$genomeID, $name]; - } - # Save the genome list for future use. - $self->{genomeList} = \%gHash; - $groupHash = \%gHash; - } - # 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. Note that we need to deal - # with the possibility of undefined values in the incoming list. - my %selectedHash = (); - if (defined $selected) { - %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected}; - } - # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage - # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes - # and use that to make the selections. - my $nmpdrCount = 0; - # Create the type counters. - my $groupCount = 1; - # Compute the ID for the status display. - my $divID = "${formName}_${menuName}_status"; - # Compute the JavaScript call for updating the status. - my $showSelect = "showSelected($menuName, '$divID', 1000);"; - # If multiple selection is supported, create an onChange event. - my $onChange = ""; - if ($cross) { - # Here we have a paired menu. Selecting something in our menu unselects it in the - # other and redisplays the status of both. - $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\""; - } elsif ($multiple) { - # This is an unpaired menu, so all we do is redisplay our status. - $onChange = " onChange=\"$showSelect\""; - } - # Create the SELECT tag and stuff it into the output array. - my @lines = (""; - # Check for multiple selection. - if ($multiple) { - # Multi-select is on, so we need to add some selection helpers. First is - # the search box. This allows the user to type text and have all genomes containing - # the text selected automatically. - my $searchThingName = "${menuName}_SearchThing"; - push @lines, "
" . - " " . - ""; - # Next are the buttons to set and clear selections. - push @lines, "
"; - push @lines, ""; - push @lines, ""; - push @lines, ""; - push @lines, ""; - # Add the status display, too. - push @lines, "
"; - # Queue to update the status display when the form loads. We need to modify the show statement - # slightly because the queued statements are executed outside the form. This may seem like a lot of - # trouble, but we want all of the show statement calls to be generated from a single line of code, - # in case we decide to twiddle the parameters. - $showSelect =~ s/showSelected\(/showSelected\(thisForm\./; - $self->QueueFormScript($showSelect); - # Finally, add this parameter to the list of genome parameters. This enables us to - # easily find all the parameters used to select one or more genomes. - push @{$self->{genomeParms}}, $menuName; - } - # Assemble all the lines into a string. - my $retVal = join("\n", @lines, ""); - # Return the result. - return $retVal; -} - -=head3 PropertyMenu - -C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >> - -Generate a property name dropdown menu. - -=over 4 - -=item menuName - -Name to give to the menu. - -=item selected - -Value of the property name to pre-select. - -=item force (optional) - -If TRUE, then the user will be forced to choose a property name. If FALSE, -then an additional menu choice will be provided to select nothing. - -=item RETURN - -Returns a dropdown menu box that allows the user to select a property name. An additional -selection entry will be provided for selecting no property name - -=back - -=cut - -sub PropertyMenu { - # Get the parameters. - my ($self, $menuName, $selected, $force) = @_; - # Get the CGI and Sprout objects. - my $sprout = $self->DB(); - my $cgi = $self->Q(); - # Create the property name list. - my @propNames = (); - if (! $force) { - push @propNames, ""; - } - # Get all the property names, putting them after the null choice if one exists. - push @propNames, $sprout->GetChoices('Property', 'property-name'); - # Create a menu from them. - my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames, - -default => $selected); + # Get a comma-delimited list of the preselected genomes. + my $preselected = ""; + if ($selected) { + $preselected = join(", ", @$selected); + } + # Ask Sprout for a genome menu. + my $retVal = $sprout->GenomeMenu(name => $menuName, + multiSelect => $multiple, + selected => $preselected, + size => $rows); # Return the result. return $retVal; } =head3 MakeTable -C<< my $htmlText = $shelp->MakeTable(\@rows); >> + my $htmlText = $shelp->MakeTable(\@rows); Create a table from a group of table rows. The table rows must be fully pre-formatted: in other words, each must have the TR and TD tags included. @@ -1452,8 +1293,8 @@ =item rows Reference to a list of table rows. Each table row must be in HTML form with all -the TR and TD tags set up. The first TD or TH tag in each row will be modified to -set the width. Everything else will be left as is. +the TR and TD tags set up. The first TD or TH tag in the first non-colspanned row +will be modified to set the width. Everything else will be left as is. =item RETURN @@ -1468,14 +1309,29 @@ my ($self, $rows) = @_; # Get the CGI object. my $cgi = $self->Q(); - # Fix the widths on the first column. Note that we eschew the use of the "g" + # The first column of the first row must have its width fixed. + # This flag will be set to FALSE when that happens. + my $needWidth = 1; # modifier becase we only want to change the first tag. Also, if a width # is already specified on the first column bad things will happen. for my $row (@{$rows}) { - $row =~ s/(]+)>/i) { + # Here we have a first cell and its tag parameters are in $2. + my $elements = $2; + if ($elements !~ /colspan/i) { + Trace("No colspan tag found in element \'$elements\'.") if T(3); + # Here there's no colspan, so we plug in the width. We + # eschew the "g" modifier on the substitution because we + # only want to update the first cell. + $row =~ s/(<(td|th))/$1 width="150"/i; + # Denote we don't need this any more. + $needWidth = 0; + } + } } # Create the table. - my $retVal = $cgi->table({border => 2, cellspacing => 2, + my $retVal = CGI::table({border => 2, cellspacing => 2, width => 700, class => 'search'}, @{$rows}); # Return the result. @@ -1484,7 +1340,7 @@ =head3 SubmitRow -C<< my $htmlText = $shelp->SubmitRow($caption); >> + my $htmlText = $shelp->SubmitRow($caption); Returns the HTML text for the row containing the page size control and the submit button. All searches should have this row somewhere @@ -1513,121 +1369,32 @@ my $realCaption = (defined $caption ? $caption : 'Go'); # Get the current page size. my $pageSize = $cgi->param('PageSize'); - # Get the incoming external-link flag. - my $aliases = ($cgi->param('ShowAliases') ? 1 : 0); - # Create the row. - my $retVal = $cgi->Tr($cgi->td("Results/Page"), - $cgi->td($cgi->popup_menu(-name => 'PageSize', - -values => [10, 25, 50, 100, 1000], - -default => $pageSize) . " " . - $cgi->checkbox(-name => 'ShowURL', - -value => 1, - -label => 'Show URL')), - $cgi->td($cgi->submit(-class => 'goButton', + # Get the form name. + my $formName = $self->FormName(); + # Get the current feature ID type. + my $aliasType = $self->GetPreferredAliasType(); + # Create the rows. + my $retVal = CGI::Tr(CGI::td("Identifier Type "), + CGI::td({ colspan => 2 }, + CGI::popup_menu(-name => 'AliasType', + -values => ['FIG', AliasAnalysis::AliasTypes() ], + -default => $aliasType) . + Hint("Identifier Type", "Specify how you want gene names to be displayed."))) . + "\n" . + CGI::Tr(CGI::td("Results/Page"), + CGI::td(CGI::popup_menu(-name => 'PageSize', + -values => [50, 10, 25, 100, 1000], + -default => $pageSize)), + CGI::td(CGI::submit(-class => 'goButton', -name => 'Search', -value => $realCaption))); # Return the result. return $retVal; } -=head3 FeatureFilterRows - -C<< my $htmlText = $shelp->FeatureFilterRows(); >> - -This method creates table rows that can be used to filter features. The form -values can be used to select features by genome using the B -object. - -=cut - -sub FeatureFilterRows { - # Get the parameters. - my ($self) = @_; - # Return the result. - return FeatureQuery::FilterRows($self); -} - -=head3 GBrowseFeatureURL - -C<< my $url = SearchHelper::GBrowseFeatureURL($sprout, $feat); >> - -Compute the URL required to pull up a Gbrowse page for the the specified feature. -In order to do this, we need to pull out the ID of the feature's Genome, its -contig ID, and some rough starting and stopping offsets. - -=over 4 - -=item sprout - -Sprout object for accessing the database. - -=item feat - -ID of the feature whose Gbrowse URL is desired. - -=item RETURN - -Returns a GET-style URL for the Gbrowse CGI, with parameters specifying the genome -ID, contig ID, starting offset, and stopping offset. - -=back - -=cut - -sub GBrowseFeatureURL { - # Get the parameters. - my ($sprout, $feat) = @_; - # Declare the return variable. - my $retVal; - # Compute the genome ID. - my ($genomeID) = FIGRules::ParseFeatureID($feat); - # Only proceed if the feature ID produces a valid genome. - if ($genomeID) { - # Get the feature location string. - my $loc = $sprout->FeatureLocation($feat); - # Compute the contig, start, and stop points. - my($contig, $start, $stop) = BasicLocation::Parse($loc); - Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3); - # Now we need to do some goofiness to insure that the location is not too - # big and that we get some surrounding stuff. - my $mid = int(($start + $stop) / 2); - my $chunk_len = 20000; - my $max_feature = 40000; - my $feat_len = abs($stop - $start); - if ($feat_len > $chunk_len) { - if ($feat_len > $max_feature) { - $chunk_len = $max_feature; - } else { - $chunk_len = $feat_len + 100; - } - } - my($show_start, $show_stop); - if ($chunk_len == $max_feature) { - $show_start = $start - 300; - } else { - $show_start = $mid - int($chunk_len / 2); - } - if ($show_start < 1) { - $show_start = 1; - } - $show_stop = $show_start + $chunk_len - 1; - my $clen = $sprout->ContigLength($contig); - if ($show_stop > $clen) { - $show_stop = $clen; - } - my $seg_id = $contig; - $seg_id =~ s/:/--/g; - Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3); - # Assemble all the pieces. - $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id;start=$show_start;stop=$show_stop"; - } - # Return the result. - return $retVal; -} - =head3 GetGenomes -C<< my @genomeList = $shelp->GetGenomes($parmName); >> + my @genomeList = $shelp->GetGenomes($parmName); Return the list of genomes specified by the specified CGI query parameter. If the request method is POST, then the list of genome IDs is returned @@ -1669,50 +1436,9 @@ return @retVal; } -=head3 GetHelpText - -C<< my $htmlText = $shelp->GetHelpText(); >> - -Get the help text for this search. The help text is stored in files on the template -server. The help text for a specific search is taken from a file named -CIC<.inc> in the template directory C<$FIG_Config::template_url>. -There are also three standard help files: C describes the -feature filtering performed by the B object, C -describes how to use a multiple-selection genome control, and C -describes the standard controls for a search, such as page size, URL display, and -external alias display. - -=cut - -sub GetHelpText { - # Get the parameters. - my ($self) = @_; - # Create a list to hold the pieces of the help. - my @helps = (); - # Get the template directory URL. - my $urlBase = $FIG_Config::template_url; - # Start with the specific help. - my $class = $self->{class}; - push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc"); - # Add the genome control help if needed. - if (scalar @{$self->{genomeParms}}) { - push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc"); - } - # Next the filter help. - if ($self->{filtered}) { - push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc"); - } - # Finally, the standard help. - push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc"); - # Assemble the pieces. - my $retVal = join("\n

 

\n", @helps); - # Return the result. - return $retVal; -} - =head3 ComputeSearchURL -C<< my $url = $shelp->ComputeSearchURL(%overrides); >> + my $url = $shelp->ComputeSearchURL(%overrides); Compute the GET-style URL for the current search. In order for this to work, there must be a copy of the search form on the current page. This will always be the @@ -1745,7 +1471,7 @@ my $cgi = $self->Q(); my $sprout = $self->DB(); # Start with the full URL. - my $retVal = $cgi->url(-full => 1); + my $retVal = "$FIG_Config::cgi_url/SearchSkeleton.cgi"; # Get all the query parameters in a hash. my %parms = $cgi->Vars(); # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null @@ -1767,7 +1493,7 @@ # a singleton list, but that's okay. my @values = split (/\0/, $parms{$parmKey}); # Check for special cases. - if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) { + if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) { # These are bookkeeping parameters we don't need to start a search. @values = (); } elsif ($parmKey =~ /_SearchThing$/) { @@ -1803,61 +1529,32 @@ return $retVal; } -=head3 GetRunTimeValue - -C<< my $htmlText = $shelp->GetRunTimeValue($text); >> - -Compute a run-time column value. - -=over 4 - -=item text - -The run-time column text. It consists of 2 percent signs, a column type, an equal -sign, and the data for the current row. - -=item RETURN - -Returns the fully-formatted HTML text to go into the current column of the current row. - -=back - -=cut - -sub GetRunTimeValue { - # Get the parameters. - my ($self, $text) = @_; - # Declare the return variable. - my $retVal; - # Parse the incoming text. - if ($text =~ /^%%([^=]+)=(.*)$/) { - $retVal = $self->RunTimeColumns($1, $2); - } else { - Confess("Invalid run-time column string \"$text\" encountered in session file."); - } - # Return the result. - return $retVal; -} - =head3 AdvancedClassList -C<< my @classes = SearchHelper::AdvancedClassList(); >> + my @classes = SearchHelper::AdvancedClassList(); Return a list of advanced class names. This list is used to generate the directory of available searches on the search page. -We use the %INC variable to accomplish this. +We do a file search to accomplish this, but to pull it off we need to look at %INC. =cut sub AdvancedClassList { - my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC; - return @retVal; + # Determine the search helper module directory. + my $libDirectory = $INC{'SearchHelper.pm'}; + $libDirectory =~ s/SearchHelper\.pm//; + # Read it, keeping only the helper modules. + my @modules = grep { /^SH\w+\.pm/ } Tracer::OpenDir($libDirectory, 0); + # Convert the file names to search types. + my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } @modules; + # Return the result in alphabetical order. + return sort @retVal; } =head3 SelectionTree -C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >> + my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); Display a selection tree. @@ -1922,7 +1619,7 @@ {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"}, Campylobacterales => [ {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"}, - Campylobacteraceae => + Campylobacteraceae => {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"}, ... ] @@ -1966,12 +1663,12 @@ =item nodeImageClosed URL of the image to display next to the tree nodes when they are collapsed. Clicking -on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>. +on the image will expand a section of the tree. The default is C. =item nodeImageOpen URL of the image to display next to the tree nodes when they are expanded. Clicking -on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>. +on the image will collapse a section of the tree. The default is C. =item style @@ -1980,7 +1677,7 @@ C
  • tags. The default style file contains the following definitions. .tree ul { - margin-left: 0; padding-left: 22px + margin-left: 0; padding-left: 22px } .tree li { list-style-type: none; @@ -2011,8 +1708,8 @@ my ($cgi, $tree, %options) = @_; # Get the options. my $optionThing = Tracer::GetOptions({ name => 'selection', - nodeImageClosed => '../FIG/Html/plus.gif', - nodeImageOpen => '../FIG/Html/minus.gif', + nodeImageClosed => "$FIG_Config::cgi_url/Html/plus.gif", + nodeImageOpen => "$FIG_Config::cgi_url/Html/minus.gif", style => 'tree', target => '_self', selected => undef}, @@ -2031,13 +1728,13 @@ Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes."); } else { # Here we have a real tree. Apply the tree style. - push @retVal, $cgi->start_div({ class => $optionThing->{style} }); + push @retVal, CGI::start_div({ class => $optionThing->{style} }); # Give us a DIV ID. my $divID = GetDivID($optionThing->{name}); # Show the tree. push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block'); # Close the DIV block. - push @retVal, $cgi->end_div(); + push @retVal, CGI::end_div(); } } # Return the result. @@ -2046,9 +1743,9 @@ =head3 ShowBranch -C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >> + my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); -This is a recursive method that displays a branch of the tree. +This is a recursive method that displays a branch of the tree. =over 4 @@ -2095,7 +1792,7 @@ # Declare the return variable. my @retVal = (); # Start the branch. - push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" }); + push @retVal, CGI::start_ul({ id => $id, style => "display:$displayType" }); # Check for the hash and choose the start location accordingly. my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0); # Get the list length. @@ -2141,7 +1838,8 @@ # If we have children, create the child list with a recursive call. if ($hasChildren) { Trace("Processing children of $myLabel.") if T(4); - push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none'); + push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'block'); + Trace("Children of $myLabel finished.") if T(4); } } } @@ -2152,10 +1850,10 @@ # closed images. my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed}); my $image = $images[$hasChildren]; - my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"}); + my $prefixHtml = CGI::img({src => $image, id => "${myID}img"}); if ($hasChildren) { # If there are children, we wrap the image in a toggle hyperlink. - $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" }, + $prefixHtml = CGI::a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" }, $prefixHtml); } # Now the radio button, if any. Note we use "defined" in case the user wants the @@ -2172,32 +1870,32 @@ if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) { $radioParms->{checked} = undef; } - $prefixHtml .= $cgi->input($radioParms); + $prefixHtml .= CGI::input($radioParms); } # Next, we format the label. my $labelHtml = $myLabel; - Trace("Formatting tree node for $myLabel.") if T(4); + Trace("Formatting tree node for \"$myLabel\".") if T(4); # Apply a hyperlink if necessary. if (defined $attrHash->{link}) { - $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} }, + $labelHtml = CGI::a({ href => $attrHash->{link}, target => $options->{target} }, $labelHtml); } # Finally, roll up the child HTML. If there are no children, we'll get a null string # here. my $childHtml = join("\n", @childHtml); # Now we have all the pieces, so we can put them together. - push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml"); + push @retVal, CGI::li("$prefixHtml$labelHtml$childHtml"); } } # Close the tree branch. - push @retVal, $cgi->end_ul(); + push @retVal, CGI::end_ul(); # Return the result. return @retVal; } =head3 GetDivID -C<< my $idString = SearchHelper::GetDivID($name); >> + my $idString = SearchHelper::GetDivID($name); Return a new HTML ID string. @@ -2226,258 +1924,86 @@ return $retVal; } -=head2 Feature Column Methods - -The methods in this section manage feature column data. If you want to provide the -capability to include new types of data in feature columns, then all the changes -are made to this section of the source file. Technically, this should be implemented -using object-oriented methods, but this is simpler for non-programmers to maintain. -To add a new column of feature data, you must first give it a name. For example, -the name for the protein page link column is C. If the column is to appear -in the default list of feature columns, add it to the list returned by -L. Then add code to produce the column title to -L and code to produce its value to L, and -everything else will happen automatically. - -There is one special column name syntax for extra columns (that is, nonstandard -feature columns). If the column name begins with C, then it is presumed to be -an extra column. The column title is the text after the C, and its value is -pulled from the extra column hash. - -=head3 DefaultFeatureColumns - -C<< my @colNames = $shelp->DefaultFeatureColumns(); >> - -Return a list of the default feature column identifiers. These identifiers can -be passed to L and L in order to -produce the column titles and row values. - -=cut - -sub DefaultFeatureColumns { - # Get the parameters. - my ($self) = @_; - # Return the result. - return qw(orgName function gblink protlink); -} - -=head3 FeatureColumnTitle +=head3 PrintLine -C<< my $title = $shelp->FeatureColumnTitle($colName); >> + $shelp->PrintLine($message); -Return the column heading title to be used for the specified feature column. +Print a line of CGI output. This is used during the operation of the B method while +searching, so the user sees progress in real-time. =over 4 -=item name - -Name of the desired feature column. - -=item RETURN +=item message -Returns the title to be used as the column header for the named feature column. +HTML text to display. =back =cut -sub FeatureColumnTitle { +sub PrintLine { # Get the parameters. - my ($self, $colName) = @_; - # Declare the return variable. We default to a blank column name. - my $retVal = " "; - # Process the column name. - if ($colName =~ /^X=(.+)$/) { - # Here we have an extra column. - $retVal = $1; - } elsif ($colName eq 'alias') { - $retVal = "External Aliases"; - } elsif ($colName eq 'fid') { - $retVal = "FIG ID"; - } elsif ($colName eq 'function') { - $retVal = "Functional Assignment"; - } elsif ($colName eq 'gblink') { - $retVal = "GBrowse"; - } elsif ($colName eq 'group') { - $retVal = "NMDPR Group"; - } elsif ($colName =~ /^keyword:(.+)$/) { - $retVal = ucfirst $1; - } elsif ($colName eq 'orgName') { - $retVal = "Organism and Gene ID"; - } elsif ($colName eq 'protlink') { - $retVal = "NMPDR Protein Page"; - } elsif ($colName eq 'subsystem') { - $retVal = "Subsystems"; - } - # Return the result. - return $retVal; + my ($self, $message) = @_; + # Send the message to the output. + print "$message\n"; } +=head3 GetHelper -=head3 FeatureColumnValue - -C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >> + my $shelp = SearchHelper::GetHelper($parm, $type => $className); -Return the value to be displayed in the specified feature column. +Return a helper object with the given class name. If no such class exists, an +error will be thrown. =over 4 -=item colName - -Name of the column to be displayed. - -=item record - -DBObject record for the feature being displayed in the current row. - -=item extraCols +=item parm -Reference to a hash of extra column names to values. If the incoming column name -begins with C, its value will be taken from this hash. - -=item RETURN - -Returns the HTML to be displayed in the named column for the specified feature. - -=back - -=cut - -sub FeatureColumnValue { - # Get the parameters. - my ($self, $colName, $record, $extraCols) = @_; - # Get the sprout and CGI objects. - my $cgi = $self->Q(); - my $sprout = $self->DB(); - # Get the feature ID. - my ($fid) = $record->Value('Feature(id)'); - # Declare the return variable. Denote that we default to a non-breaking space, - # which will translate to an empty table cell (rather than a table cell with no - # interior, which is what you get for a null string). - my $retVal = " "; - # Process according to the column name. - if ($colName =~ /^X=(.+)$/) { - # Here we have an extra column. Only update if the value exists. Note that - # a value of C is treated as a non-existent value, because the - # caller may have put "colName => undef" in the "PutFeature" call in order - # to insure we know the extra column exists. - if (defined $extraCols->{$1}) { - $retVal = $extraCols->{$1}; - } - } elsif ($colName eq 'alias') { - # In this case, the user wants a list of external aliases for the feature. - # These are very expensive, so we compute them when the row is displayed. - $retVal = "%%alias=$fid"; - } elsif ($colName eq 'fid') { - # Here we have the raw feature ID. We hyperlink it to the protein page. - $retVal = HTML::set_prot_links($fid); - } elsif ($colName eq 'function') { - # The functional assignment is just a matter of getting some text. - ($retVal) = $record->Value('Feature(assignment)'); - } elsif ($colName eq 'gblink') { - # Here we want a link to the GBrowse page using the official GBrowse button. - $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef, - fid => $fid); - } elsif ($colName eq 'group') { - # Get the NMPDR group name. - my (undef, $group) = $self->OrganismData($fid); - # Dress it with a URL to the group's main page. - my $nurl = $sprout->GroupPageName($group); - $retVal = $cgi->a({ href => $nurl, title => "$group summary" }, - $group); - } elsif ($colName =~ /^keyword:(.+)$/) { - # Here we want keyword-related values. This is also expensive, so - # we compute them when the row is displayed. - $retVal = "%%$colName=$fid"; - } elsif ($colName eq 'orgName') { - # Here we want the formatted organism name and feature number. - $retVal = $self->FeatureName($fid); - } elsif ($colName eq 'protlink') { - # Here we want a link to the protein page using the official NMPDR button. - $retVal = Formlet('NMPDR', "protein.cgi", undef, - prot => $fid, SPROUT => 1, new_framework => 0, - user => ''); - }elsif ($colName eq 'subsystem') { - # Another run-time column: subsystem list. - $retVal = "%%subsystem=$fid"; - } - # Return the result. - return $retVal; -} - -=head3 RunTimeColumns - -C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >> - -Return the HTML text for a run-time column. Run-time columns are evaluated when the -list is displayed, rather than when it is generated. - -=over 4 +Parameter to pass to the constructor. This is a CGI object for a search helper +and a search helper object for the result helper. =item type -Type of column. +Type of helper: C for a result helper and C for a search helper. -=item text +=item className -Data relevant to this row of the column. +Class name for the helper object, without the preceding C or C. This is +identical to what the script expects for the C or C parameter. =item RETURN -Returns the fully-formatted HTML text to go in the specified column. +Returns a helper object for the specified class. =back =cut -sub RunTimeColumns { +sub GetHelper { # Get the parameters. - my ($self, $type, $text) = @_; + my ($parm, $type, $className) = @_; # Declare the return variable. - my $retVal = ""; - # Get the Sprout and CGI objects. - my $sprout = $self->DB(); - my $cgi = $self->Q(); - Trace("Runtime column $type with text \"$text\" found.") if T(4); - # Separate the text into a type and data. - if ($type eq 'alias') { - # Here the caller wants external alias links for a feature. The text - # is the feature ID. - my $fid = $text; - # The complicated part is we have to hyperlink them. First, get the - # aliases. - Trace("Generating aliases for feature $fid.") if T(4); - my @aliases = $sprout->FeatureAliases($fid); - # Only proceed if we found some. - if (@aliases) { - # Join the aliases into a comma-delimited list. - my $aliasList = join(", ", @aliases); - # Ask the HTML processor to hyperlink them. - $retVal = HTML::set_prot_links($cgi, $aliasList); - } - } elsif ($type eq 'subsystem') { - # Here the caller wants the subsystems in which this feature participates. - # The text is the feature ID. We will list the subsystem names with links - # to the subsystem's summary page. - my $fid = $text; - # Get the subsystems. - Trace("Generating subsystems for feature $fid.") if T(4); - my %subs = $sprout->SubsystemsOf($fid); - # Extract the subsystem names. - my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs; - # String them into a list. - $retVal = join(", ", @names); - } elsif ($type =~ /^keyword:(.+)$/) { - # Here the caller wants the value of the named keyword. The text is the - # feature ID. - my $keywordName = $1; - my $fid = $text; - # Get the attribute values. - Trace("Getting $keywordName values for feature $fid.") if T(4); - my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid], - "Feature($keywordName)"); - # String them into a list. - $retVal = join(", ", @values); + my $retVal; + # Try to create the helper. + eval { + # Load it into memory. If it's already there nothing will happen here. + my $realName = "$type$className"; + Trace("Requiring helper $realName.") if T(3); + require "$realName.pm"; + Trace("Constructing helper object.") if T(3); + # Construct the object. + $retVal = eval("$realName->new(\$parm)"); + # Commit suicide if it didn't work. + if (! defined $retVal) { + die "Could not find a $type handler of type $className."; + } else { + # Perform any necessary subclass initialization. + $retVal->Initialize(); + } + }; + # Check for errors. + if ($@) { + Confess("Error retrieving $type$className: $@"); } # Return the result. return $retVal; @@ -2485,7 +2011,7 @@ =head3 SaveOrganismData -C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >> + my ($name, $displayGroup, $domain) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); Format the name of an organism and the display version of its group name. The incoming data should be the relevant fields from the B record in the database. The @@ -2515,10 +2041,14 @@ Strain of the species represented by the genome. +=item taxonomy + +Taxonomy of the species represented by the genome. + =item RETURN -Returns a two-element list. The first element is the formatted genome name. The second -element is the display name of the genome's group. +Returns a three-element list. The first element is the formatted genome name. The second +element is the display name of the genome's group. The third is the genome's domain. =back @@ -2526,7 +2056,7 @@ sub SaveOrganismData { # Get the parameters. - my ($self, $group, $genomeID, $genus, $species, $strain) = @_; + my ($self, $group, $genomeID, $genus, $species, $strain, $taxonomy) = @_; # Declare the return values. my ($name, $displayGroup); # If the organism does not exist, format an unknown name and a blank group. @@ -2542,17 +2072,20 @@ # Compute the display group. This is currently the same as the incoming group # name unless it's the supporting group, which is nulled out. $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group); + Trace("Group = $displayGroup, translated from \"$group\".") if T(4); } + # Compute the domain from the taxonomy. + my ($domain) = split /\s*;\s*/, $taxonomy, 2; # Cache the group and organism data. my $cache = $self->{orgs}; - $cache->{$genomeID} = [$name, $displayGroup]; + $cache->{$genomeID} = [$name, $displayGroup, $domain]; # Return the result. - return ($name, $displayGroup); + return ($name, $displayGroup, $domain); } =head3 ValidateKeywords -C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >> + my $okFlag = $shelp->ValidateKeywords($keywordString, $required); Insure that a keyword string is reasonably valid. If it is invalid, a message will be set. @@ -2588,6 +2121,8 @@ if (! @wordList) { if ($required) { $self->SetMessage("No search words specified."); + } else { + $retVal = 1; } } elsif (! @plusWords) { $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs."); @@ -2598,120 +2133,259 @@ return $retVal; } -=head3 Formlet +=head3 TuningParameters -C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >> + my $options = $shelp->TuningParameters(%parmHash); -Create a mini-form that posts to the specified URL with the specified parameters. The -parameters will be stored in hidden fields, and the form's only visible control will -be a submit button with the specified caption. - -Note that we don't use B services here because they generate forms with extra characters -and tags that we don't want to deal with. +Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names +to their default values. The parameters and their values will be returned as a hash reference. =over 4 -=item caption +=item parmHash -Caption to be put on the form button. +Hash mapping parameter names to their default values. -=item url +=item RETURN -URL to be put in the form's action parameter. +Returns a reference to a hash containing the parameter names mapped to their actual values. -=item target +=back -Frame or target in which the form results should appear. If C is specified, -the default target will be used. +=cut -=item parms +sub TuningParameters { + # Get the parameters. + my ($self, %parmHash) = @_; + # Declare the return variable. + my $retVal = {}; + # Get the CGI Query Object. + my $cgi = $self->Q(); + # Loop through the parameter names. + for my $parm (keys %parmHash) { + # Get the incoming value for this parameter. + my $value = $cgi->param($parm); + # Zero might be a valid value, so we do an is-defined check rather than an OR. + if (defined($value)) { + $retVal->{$parm} = $value; + } else { + $retVal->{$parm} = $parmHash{$parm}; + } + } + # Return the result. + return $retVal; +} -Hash containing the parameter names as keys and the parameter values as values. +=head3 GetPreferredAliasType -=back + my $type = $shelp->GetPreferredAliasType(); + +Return the preferred alias type for the current session. This information is stored +in the C parameter of the CGI query object, and the default is C +(which indicates the FIG ID). =cut -sub Formlet { +sub GetPreferredAliasType { # Get the parameters. - my ($caption, $url, $target, %parms) = @_; - # Compute the target HTML. - my $targetHtml = ($target ? " target=\"$target\"" : ""); - # Start the form. - my $retVal = ""; - # Add the parameters. - for my $parm (keys %parms) { - $retVal .= ""; - } - # Put in the button. - $retVal .= ""; - # Close the form. - $retVal .= ""; - # Return the result. + my ($self) = @_; + # Determine the preferred type. + my $cgi = $self->Q(); + my $retVal = $cgi->param('AliasType') || 'FIG'; + # Return it. return $retVal; } +=head3 Hint + + my $htmlText = SearchHelper::Hint($wikiPage, $hintText); + +Return the HTML for a small question mark that displays the specified hint text when it is clicked. +This HTML can be put in forms to provide a useful hinting mechanism. + +=over 4 + +=item wikiPage + +Name of the wiki page to be popped up when the hint mark is clicked. + +=item hintText + +Text to display for the hint. It is raw html, but may not contain any double quotes. + +=item RETURN + +Returns the html for the hint facility. The resulting html shows a small button-like thing that +uses the standard FIG popup technology. + +=back + +=cut + +sub Hint { + # Get the parameters. + my ($wikiPage, $hintText) = @_; + # Ask Sprout to draw the hint button for us. + return Sprout::Hint($wikiPage, $hintText); +} + + + =head2 Virtual Methods +=head3 HeaderHtml + + my $html = $shelp->HeaderHtml(); + +Generate HTML for the HTML header. If extra styles or javascript are required, +they should go in here. + +=cut + +sub HeaderHtml { + return ""; +} + =head3 Form -C<< my $html = $shelp->Form(); >> + my $html = $shelp->Form($mode); -Generate the HTML for a form to request a new search. +Generate the HTML for a form to request a new search. If the subclass does not +override this method, then the search is formless, and must be started from an +external page. + +=cut + +sub Form { + # Get the parameters. + my ($self) = @_; + return ""; +} =head3 Find -C<< my $resultCount = $shelp->Find(); >> + my $resultCount = $shelp->Find(); Conduct a search based on the current CGI query parameters. The search results will be written to the session cache file and the number of results will be returned. If the search parameters are invalid, a result count of C will be returned and a result message will be stored in this object describing the problem. +=cut + +sub Find { + # Get the parameters. + my ($self) = @_; + $self->Message("Call to pure virtual Find method in helper of type " . ref($self) . "."); + return undef; +} + =head3 Description -C<< my $htmlText = $shelp->Description(); >> + my $htmlText = $shelp->Description(); Return a description of this search. The description is used for the table of contents on the main search tools page. It may contain HTML, but it should be character-level, not block-level, since the description is going to appear in a list. -=head3 SortKey +=cut + +sub Description { + # Get the parameters. + my ($self) = @_; + $self->Message("Call to pure virtual Description method in helper of type " . ref($self) . "."); + return "Unknown search type"; +} + +=head3 SearchTitle + + my $titleHtml = $shelp->SearchTitle(); + +Return the display title for this search. The display title appears above the search results. +If no result is returned, no title will be displayed. The result should be an html string +that can be legally put inside a block tag such as C

    or C

    . + +=cut + +sub SearchTitle { + # Get the parameters. + my ($self) = @_; + # Declare the return variable. + my $retVal = ""; + # Return it. + return $retVal; +} + +=head3 DefaultColumns + + $shelp->DefaultColumns($rhelp); + +Store the default columns in the result helper. The default action is just to ask +the result helper for its default columns, but this may be changed by overriding +this method. + +=over 4 + +=item rhelp + +Result helper object in which the column list should be stored. + +=back + +=cut + +sub DefaultColumns { + # Get the parameters. + my ($self, $rhelp) = @_; + # Get the default columns from the result helper. + my @cols = $rhelp->DefaultResultColumns(); + # Store them back. + $rhelp->SetColumns(@cols); +} + -C<< my $key = $shelp->SortKey($fdata); >> +=head3 Initialize -Return the sort key for the specified feature data. The default is to sort by feature name, -floating NMPDR organisms to the top. If a full-text search is used, then the default -sort is by relevance followed by feature name. This sort may be overridden by the -search class to provide fancier functionality. This method is called by -B, so it is only used for feature searches. A non-feature search -would presumably have its own sort logic. + $shelp->Initialize(); + +Perform any initialization required after construction of the helper. + +=cut + +sub Initialize { + # The default is to do nothing. +} + +=head3 GetResultHelper + + my $rhelp = $shelp->GetResultHelper($className); + +Return a result helper for this search helper. The default action is to create +a result helper from scratch; however, if the subclass has an internal result +helper it can override this method to return it without having to create a new +one. =over 4 -=item record +=item className -The C containing the current feature. +Result helper class name. =item RETURN -Returns a key field that can be used to sort this row in among the results. +Returns a result helper of the specified class connected to this search helper. =back =cut -sub SortKey { +sub GetResultHelper { # Get the parameters. - my ($self, $fdata) = @_; - # Get the feature ID from the record. - my $fid = $fdata->FID(); - # Get the group from the feature ID. - my $group = $self->FeatureGroup($fid); - # Ask the feature query object to form the sort key. - my $retVal = $fdata->SortKey($self, $group); - # Return the result. + my ($self, $className) = @_; + # Create the helper. + my $retVal = GetHelper($self, RH => $className); + # return it. return $retVal; } -1; \ No newline at end of file +1;