[Bio] / Sprout / SearchHelper.pm Repository:
ViewVC logotype

View of /Sprout/SearchHelper.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (download) (as text) (annotate)
Mon Oct 2 07:31:46 2006 UTC (12 years, 11 months ago) by parrello
Branch: MAIN
Changes since 1.5: +1 -1 lines
Fixed GBrowse URL method.

#!/usr/bin/perl -w

package SearchHelper;

    use strict;
    use Tracer;
    use PageBuilder;
    use Digest::MD5;
    use File::Basename;
    use File::Path;
    use File::stat;
    use LWP::UserAgent;
    use Time::HiRes 'gettimeofday';
    use Sprout;
    use SFXlate;
    use FIGRules;
    use HTML;
    use BasicLocation;
    use FeatureQuery;
    use URI::Escape;
    use PageBuilder;

=head1 Search Helper Base Class

=head2 Introduction

The search helper is a base class for all search objects. It has methods for performing
all the common tasks required to build and manage a search cache. The subclass must
provide methods for generating and processing search forms. The base class has the
following object fields.

=over 4

=item cols

Reference to a list of column header descriptions. If undefined, then the session cache
file has been opened but nothing has been written to it.

=item fileHandle

File handle for the session cache file.

=item query

CGI query object, which includes the search parameters and the various
session status variables kept between requests from the user.

=item type

Session type: C<old> if there is an existing cache file from which we are
displaying search results, or C<new> if the cache file needs to be built.

=item class

Name of the search helper class as it would appear in the CGI query object
(i.e. without the C<SH> prefix.

=item sprout

Sprout object for accessing the database.

=item message

Message to display if an error has been detected.

=item orgs

Reference to a hash mapping genome IDs to organism names.

=item name

Name to use for this object's form.

=item scriptQueue

List of JavaScript statements to be executed after the form is closed.

=item genomeHash

Cache of the genome group hash used to build genome selection controls.

=item genomeParms

List of the parameters that are used to select multiple genomes.

=item filtered

TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this
field is updated by the B<FeatureQuery> object.

=back

=head2 Adding a new Search Tool

To add a new search tool to the system, you must

=over 4

=item 1

Choose a class name for your search tool.

=item 2

Create a new subclass of this object and implement each of the virtual methods. The
name of the subclass must be C<SH>I<className>.

=item 3

Create an include file among the web server pages that describes how to use
the search tool. The include file must be in the B<includes> directory, and
its name must be C<SearchHelp_>I<className>C<.inc>.

=item 4

In the C<SearchSkeleton.cgi> script, add a C<use> statement for your search tool
and then put the class name in the C<@advancedClasses> list.

=back

=head3 Building a Search Form

All search forms are three-column tables. In general, you want one form
variable per table row. The first column should contain the label and
the second should contain the form control for specifying the variable
value. If the control is wide, you should use C<colspan="2"> to give it
extra room. B<Do not> specify a width in any of your table cells, as
width management is handled by this class.

The general code for creating the form should be

    sub Form {
        my ($self) = @_;
        # Get the CGI object.
        my $cgi = @self->Q();
        # Start the form.
        my $retVal = $self->FormStart("form title");
        # Assemble the table rows.
        my @rows = ();
        ... push table row Html into @rows ...
        push @rows, $self->SubmitRow();
        ... push more Html into @rows ...
        # Build the table from the rows.
        $retVal .= $self->MakeTable(\@rows);
        # Close the form.
        $retVal .= $self->FormEnd();
        # Return the form Html.
        return $retVal;
    }

Several helper methods are provided for particular purposes.

=over 4

=item 1

L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
L</GetGenomes> 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</FeatureFilterRow> formats several rows of controls for filtering features.
When you start building the code for the L</Find> method, you can use a
B<FeatureQuery> object to automatically filter each genome's features using
the values from the filter controls.

=item 3

L</QueueFormScript> allows you to queue JavaScript statements for execution
after the form is fully generated. If you are using very complicated
form controls, the L</QueueFormScript> method allows you to perform
JavaScript initialization. The L</NmpdrGenomeMenu> control uses this
facility to display a list of the pre-selected genomes.

=back

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</Find> 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</FeatureFilterRows> method
has been used to create feature filtering parameters.

    sub Find {
        my ($self) = @_;
        # Get the CGI and Sprout objects.
        my $cgi = $self->Q();
        my $sprout = $self->DB();
        # Declare the return variable. If it remains undefined, the caller will
        # know that an error occurred.
        my $retVal;
        ... validate the parameters ...
        if (... invalid parameters...) {
            $self->SetMessage(...appropriate message...);
        } elsif (FeatureQuery::Valid($self)) {
            # Initialize the session file.
            $self->OpenSession();
            # 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++;
                    }
                }
            }
        }
        # Close the session file.
        $self->CloseSession();
        # Return the result count.
        return $retVal;
    }

A Find method is of course much more complicated than generating a form, and there
are variations on the above them. 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.

If you wish to add your own extra columns to the output, use the B<AddExtraColumns>
method of the feature query object.

    $fq->AddExtraColumns(score => $sc);

The L</Find> method must return C<undef> if the search parameters are invalid. If this
is the case, then a message describing the problem should be passed to the framework
by calling L</SetMessage>. If the parameters are valid, then the method must return
the number of items found.

=cut

# This counter is used to insure every form on the page has a unique name.
my $formCount = 0;

=head2 Public Methods

=head3 new

C<< my $shelp = SearchHelper->new($query); >>

Construct a new SearchHelper object.

=over 4

=item query

The CGI query object for the current script.

=back

=cut

sub new {
    # Get the parameters.
    my ($class, $query) = @_;
    # Check for a session ID.
    my $session_id = $query->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();
        $type = "new";
        $query->param(-name => 'SessionID', -value => $session_id);
    }
    # Compute the subclass name.
    $class =~ /SH(.+)$/;
    my $subClass = $1;
    # Insure everybody knows we're in Sprout mode.
    $query->param(-name => 'SPROUT', -value => 1);
    # Generate the form name.
    my $formName = "$class$formCount";
    $formCount++;
    # 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.
    my $retVal = {
                  query => $query,
                  type => $type,
                  class => $subClass,
                  sprout => undef,
                  orgs => {},
                  name => $formName,
                  scriptQueue => [],
                  genomeList => undef,
                  genomeParms => [],
                  filtered => 0,
                 };
    # Bless and return it.
    bless $retVal, $class;
    return $retVal;
}

=head3 Q

C<< my $query = $shelp->Q(); >>

Return the CGI query object.

=cut

sub Q {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{query};
}

=head3 DB

C<< my $sprout = $shelp->DB(); >>

Return the Sprout database object.

=cut

sub DB {
    # Get the parameters.
    my ($self) = @_;
    # Insure we have a database.
    my $retVal = $self->{sprout};
    if (! defined $retVal) {
        $retVal = SFXlate->new_sprout_only();
        $self->{sprout} = $retVal;
    }
    # Return the result.
    return $retVal;
}

=head3 IsNew

C<< 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.

=cut

sub IsNew {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return ($self->{type} eq 'new');
}

=head3 ID

C<< my $sessionID = $shelp->ID(); >>

Return the current session ID.

=cut

sub ID {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->Q()->param("SessionID");
}

=head3 FormName

C<< my $name = $shelp->FormName(); >>

Return the name of the form this helper object will generate.

=cut

sub FormName {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{name};
}

=head3 QueueFormScript

C<< $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
the closing </FORM> tag is emitted, the form elements cannot be referenced by
name. When generating the statement, you can refer to the variable C<thisForm>
in order to reference the form in progress. Thus,

    thisForm.simLimit.value = 1e-10;

would set the value of the form element C<simLimit> in the current form to
C<1e-10>.

=over 4

=item statement

JavaScript statement to be queued for execution after the form is built.
The trailing semi-colon is required. Theoretically, you could include
multiple statements separated by semi-colons, but one at a time works
just as well.

=back

=cut

sub QueueFormScript {
    # Get the parameters.
    my ($self, $statement) = @_;
    # Push the statement onto the script queue.
    push @{$self->{scriptQueue}}, $statement;
}

=head3 FormStart

C<< 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
tracing, sprout status, and search class.

A call to L</FormEnd> is required to close the form.

=over 4

=item title

Title to be used for the form.

=item RETURN

Returns the initial HTML for the search form.

=back

=cut

sub FormStart {
    # Get the parameters.
    my ($self, $title) = @_;
    # Get the CGI object.
    my $cgi = $self->Q();
    # Start the form.
    my $retVal = "<div class=\"search\">\n" .
                 $cgi->start_form(-method => 'POST',
                                  -action => $cgi->url(-relative => 1),
                                  -name => $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));
    }
    # Put in an anchor tag in case there's a table of contents.
    my $anchorName = $self->FormName();
    $retVal .= "<a name=\"$anchorName\"></a>\n";
    # Return the result.
    return $retVal;
}

=head3 FormEnd

C<< my $htmlText = $shelp->FormEnd(); >>

Return the HTML text for closing a search form. This closes both the C<form> and
C<div> tags.

=cut

sub FormEnd {
    # Get the parameters.
    my ($self) = @_;
    # Declare the return variable, closing the form and the DIV block.
    my $retVal = "</form></div>\n";
    # Now we flush out the statement queue.
    my @statements = @{$self->{scriptQueue}};
    if (@statements > 0) {
        # Switch to JavaScript and set the "thisForm" variable.
        $retVal .= "<SCRIPT language=\"JavaScript\">\n" .
                   "  thisForm = document.$self->{name};\n";
        # Unroll the statements.
        while (@statements > 0) {
            my $statement = shift @statements;
            $retVal .= "  $statement\n";
        }
        # Close the JavaScript.
        $retVal .= "</SCRIPT>\n";
    }
    # Return the result.
    return $retVal;
}

=head3 SetMessage

C<< $shelp->SetMessage($msg); >>

Store the specified text as the result message. The result message is displayed
if an invalid parameter value is specified.

=over 4

=item msg

Text of the result message to be displayed.

=back

=cut

sub SetMessage {
    # Get the parameters.
    my ($self, $msg) = @_;
    # Store the message.
    $self->{message} = $msg;
}

=head3 Message

C<< my $text = $shelp->Message(); >>

Return the result message. The result message is displayed if an invalid parameter
value is specified.

=cut

sub Message {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->{message};
}

=head3 OpenSession

C<< $shelp->OpenSession(); >>

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.

=cut

sub OpenSession {
    # Get the parameters.
    my ($self) = @_;
    # Denote we have not yet written out the column headers.
    $self->{cols} = undef;
}

=head3 GetCacheFileName

C<< my $fileName = $shelp->GetCacheFileName(); >>

Return the name to be used for this session's cache file.

=cut

sub GetCacheFileName {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return $self->GetTempFileName('cache');
}

=head3 GetTempFileName

C<< 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.

=over 4

=item type

Type of temporary file to be generated.

=item RETURN

Returns a file name generated from the session name and the specified type.

=back

=cut

sub GetTempFileName {
    # Get the parameters.
    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";
    # Return the result.
    return $retVal;
}

=head3 PutFeature

C<< $shelp->PutFeature($fquery); >>

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.

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<AddExtraColumns> method. For example, the following
code adds columns for essentiality and virulence.

    $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
    $shelp->PutFeature($fq);

For correct results, all values should be specified for all extra columns in all calls to
B<PutFeature>. (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<undef>.

    if (! $essentialFlag) {
        $essentialFlag = undef;
    }
    $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
    $shelp->PutFeature($fq);

=over 4

=item fquery

FeatureQuery object containing the current feature data.

=back

=cut

sub PutFeature {
    # Get the parameters.
    my ($self, $fq) = @_;
    # Get the CGI query object.
    my $cgi = $self->Q();
    # Get the feature data.
    my $record = $fq->Feature();
    my $extraCols = $fq->ExtraCols();
    # Check for a first-call situation.
    if (! defined $self->{cols}) {
        # Here we need to set up the column information. Start with the defaults.
        $self->{cols} = $self->DefaultFeatureColumns();
        # Add the externals if they were requested.
        if ($cgi->param('ShowAliases')) {
            push @{$self->{cols}}, 'alias';
        }
        # Append the extras, sorted by column name.
        for my $col (sort keys %{$extraCols}) {
            push @{$self->{cols}}, "X=$col";
        }
        # 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) = $record->Value('Feature(id)');
    # 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 floats NMPDR organism features to the
    # top of the return list.
    my $key = $self->SortKey($record);
    # Write the feature data.
    $self->WriteColumnData($key, @output);
}

=head3 WriteColumnHeaders

C<< $shelp->WriteColumnHeaders(@colNames); >>

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

=item colNames

A list of column names in the desired presentation order.

=back

=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");
    # 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");
}

=head3 WriteColumnData

C<< $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.

=over 4

=item key

Sort key.

=item colValues

List of column values to write to the search result cache file for this session.

=back

=cut

sub WriteColumnData {
    # Get the parameters.
    my ($self, $key, @colValues) = @_;
    # Write them to the cache file.
    Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);
}

=head3 CloseSession

C<< $shelp->CloseSession(); >>

Close the session file.

=cut

sub CloseSession {
    # Get the parameters.
    my ($self) = @_;
    # Check for an open session file.
    if (defined $self->{fileHandle}) {
        # We found one, so close it.
        close $self->{fileHandle};
    }
}

=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); >>

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
only compute it once per run.

=over 4

=item genomeID

ID of the genome whose name is desired.

=item RETURN

Returns a list of two 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.

=back

=cut

sub OrganismData {
    # Get the parameters.
    my ($self, $genomeID) = @_;
    # Declare the return variables.
    my ($orgName, $group);
    # Check the cache.
    my $cache = $self->{orgs};
    if (exists $cache->{$genomeID}) {
        ($orgName, $group) = @{$cache->{$genomeID}};
    } 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)']);
        # Null out the supporting group.
        $group = "" if ($group eq $FIG_Config::otherGroup);
        # If the organism does not exist, format an unknown name.
        if (! defined($genus)) {
            $orgName = "Unknown Genome $genomeID";
        } else {
            # It does exist, so format the organism name.
            $orgName = "$genus $species";
            if ($strain) {
                $orgName .= " $strain";
            }
        }
        # Save this organism in the cache.
        $cache->{$genomeID} = [$orgName, $group];
    }
    # Return the result.
    return ($orgName, $group);
}

=head3 Organism

C<< 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.

=over 4

=item genomeID

ID of the genome whose name is desired.

=item RETURN

Returns the display name of the specified organism.

=back

=cut

sub Organism {
    # 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]";
    }
    # Return the result.
    return $retVal;
}

=head3 ComputeFASTA

C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>

Parse a sequence input and convert it into a FASTA string of the desired type. Note
that it is possible to convert a DNA sequence into a protein sequence, but the reverse
is not possible.

=over 4

=item incomingType

C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.

=item desiredType

C<dna> to return a DNA sequence, C<prot> to return a protein sequence. If the
I<$incomingType> is C<prot> and this value is C<dna>, an error will be thrown.

=item sequence

Sequence to return. It may be a DNA or protein sequence in FASTA form or a feature ID.
If a feature ID is specified, the feature's DNA or translation will be returned. The
feature ID is recognized by the presence of a vertical bar in the input. Otherwise,
if the input does not begin with a greater-than sign (FASTA label line), a default label
line will be provided.

=item RETURN

Returns a string in FASTA format representing the content of the desired sequence with
an appropriate label. If the input is invalid, a message will be stored and we will
return C<undef>. Note that the output will include a trailing new-line.

=back

=cut

sub ComputeFASTA {
    # Get the parameters.
    my ($self, $incomingType, $desiredType, $sequence) = @_;
    # Declare the return variable. If an error occurs, it will remain undefined.
    my $retVal;
    # Create variables to hold the FASTA label and data.
    my ($fastaLabel, $fastaData);
    # Check for a feature specification.
    if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
        # Here we have a feature ID in $1. We'll need the Sprout object to process
        # it.
        my $fid = $1;
        my $sprout = $self->DB();
        # Get the FIG ID. Note that we only use the first feature found. We are not
        # supposed to have redundant aliases, though we may have an ID that doesn't
        # exist.
        my ($figID) = $sprout->FeaturesByAlias($fid);
        if (! $figID) {
            $self->SetMessage("No feature found with the ID \"$fid\".");
        } else {
            # Set the FASTA label.
            my $fastaLabel = $fid;
            # Now proceed according to the sequence type.
            if ($desiredType =~ /prot/i) {
                # We want protein, so get the translation.
                $fastaData = $sprout->FeatureTranslation($figID);
            } else {
                # We want DNA, so get the DNA sequence. This is a two-step process.
                my @locList = $sprout->FeatureLocation($figID);
                $fastaData = $sprout->DNASeq(\@locList);
            }
        }
    } elsif ($incomingType =~ /prot/ && $desiredType =~ /dna/) {
        # Here we're being asked to do an impossible conversion.
        $self->SetMessage("Cannot convert a protein sequence to DNA.");
    } else {
        # Here we are expecting a FASTA. We need to see if there's a label.
        if ($sequence =~ /^>\s*(\S.*)\s*\n(.+)$/) {
            # Here we have a label, so we split it from the data.
            $fastaLabel = $1;
            $fastaData = $2;
        } else {
            # Here we have no label, so we create one and use the entire sequence
            # as data.
            $fastaLabel = "User-specified $incomingType sequence";
            $fastaData = $sequence;
        }
        # The next step is to clean the junk out of the sequence.
        $fastaData =~ s/\n//g;
        $fastaData =~ s/\s+//g;
        # Finally, if the user wants to convert to protein, we do it here. Note that
        # we've already prevented a conversion from protein to DNA.
        if ($incomingType ne $desiredType) {
            $fastaData = Sprout::Protein($fastaData);
        }
    }
    # At this point, either "$fastaLabel" and "$fastaData" have values or an error is
    # in progress.
    if (defined $fastaLabel) {
        # 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;
        my $retVal = join("\n", ">$fastaLabel", @chunks, "");
    }
    # Return the result.
    return $retVal;
}

=head3 NmpdrGenomeMenu

C<< 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
easier to select all genomes from a particular category.

=over 4

=item menuName

Name to give to the menu.

=item multiple

TRUE if the user is allowed to select multiple genomes, else FALSE.

=item selected

Reference to a list containing the IDs of the genomes to be pre-selected. If the menu
is not intended to allow multiple selections, the list should be a singleton. If the
list is empty, nothing will be pre-selected.

=item rows (optional)

Number of rows to display. If omitted, the default is 1 for a single-select list
and 10 for a multi-select list.

=item RETURN

Returns the HTML text to generate a C<SELECT> menu inside a form.

=back

=cut

sub NmpdrGenomeMenu {
    # Get the parameters.
    my ($self, $menuName, $multiple, $selected, $rows) = @_;
    # Get the Sprout and CGI objects.
    my $sprout = $self->DB();
    my $cgi = $self->Q();
    # Compute the row count.
    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};
            # Form the genome name.
            my $name = "$genus $species";
            if ($strain) {
                $name .= " $strain";
            }
            # Push the genome into the group's list.
            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.
    # 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 ($multiple) {
        $onChange = " onChange=\"$showSelect\"";
    }
    # Create the SELECT tag and stuff it into the output array.
    my $select = "<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">";
    my @lines = ($select);
    # Loop through the groups.
    for my $group (@groups) {
        # Create the option group tag.
        my $tag = "<OPTGROUP label=\"$group\">";
        push @lines, "  $tag";
        # Compute the label for this group's options. This is seriously dirty stuff, as the
        # label option may have functionality in future browsers. If that happens, we'll need
        # to modify the genome text so that the "selectSome" method can tell which are NMPDR
        # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript
        # hierarchy, so we can't use it.
        my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");
        # Get the genomes in the group.
        for my $genome (@{$groupHash->{$group}}) {
            my ($genomeID, $name) = @{$genome};
            # See if it's selected.
            my $select = ($selectedHash{$genomeID} ? " selected" : "");
            # Generate the option tag.
            my $optionTag = "<OPTION value=\"$genomeID\" label=\"$label\"$select>$name <em>($genomeID)</em></OPTION>";
            push @lines, "    $optionTag";
        }
        # Close the option group.
        push @lines, "  </OPTGROUP>";
    }
    # Close the SELECT tag.
    push @lines, "</SELECT>";
    # Check for multiple selection.
    if ($multiple) {
        # Since multi-select is on, we set up some buttons to set and clear selections.
        push @lines, "<br />";
        push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
        push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";
        push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";
        push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";
        # Now add 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, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />&nbsp;" .
                     "<INPUT type=\"button\" name=\"Select\" class=\"button\" value=\"Search\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";
        # Add the status display, too.
        push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
        # 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);
    # Return the result.
    return $retVal;
}

=head3 MakeTable

C<< 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.

The purpose of this method is to provide a uniform look for search form tables. It is
almost impossible to control a table using styles, so rather than have a table style,
we create the TABLE tag in this method. Note also that the first TD or TH in each row will
be updated with an explicit width so the forms look pretty when they are all on one
page.

=over 4

=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.

=item RETURN

Returns the full HTML for a table in the approved NMPDR Search Form style.

=back

=cut

sub MakeTable {
    # Get the parameters.
    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"
    # 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/(<td|th)/$1 width="150"/i;
    }
    # Create the table.
    my $retVal = $cgi->table({border => 2, cellspacing => 2,
                              width => 700, class => 'search'},
                             @{$rows});
    # Return the result.
    return $retVal;
}

=head3 SubmitRow

C<< my $htmlText = $shelp->SubmitRow(); >>

Returns the HTML text for the row containing the page size control
and the submit button. All searches should have this row somewhere
near the top of the form.

=cut

sub SubmitRow {
    # Get the parameters.
    my ($self) = @_;
    my $cgi = $self->Q();
    # 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, 45, 100, 1000],
                                                    -default => $pageSize) . " " .
                                   $cgi->checkbox(-name => 'ShowURL',
                                                  -value => 1,
                                                  -label => 'Show URL')),
                          $cgi->td($cgi->submit(-class => 'goButton',
                                                -name => 'Search',
                                                -value => 'Go')));
    # Return the result.
    return $retVal;
}

=head3 FeatureFilterRows

C<< my $htmlText = $shelp->FeatureFilterRows(); >>

This method creates table rows that can be used to filter features. There are
two rows returned, and the values can be used to select features by genome
using the B<FeatureQuery> 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); >>

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
without preamble. If the request method is GET and the parameter is not
specified, then it is treated as a request for all genomes. This makes it
easier for web pages to link to a search that wants to specify all genomes.

=over 4

=item parmName

Name of the parameter containing the list of genomes. This will be the
first parameter passed to the L</NmpdrGenomeMenu> call that created the
genome selection control on the form.

=item RETURN

Returns a list of the genomes to process.

=back

=cut

sub GetGenomes {
    # Get the parameters.
    my ($self, $parmName) = @_;
    # Get the CGI query object.
    my $cgi = $self->Q();
    # Get the list of genome IDs in the request header.
    my @retVal = $cgi->param($parmName);
    Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
    # Check for the special GET case.
    if ($cgi->request_method() eq "GET" && ! @retVal) {
        # Here the caller wants all the genomes.
        my $sprout = $self->DB();
        @retVal = $sprout->Genomes();
    }
    # Return the result.
    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
C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
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<p>&nbsp;</p>\n", @helps);
    # Return the result.
    return $retVal;
}

=head3 ComputeSearchURL

C<< my $url = $shelp->ComputeSearchURL(); >>

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
case if the search is coming from C<SearchSkeleton.cgi>.

A little expense is involved in order to make the URL as smart as possible. The
main complication is that if the user specified all genomes, we'll want to
remove the parameter entirely from a get-style URL.

=cut

sub ComputeSearchURL {
    # Get the parameters.
    my ($self) = @_;
    # Get the database and CGI query object.
    my $cgi = $self->Q();
    my $sprout = $self->DB();
    # Start with the full URL.
    my $retVal = $cgi->url(-full => 1);
    # 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
    # characters separating the individual values. We have to convert those to lists. In addition,
    # the multiple-selection genome parameters and the feature type parameter must be checked to
    # determine whether or not they can be removed from the URL. First, we get a list of the
    # genome parameters and a list of all genomes. Note that we only need the list if a
    # multiple-selection genome parameter has been found on the form.
    my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
    my @genomeList;
    if (keys %genomeParms) {
        @genomeList = $sprout->Genomes();
    }
    # Create a list to hold the URL parameters we find.
    my @urlList = ();
    # Now loop through the parameters in the hash, putting them into the output URL.
    for my $parmKey (keys %parms) {
        # Get a list of the parameter values. If there's only one, we'll end up with
        # a singleton list, but that's okay.
        my @values = split (/\0/, $parms{$parmKey});
        # Check for special cases.
        if ($parmKey eq 'featureTypes') {
            # Here we need to see if the user wants all the feature types. If he
            # does, we erase all the values so that the parameter is not output.
            my %valueCheck = map { $_ => 1 } @values;
            my @list = FeatureQuery::AllFeatureTypes();
            my $okFlag = 1;
            for (my $i = 0; $okFlag && $i <= $#list; $i++) {
                if (! $valueCheck{$list[$i]}) {
                    $okFlag = 0;
                }
            }
            if ($okFlag) {
                @values = ();
            }
        } elsif (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {
            # These are bookkeeping parameters we don't need to start a search.
            @values = ();
        } elsif ($parmKey =~ /_SearchThing$/) {
            # Here the value coming in is from a genome control's search thing. It does
            # not affect the results of the search, so we clear it.
            @values = ();
        } elsif ($genomeParms{$parmKey}) {
            # Here we need to see if the user wants all the genomes. If he does,
            # we erase all the values just like with features.
            my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
            if ($allFlag) {
                @values = ();
            }
        }
        # If we still have values, create the URL parameters.
        if (@values) {
            push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
        }
    }
    # Add the parameters to the URL.
    $retVal .= "?" . join(";", @urlList);
    # Return the result.
    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;
}

=head2 Feature Column Methods

The methods in this column 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<protlink>. If the column is to appear
in the default list of feature columns, add it to the list returned by
L</DefaultFeatureColumns>. Then add code to produce the column title to
L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>, 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<X=>, then it is presumed to be
an extra column. The column title is the text after the C<X=>, and its value is
pulled from the extra column hash.

=head3 DefaultFeatureColumns

C<< my $colNames = $shelp->DefaultFeatureColumns(); >>

Return a reference to a list of the default feature column identifiers. These
identifiers can be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in
order to produce the column titles and row values.

=cut

sub DefaultFeatureColumns {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return ['orgName', 'function', 'gblink', 'protlink',
            FeatureQuery::AdditionalColumns($self)];
}

=head3 FeatureColumnTitle

C<< my $title = $shelp->FeatureColumnTitle($colName); >>

Return the column heading title to be used for the specified feature column.

=over 4

=item name

Name of the desired feature column.

=item RETURN

Returns the title to be used as the column header for the named feature column.

=back

=cut

sub FeatureColumnTitle {
    # Get the parameters.
    my ($self, $colName) = @_;
    # Declare the return variable. We default to a blank column name.
    my $retVal = "&nbsp;";
    # Process the column name.
    if ($colName =~ /^X=(.+)$/) {
        # Here we have an extra column.
        $retVal = $1;
    } elsif ($colName eq 'orgName') {
        $retVal = "Name";
    } elsif ($colName eq 'fid') {
        $retVal = "FIG ID";
    } elsif ($colName eq 'alias') {
        $retVal = "External Aliases";
    } elsif ($colName eq 'function') {
        $retVal = "Functional Assignment";
    } elsif ($colName eq 'gblink') {
        $retVal = "GBrowse";
    } elsif ($colName eq 'protlink') {
        $retVal = "NMPDR Protein Page";
    } elsif ($colName eq 'group') {
        $retVal = "NMDPR Group";
    }
    # Return the result.
    return $retVal;
}

=head3 FeatureColumnValue

C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>

Return the value to be displayed in the specified feature column.

=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

Reference to a hash of extra column names to values. If the incoming column name
begins with C<X=>, 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 = "&nbsp;";
    # 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<undef> 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 'orgName') {
        # Here we want the formatted organism name and feature number.
        $retVal = $self->FeatureName($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 '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 = "%%aliases=$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.
        my $gurl = "GetGBrowse.cgi?fid=$fid";
        $retVal = $cgi->a({ href => $gurl, title => "GBrowse for $fid" },
                          $cgi->img({ src => "../images/button-gbrowse.png",
                                      border => 0 })
                         );
    } elsif ($colName eq 'protlink') {
        # Here we want a link to the protein page using the official NMPDR button.
        my $hurl = HTML::fid_link($cgi, $fid, 0, 1);
        $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },
                          $cgi->img({ src => "../images/button-nmpdr.png",
                                     border => 0 })
                         );
    } 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);
    }
    # 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

=item type

Type of column.

=item text

Data relevant to this row of the column.

=item RETURN

Returns the fully-formatted HTML text to go in the specified column.

=back

=cut

sub RunTimeColumns {
    # Get the parameters.
    my ($self, $type, $text) = @_;
    # Declare the return variable.
    my $retVal = "";
    # Get the Sprout and CGI objects.
    my $sprout = $self->DB();
    my $cgi = $self->Q();
    # Separate the text into a type and data.
    if ($type eq 'aliases') {
        # 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);
        }
    }
    # Return the result.
    return $retVal;
}

=head2 Virtual Methods

=head3 Form

C<< my $html = $shelp->Form(); >>

Generate the HTML for a form to request a new search.

=head3 Find

C<< 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<undef> will be
returned and a result message will be stored in this object describing the problem.

=head3 Description

C<< 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

C<< my $key = $shelp->SortKey($record); >>

Return the sort key for the specified record. The default is to sort by feature name,
floating NMPDR organisms to the top. This sort may be overridden by the search class
to provide fancier functionality. This method is called by B<PutFeature>, so it
is only used for feature searches. A non-feature search would presumably have its
own sort logic.

=over 4

=item record

The C<DBObject> from which the current row of data is derived.

=item RETURN

Returns a key field that can be used to sort this row in among the results.

=back

=cut

sub SortKey {
    # Get the parameters.
    my ($self, $record) = @_;
    # Get the feature ID from the record.
    my ($fid) = $record->Value('Feature(id)');
    # Get the group from the feature ID.
    my $group = $self->FeatureGroup($fid);
    # Ask the feature query object to form the sort key.
    my $retVal = FeatureQuery::SortKey($self, $group, $record);
    # Return the result.
    return $retVal;
}
1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3