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

View of /Sprout/SearchSkeleton.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (as text) (annotate)
Wed Sep 21 21:05:15 2011 UTC (8 years, 2 months ago) by parrello
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +0 -0 lines
FILE REMOVED
Changes to support complexes.

#!/usr/bin/perl -w

#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
#
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License.
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#
package SearchSkeleton;

    use strict;
    use Tracer;
    use CGI qw(-nosticky);
    use Sprout;
    use SearchHelper;
    use POSIX qw(ceil);
    use File::stat;
    use FIGRules;
    use TWiki::Func;
    use HTML::Template;

=head1 NMPDR Search Skeleton

This package executes a search and displays the results. If, on entry,
it sees a session ID, then it will assume search results have been
cached and the cached results are to be displayed. Otherwise, it
will perform the search, cache the results, and display the first
page. The search itself is performed by an object that subclasses
B<SearchHelper>. The results are formatted by an object that
subclasses C<ResultHelper>.To allow for additional search types, you need
merely implement a new subclass of B<SearchHelper> and possibly a
new subclass of B<ResultHelper>. By convention, all search helper
subclasses begin with the letters C<SH> and all result helper
subclasses begin with the letters C<RH>. This is not consistent
with normal PERL practice, but it fits better into the way we
do builds.

=head2 Session Data

The following parameters are expected from the CGI query object.
Additional parameters may be required by whichever B<SearchHelper>
subclass is selected. By convention, the parameters required by
the subclasses will be lower-case and the parameters used by this
script are capital-case. Note that some parameters are only required
by old sessions, that is, sessions which are established with
existing search result cache files.

=over 4

=item Trace

Trace level and list of trace modules to turn on, space-delimited.

=item NoForm

If specified, then no search form will be generated.

=item SessionID

Unique session ID for this user. This is used to generate the name of the user's
cache file in the temporary directory. The actual filename will be
C<tmp_>I<SessionID>C<.cache>.

=item Page (old only)

Number of the current page to display.

=item PageSize

Number of items per page.

=item ResultCount (old only)

Total number of search result lines.

=item ResultType (old only)

Type of result displayed.

=item Class

Name of the B<SearchHelper> subclass for this type of search. The name does not include
the C<SH> prefix. So, to specify a B<SHFidSearch> type of
search, you would specify a class of C<FidSearch>. If this parameter is omitted,
then all of the advanced search forms will be displayed.

=item Alternate

If specified, then a list of advanced search forms will be shown.

=item Download

If specified, then the table of search results will be downloaded. The value
indicates the download format. Currently, C<tbl> will download the search results
in a tab-delimited file, and C<fasta> will download the search results as a
FASTA file.

=item DownloadItem

If specified, then only the item specified will be downloaded rather than
all of the search results. At some point this will be a list-type thing so
the user can download more than one item.

=back

=head2 The Cache File

The cache file is a tab-delimited file. The first line of the file contains the
column names and the remaining lines contain the data for each result item.

The column contents may contain HTML tags, including hyperlinks and buttons. For best
results, all links should be relative.

Some columns will consist of a doubled percent sign followed by a name, an equal sign,
and some text. This tells the display code to call the B<RunTimeColumns> method of
the B<SearchHelper> object to compute the column value. This facility is designed for
columns that require a lot of time to calculate, so we don't want to calculate them
until we absolutely have to display them.

If the cache file is empty or has only a single line, a stock "No Search Results"
message will be displayed.

=cut

# Global variable containing the names of the parameters that get stored in the status URL.
my @Keepers = qw(SessionID Trace NoForm ResultCount ResultType Page PageSize Class
                 SPROUT Download FavoredAlias);
# Map of old class names to new class names.
my %ClassMap = (BlastSearch => 'ToolSearch', FidSearch => 'GeneSearch');
# List of searches we want to hide from users. This will go away when we've fixed up the wiki.
my %Hidden = (PropSearch => 1);

=head3 Package Methods

=head3 main

    SearchSkeleton::main($cgi, $session, $varHash);

Process a search request. This method will analyze the CGI parameters and
write output directly to the user's browser.

=over 4

=item cgi

CGI query object to use for accessing the search parameters.

=item session

TWiki session object.

=item varHash

Hash to use for computing screen data to display.

=back

=cut

sub main {
    # Get the parameters.
    my ($cgi, $session, $varHash) = @_;
    # Turn on emergency tracing.
    ETracing($cgi);
    # If this next variable is set to Download, then a download is in progress and the output
    # is saved to the user's hard drive. If it's set to "Search", then a search is in
    # progress and we don't produce the template at the end.
    my $mode = "Display";
    # If search mode is 1, the search helper will be in here.
    my $shelp;
    # If there are results, the results helper will be in here.
    my $rhelp;
    eval {
        # Get the search class.
        my $class = $cgi->param("Class");
        # Get the result type (if any).
        my $resultType = $cgi->param("ResultType");
        # Check for advanced mode.
        if ($cgi->param("Alternate")) {
            Trace("Advanced mode selected.") if T(3);
            # In advanced mode, we list all the search forms in
            # $FIG_Config::advanced_class.
            my @classes = split(/\s+/, $FIG_Config::advanced_class);
            # Set the page size to the default.
            $cgi->param(-name => 'PageSize', -value => $FIG_Config::results_per_page);
            # Tell the template we have no search results and no class.
            $varHash->{result_count} = 0;
            $varHash->{class} = "";
            # Loop through the classes, creating the table of contents and
            # the forms.
            $varHash->{formIndex} = CGI::h3("Contents") . CGI::start_ul();
            for my $className (@classes) {
                my $shelp = SearchHelper::GetHelper($cgi, SH => $className);
                # Produce the contents entry.
                $varHash->{formIndex} .= CGI::li(CGI::a({href => "#X$className"}, $className) .
                                                  ": " . $shelp->Description());
                # Produce the bookmark.
                $varHash->{form} .= CGI::a({ name => "X$className" });
                # Produce the form.
                $varHash->{form} .= $shelp->Form();
                # Produce the help text.
                $varHash->{form} .= $shelp->GetHelpText();
                # Put some space between us and whatever comes next.
                $varHash->{form} .= "<p>&nbsp;</p>";
            }
            # Check the number of classes.
            if (@classes < 2) {
                # Only one class, so we don't need the table of contents.
                $varHash->{formIndex} = "";
            } else {
                # Multiple classes, so close the table of contents.
                $varHash->{formIndex} .= CGI::end_ul();
            }
        } elsif (! $class) {
            Trace("Producing index of search tools.") if T(3);
            # No class specified, so we simply generate an index of the
            # searches. First, make sure the template knows there are no search results.
            $varHash->{result_count} = 0;
            Trace("Building URL.") if T(3);
            # Get a copy of our URL and append a question mark.
            my $selfURL = "$FIG_Config::cgi_url/SearchSkeleton.cgi?";
            # Loop through the search classes building a table of contents.
            my @contents = ();
            for my $className (SearchHelper::AdvancedClassList()) {
                if ($Hidden{$className}) {
                    Trace("Skipping hidden class $className.") if T(3);
                } else {
                    Trace("Processing $className") if T(3);
                    my $shelp = SearchHelper::GetHelper($cgi, SH => $className);
                    push @contents, "<a href=\"${selfURL}Class=$className\">$className</a>: " .
                        $shelp->Description();
                }
            }
            # Create the table of contents.
            Trace("Building index.") if T(3);
            my $index = CGI::h3("Index of Search Tools" .
                                SearchHelper::Hint('NmpdrSearch')) .
                        CGI::ul(CGI::li(\@contents));
            # Add the main help link.
            # Store it as the results.
            $varHash->{results} = $index;
            # Tell the template we don't have a class.
            $varHash->{class} = "";
            Trace("Index built.") if T(3);
        } else {
            Trace("Class $class detected.") if T(3);
            # If this class has had its name changed, use the new name.
            if (exists $ClassMap{$class}) {
                $class = $ClassMap{$class};
                $cgi->param(Class => $class);
                Trace("New class name is $class.") if T(3);
            }
            # Here we have a class, so we're working with a single type of search.
            $shelp = SearchHelper::GetHelper($cgi, SH => $class);
            # Tell the template what the class is.
            $varHash->{class} = $class;
            # Generate its header stuff.
            $varHash->{head} = $shelp->HeaderHtml();
            # Insure we have a page size.
            if (! $cgi->param("PageSize")) {
                $cgi->param(-name => 'PageSize', -value => $FIG_Config::results_per_page);
            }
            # Declare the result count variable.
            my $result_count = 0;
            # Now there are three different directions we can go. If a
            # "Search" button has been pressed, then we need to perform a
            # search. If this is a new session and the button has not
            # been pressed, we do nothing. If this is an old session
            # and the button has not been pressed, we display results. Note
            # that we allow for regular buttons (Search) or image buttons
            # (Search.x).
            if (!$cgi->param("Search") && !$cgi->param("Search.x")) {
                # No button, so check for results. Note we only do this if this is not
                # a new session. A new session won't have results.
                Trace("No search requested.") if T(3);
                # Check for a result type.
                if (defined $resultType) {
                    # Get the object that controls the result type.
                    $rhelp = SearchHelper::GetHelper($shelp, RH => $resultType);
                }
                # Get the result count, which should have been set when we did the search. If
                # we did no search, it won't be set, so in that case we want to make it zero.
                $result_count = $cgi->param("ResultCount") || 0;
                # Get the download type (if any).
                my $dlType = $cgi->param("Download") | "";
                # Check for a Download request.
                if ($dlType) {
                    # Here we're downloading.
                    $mode = "Download";
                    # Download the results.
                    DownloadResults($dlType, $shelp, $rhelp, $cgi);
                } else {
                    # If we have a saved search, load its parameters so they show up in the form.
                    LoadSearchParms($cgi, $shelp);
                    # Display the form, if desired. This absolutely must happen before we do the
                    # ShowURL thing when we display the results. The form can actually appear
                    # after the results, however, thanks to the template.
                    my $formShown = ! $cgi->param("NoForm");
                    if (! $cgi->param("NoForm")) {
                        Trace("Displaying form.") if T(3);
                        $varHash->{form} = $shelp->Form();
                    }
                    if (! $shelp->IsNew()) {
                        # We have results, so display them.
                        $varHash->{results} = DisplayResults($shelp, $rhelp, $cgi);
                    }
                    # Save the result count so that the results helper text appears if it
                    # is needed. This text is in the template, but it's protected by a TMPL_IF
                    # on "result_count".
                    $varHash->{result_count} = $result_count;
                }
            } else {
                # Here we have a button press, so we need to find stuff. In this case the
                # template is not used. Instead, status is displayed while we search, and
                # then a JavaScript trick is used to switch the user to the first page of
                # results. This prevents the server from giving up if the search takes a long
                # time.
                Trace("Performing the search.") if T(3);
                # Save the search parameters so we can display them on the result pages.
                Trace("Saving search parameters.") if T(3);
                SaveSearchParms($cgi, $shelp);
                # Denote we're in searching mode. This means we'll be displaying the HTML
                # as we go along.
                $mode = "Searching";
                # Make sure the output is unbuffered.
                $| = 1;
                # Start the HTML page.
                print CGI::header();
                print CGI::start_html(-title => 'NMPDR Search in Progress',
                                       -style => { src => "$FIG_Config::cgi_url/wiki/pub/Main/TWikiPreferences/NmpdrStyleOverrides.css" }
                                      );
                # Print the banner.
                print CGI::img({ src => "$FIG_Config::cgi_url/wiki/pub/Main/TWikiPreferences/banner2.png" });
                # Tell the user the type of this search.
                print CGI::h2($shelp->SearchTitle()) . "\n";
                # Start a paragraph.
                print "<p>\n";
                # Perform the search.
                Trace("Calling FIND method.") if T(3);
                $result_count = $shelp->Find();
                Trace("Processing results.") if T(3);
                # End the paragraph.
                print "</p>\n";
                # Check to see what kind of results we got.
                if (! defined($result_count)) {
                    # Here an error occurred, so we display the error message.
                    $shelp->PrintLine(CGI::h3("ERROR: " . $shelp->Message()));
                    $result_count = 0;
                    $shelp->PrintLine(CGI::p("Use your browser's BACK button to try again."));
                } else {
                    # Here we have results (even though there may be zero of them. Save
                    # the result count and set up to display the first page of results.
                    $cgi->param(-name => "ResultCount", -value => $result_count);
                    $cgi->param(-name => "Page", -value => 1);
                    # Now we create the URL for the first page of results.
                    my $page1Url = StatusURL($cgi);
                    # Create the Javascript thingie to pull up the results.
                    $shelp->PrintLine('<script type="text/javascript">');
                    $shelp->PrintLine("  location.href = \"$page1Url\";");
                    $shelp->PrintLine('</script>');
                }
            }
        }
    };
    if ($@) {
        # Compute the error message HTML.
        my $message = $@;
        $varHash->{results} = FIGRules::NmpdrErrorPage(SearchSkeleton => $message);
        if ($mode eq "Searching") {
            # Here we've already started the page, so we output the error message immediately.
            $shelp->PrintLine($varHash->{results});
        } elsif ($mode eq "Download") {
            # A download is in progress, so we have to put an error message in
            # the download file. Note that we trim off the extra trace garbage
            # to reduce the yuckiness.
            my ($realMessage) = split /\n/, $message, 2;
            print "\n\n*** ERROR: Download failed: $realMessage\n";
        }
    }
    if ($mode eq "Searching") {
        # We've already started the page, so all we have to do is terminate it.
        $shelp->PrintLine(CGI::end_html());
    } elsif ($mode eq "Display") {
        # Here there's been no output, so we're showing either a form or results.
        # Print the CGI header. We suppress browser caches so that the javascript
        # doesn't go haywire on us.
        print "Cache-Control: no-cache\n";
        print $cgi->header();
        # Produce the output using a template.
        print MyPage($varHash);
    }
}

=head3 MyPage

    my $html = MyPage($varHash);

Output a search form or result page. The incoming hash contains
parameters that are plugged into a template.

=over 4

=item varHash

Hash containing the variable data to be placed on the page.

=item RETURN

Returns the page HTML to display.

=back

The variables in the hash should be as follows.

=over 4

=item result_count

Number of search results.

=item results

Table displaying the search results.

=item formIndex

If multiple search forms are displayed, this should contain the table of contents.

=item form

Search form.

=item tracing

Debugging output.

=back

=cut

sub MyPage {
    # Get the parameters.
    my ($varHash) = @_;
    # Compute the page title.
    my $resultsFound = $varHash->{result_count};
    my $title = ($resultsFound ? 'SearchResults' : 'SearchPage');
    # Get the text template. This is an HTML template, not a TWiki template.
    my $htmlTemplate = TWiki::Func::readAttachment('Main', 'TWikiPreferences', 'Search.tmpl');
    my $templateObject = HTML::Template->new(scalarref => \$htmlTemplate,
                                             die_on_bad_params => 0);
    # Next, we pass in the variable values.
    for my $varKey (keys %{$varHash}) {
        # Get the variable value.
        my $varValue = $varHash->{$varKey};
        # Check for an undefined value.
        if (! defined($varValue)) {
            # Treat it as a null string.
            $templateObject->param($varKey => "");
        } else {
            # Check for an array of scalars. We convert this into a string
            # for compatibility with earlier stuff. An array of hashes is
            # okay, because it's used for loops.
            if (ref $varValue eq 'ARRAY') {
                if (scalar @{$varValue} > 0 && ! ref $varValue->[0]) {
                    $varValue = join("\n", @{$varValue});
                }
            }
            # Record the parameter.
            $templateObject->param($varKey => $varValue);
        }
    }
    # Finally, we produce the text.
    my $text = $templateObject->output();
    # Get the view template. This IS a TWiki template.
    my $template = TWiki::Func::loadTemplate('view');
    # Set the meta-variable values.
    $template =~ s/%TEXT%/$text/g;
    $template =~ s/%REVTITLE%//g;
    # Expand it.
    my $raw = TWiki::Func::expandCommonVariables($template, $title, 'Main');
    # Render it into HTML.
    my $retVal = TWiki::Func::renderText($raw, 'Main');
    # Clean the nops.
    $retVal =~ s/<nop>//g;
    # Return the result.
    return $retVal;
}


=head3 DownloadResults

    DownloadResults($dlType, $shelp, $rhelp, $cgi);

Download the search results as a text file. We use a content-disposition header to create
output that will be saved automatically to the user's hard drive.

=over 4

=item dlType

Download type (e.g. C<tbl>, C<fasta>).

=item shelp

Actice search helper.

=item rhelp

Relevant result helper. This is used to retrieve and process the results.

=item cgi

CGI query object used to format the output.

=back

=cut

sub DownloadResults {
    # Get the parameters.
    my ($dlType, $shelp, $rhelp, $cgi) = @_;
    # Get the operating system type.
    my $osType = $cgi->param('os');
    # Compute the appropriate EOL marker based on the web user's OS. Unfortunately,
    # on the Mac download files are always treated as binary, and in all environments,
    # FireFox doesn't display the download dialog correctly unless it's binary.
    my $eol = FIGRules::ComputeEol($osType);
    # Compute a file name.
    my $defaultName = $cgi->param('Class') . ".$dlType";
    # Check the state of the session file.
    my $fileName = $shelp->GetCacheFileName();
    if (! -e $fileName) {
        Confess("Search session has expired. Please resubmit your query.");
    } else {
        # Write the CGI header.
        print CGI::header(-type => 'application/octet-stream',
                           -attachment => $defaultName);
        # Put us in binary mode so that the output doesn't do screwy stuff with new-lines.
        binmode(STDOUT);
        # The session file is here, so we can open it.
        my $sessionH = Open(undef, "<$fileName");
        if (T(3)) {
            my $fileData = stat($sessionH);
            Trace($fileData->size . " bytes in $fileName.");
        }
        # Read the column headers.
        my @colHdrs = $shelp->ReadColumnHeaders($sessionH);
        # Get the list of items to keep. If the list is empty, we keep everything. The idea here is that the user
        # might have the option to select certain rows to be downloaded. The rows are identified by the row key,
        # which is the first column in each row.
        my %keepers = map { $_ => 1 } $cgi->param('DownloadItem');
        # Here we get the number of lines to be downloaded. If we're not downloading everything,
        # we'll decrement this number each time we download a kept item, and stop when it hits zero.
        my $selections = scalar(keys %keepers);
        my $selective = ($selections > 0);
        # Download the header.
        Trace("Downloading header. " . scalar(@colHdrs) . " columns present.") if T(3);
        my @lines = $rhelp->DownloadDataLine(undef, $dlType, 'header', \@colHdrs);
        DownloadLines($eol, @lines);
        Trace("Downloading data lines.") if T(3);
        # Now loop through the lines in the file, converting them to output text.
        while (! eof $sessionH && (! $selective || $selections > 0)) {
            # Get the current line of columns.
            Trace("Reading line from session file.") if T(3);
            my @cols = Tracer::GetLine($sessionH);
            # Extract the object ID, which is the first column of the results.
            my $objectID = shift @cols;
            # Test to see if we're keeping this line.
            if (! $selective || $keepers{$objectID}) {
                # If so, we download it. Decrement the selection counter.
                $selections--;
                # Call the DownloadDataLine method to produce the lines of data to write.
                @lines = $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs);
                # Write them out with the appropriate line-end character.
                DownloadLines($eol, @lines);
            }
        }
        # Download the footer.
        Trace("Downloading footer.") if T(3);
        @lines = $rhelp->DownloadDataLine(undef, $dlType, 'footer', \@colHdrs);
        DownloadLines($eol, @lines);
    }
}

=head3 DownloadLines

    DownloadLines($eol, @lines);

Write the specified lines to the download output using the given end-of-line character.

=over 4

=item eol

End-of-line character to use.

=item lines

List of lines to write.

=back

=cut

sub DownloadLines {
    # Get the parameters.
    my ($eol, @lines) = @_;
    # Output the lines.
    print join($eol, @lines, "");
}

=head3 DisplayResults

    my $htmlText = DisplayResults($shelp, $rhelp, $cgi);

Display the results of a search. A page of results will be displayed, along with links to get to
other pages. The HTML for the results display is returned.

=over 4

=item shelp

Search helper object representing the search. The column headers and search rows will be
stored in the session file attached to it.

=item rhelp

Result helper object used to format the results.

=item cgi

CGI query object for the current session. This includes the page number, size, and result
counts.

=item RETURN

Returns the HTML text for displaying the current page of search results.

=back

=cut

sub DisplayResults {
    # Get the parameters.
    my ($shelp, $rhelp, $cgi) = @_;
    # Declare the return variable.
    my $retVal = "";
    # Check for a title.
    my $title = $shelp->SearchTitle();
    if ($title) {
        $title = CGI::h3($title);
    }
    # Extract the result parameters.
    my ($pageSize, $pageNum, $resultCount) = map { $cgi->param($_) } qw(PageSize Page ResultCount);
    my $rhelperClass = $cgi->param('ResultType');
    my $shelperClass = $cgi->param('Class');
    Trace("Result count is $resultCount on page $pageNum for $pageSize/page.") if T(3);
    Trace("Preferred ID style is " . $shelp->GetPreferredAliasType() . ".") if T(3);
    # Only proceed if there are actual results.
    if ($resultCount <= 0) {
        $retVal .= CGI::h3("No matches found.");
    } else {
        # Check the state of the session file.
        my $fileName = $shelp->GetCacheFileName();
        if (! -e $fileName) {
            $retVal .= CGI::h3("Search session has expired. Please resubmit your query.");
        } else {
            # The file is here, so we can open it.
            my $sessionH = Open(undef, "<$fileName");
            if (T(3)) {
                my $fileData = stat($sessionH);
                Trace($fileData->size . " bytes in $fileName.");
            }
            # Read the column headers.
            my @colHdrs = $shelp->ReadColumnHeaders($sessionH);
            if (T(3)) {
                Trace(scalar(@colHdrs) . " column headers found.");
                for (my $i = 0; $i <= $#colHdrs; $i++) {
                    my $col = $colHdrs[$i];
                    $col = "X=$col->{name}" if (ref $col eq 'HASH');
                    Trace("Column $i is $col.");
                }
            }
            # Compute the page navigation string.
            my $formFlag = ($cgi->param('NoForm') ? 0 : 1);
            my $pageNavigator = PageNavigator($shelp, $formFlag);
            # Now we need to find our page. The line number we compute will be
            # zero-based. We'll read from the session file until it drops to zero.
            # This may push us past end-of-file, but it won't cause an exception, and
            # it's something that should only happen very rarely in any case.
            my $linesToSkip = ($pageNum - 1) * $pageSize;
            Trace("Skipping $linesToSkip lines in session file $fileName.") if T(3);
            for (my $lines = $linesToSkip; $lines > 0; $lines--) {
                Tracer::GetLine($sessionH);
            }
            # The session file is now positioned at the beginning of our line.
            # We build the table rows one line at a time until we run out of data
            # or exceed the page size.
            my @tableRows = ();
            my $linesLeft = $pageSize;
            Trace("$linesLeft lines to read from session file.") if T(3);
            while ($linesLeft-- > 0) {
                Trace("Reading line from session file.") if T(3);
                my @cols = Tracer::GetLine($sessionH);
                if (! @cols) {
                    Trace("End of file read.") if T(3);
                    $linesLeft = 0;
                } else {
                    Trace("Line has " . scalar(@cols) . " columns. $linesLeft lines left.") if T(3);
                    # Peel off the first column. This is the ID of the result object. We don't use
                    # it, but other methods do.
                    shift @cols;
                    # Check the columns for run-time generation.
                    my @actual = $rhelp->GetRunTimeValues(@cols);
                    # Put the actual data into the table list.
                    push @tableRows, \@actual;
                }
            }
            # Start the list of links. The first one is the URL-save link.
            my $downloadScript = CGI::start_table({ border => "2" });
            if (! $cgi->param("NoForm")) {
                my $searchURL = $shelp->ComputeSearchURL();
                # This will only work if the URL is short enough.
                if (length $searchURL < 2048) {
                    $downloadScript .= CGI::Tr(CGI::td("URL to repeat this search (right-click to save)"),
                                               CGI::td({ style => 'text-align: center; font-weight: bold' },
                                                       CGI::a({ href => $searchURL }, "Repeat"))) . "\n";
                }
            }
            # The remaining links are disguised in buttons using this style string.
            my $buttonClass = "button button2";
            # Next is the optional download-to-seedviewer thing.
            if ($resultCount <= $FIG_Config::max_seedviewer_table) {
                my $sessionID = $shelp->ID();
                my $svURL = "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/SeedViewer?" .
                            "page=NmpdrGeneTable;SessionID=$sessionID;PageSize=$pageSize;" .
                            "Class=$shelperClass;ResultType=$rhelperClass";
                $downloadScript .= CGI::Tr(CGI::td("View these results in a [[FIG.InteractiveTable][sortable, expandable table]]"),
                                           CGI::td({ class => $buttonClass }, CGI::a({ href => $svURL }, "Table View"))) . "\n";
            }
            # Now compute the download links. This is actually a JavaScript thing, because we need to know
            # name of the user's operating system and handle fields inside the link text.
            my $downloadURL = StatusURL($cgi);
            my $dlType;
            # Ask the result helper which download types are supported.
            my %myDlTypes = $rhelp->DownloadFormatsAvailable();
            # First we display the links themselves.
            for $dlType (sort keys %myDlTypes) {
                my $dlDesc = $myDlTypes{$dlType};
                # Check the description for a data field.
                if ($dlDesc =~ /^([^\[]+)(\[[^\]]+\])(.+)/) {
                    my ($prefix, $data, $suffix) = ($1, $2, $3);
                    # We want to replace the data thing with a text field. First, we parse out the field name.
                    $data =~ /\[(\w+)\]/;
                    my ($fieldName) = ($1, $2);
                    # Generate the text field HTML.
                    my $textField = CGI::textfield(-name => $fieldName, -size => 5,
                                                    -onKeyUp => "updateAnchor('$dlType', '$fieldName', this.value)");
                    # Put it all together.
                    $dlDesc = "$prefix$textField$suffix";
                }
                $downloadScript .= CGI::Tr(CGI::td("$dlDesc"), CGI::td({ class => $buttonClass },
                                                                       CGI::a({ id => "dlLink$dlType" }, "Download"))) . "\n";
            }
            $downloadScript .=     CGI::end_table();
            # Now we create the javascript to fill the URLs into the link anchors. Each URL adds the download
            # type, operating system ID, and data-thing parameters to the link URL. We have one method that
            # initializes all the links, and another that updates a link when a parameter changes.
            $downloadScript     .= "<script type=\"text/javascript\">\n" .
                                   "  function setAnchors() {\n" .
                                   "    var sysType = checkOS();\n" .
                                   "    var linkAnchor;\n";
            for $dlType (keys %myDlTypes) {
                $downloadScript .= "    linkAnchor = document.getElementById('dlLink$dlType');\n" .
                                   "    linkAnchor.href = '$downloadURL;Download=$dlType;os=' + sysType;\n";
            }
            $downloadScript     .= "  };\n";
            # Now we've got the method for initializes all the links. The next one updates a link when its parameter
            # field changes.
            $downloadScript     .= "  function updateAnchor(dlType, name, value) {\n" .
                                   "    var sysType = checkOS();\n" .
                                   "    var linkAnchor;\n" .
                                   "    linkAnchor = document.getElementById('dlLink' + dlType);\n" .
                                   "    linkAnchor.href = '$downloadURL;Download=' + dlType + ';os=' + sysType + ';' + name + '=' + value;\n" .
                                   "  };\n" .
                                   "  setAnchors();\n" .
                                   "</script>";
            # Finally, a spacer to separate the table from the page navigator.
            $downloadScript     .= "<p>&nbsp;</p>\n";
            # Now we build the table. Create an array for the row styles.
            my @styles = ('even', 'odd');
            # Start the table.
            my @tableLines = (CGI::start_table({border => 0}));
            # Put in the column headers.
            push @tableLines, CGI::Tr({class => $styles[1]}, map { CGI::th({ class => $rhelp->ColumnStyle($_) },
                                                                             $rhelp->ColumnTitle($_)) } @colHdrs );
            # Start the first data row with the even style.
            my $styleMode = 0;
            # Loop through the rows.
            for my $row (@tableRows) {
                # We'll put the table cells in here.
                my @cells = ();
                # Loop through the cells in this row. We use a numeric index because we're moving through
                # the column headers list and the row list in parallel.
                for (my $i = 0; $i <= $#colHdrs; $i++) {
                    push @cells, CGI::td({class => $rhelp->ColumnStyle($colHdrs[$i]) }, $row->[$i]);
                }
                # Push this row into the result list.
                push @tableLines, CGI::Tr({class => $styles[$styleMode]}, @cells);
                # Flip the style.
                $styleMode = 1 - $styleMode;
            }
            # Close the table.
            push @tableLines, CGI::end_table();
            # Assemble the result.
            my $tableText = join("\n", @tableLines);
            # Finally, we compute the page label, which contains the page number, the number of results
            # displayed, and the total results found. If the total found is zero, we would not even be here,
            # so when we create our fancy English result count, we only have to worry about singular or
            # plural.
            my $resultCountLine;
            my $linesFound = scalar @tableRows;
            if ($resultCount == 1) {
                $resultCountLine = "One Result Found.";
            } elsif ($resultCount <= $linesFound) {
                $resultCountLine = "$resultCount Results Found";
            } else {
                $resultCountLine = "Search Results Page $pageNum: $linesFound of $resultCount Results Displayed.";
            }
            # Check for notices.
            my $noticeLines = "";
            my $noticeFileName = $shelp->GetTempFileName('notices');
            if (-s $noticeFileName) {
                # Read them in and format them into a bullet list.
                my @lines = Tracer::GetFile($noticeFileName);
                $noticeLines = CGI::h4('Notices') . CGI::ul(CGI::li(\@lines));
            }
            # Now we're ready. All the little pieces are put together. Note that
            # the page navigator appears twice.
            $retVal = join("\n",
                                 $title,
                                 $downloadScript,
                                 $noticeLines,
                                 $pageNavigator,
                                 CGI::p("&nbsp;"),
                                 CGI::h3($resultCountLine),
                                 $tableText,
                                 CGI::p("&nbsp;"),
                                 $pageNavigator,
                                 "");
        }
    }
    # Return the result.
    return $retVal;
}

=head3 PageNavigator

    my $htmlText = PageNavigator($shelp, $formFlag);

Return a page navigation string for the specified query.

=over 4

=item shelp

Search helper object for the current session.

=item formFlag

TRUE if a form has been displayed, else FALSE.

=item RETURN

Returns a page navigation string for the specified search operation. If a form
has been displayed, the navigation elements will include the complete form
information; otherwise they will only include position and status.

=back

=cut

sub PageNavigator {
    # Get the parameters.
    my ($shelp, $formFlag) = @_;
    # Get the CGI query object.
    my $cgi = $shelp->Q();
    # Extract the result parameters.
    my ($pageSize, $pageNum, $resultCount) = ($cgi->param('PageSize'),
                                              $cgi->param('Page'),
                                              $cgi->param('ResultCount'));
    # Declare the return variable.
    my $retVal = "";
    # Compute the number of the last page.
    my $lastPage = ceil($resultCount / $pageSize);
    # Only proceed if there's more than one page.
    if ($lastPage > 1) {
        # Create a URL without a page number. All the other URLs will be generated
        # from this one by appending the new page number.
        my $url = StatusURL($cgi, SessionID => $shelp->ID(), Page => undef);
        # Now compute the start and end pages for the display. We display ten pages,
        # with the current one more or less centered.
        my $startPage = $pageNum - 4;
        if ($startPage < 1) { $startPage = 1; }
        my $endPage = $startPage + 9;
        if ($endPage > $lastPage) { $endPage = $lastPage; }
        # Create a list of URL/page-number combinations.
        my @pageThings = ();
        for (my $linkPage = $startPage; $linkPage <= $endPage; $linkPage++) {
            # Check for the current page. It gets a page number with no link.
            if ($linkPage == $pageNum) {
                push @pageThings, $linkPage;
            } else {
                # This is not the current page, so it gets the full treatment.
                push @pageThings, PageThing($cgi, $linkPage, $linkPage, $url);
            }
        }
        # Now add some jump links at the end.
        my @forePointers = ();
        my $pg;
        if ($endPage < $lastPage) {
            for ($pg = $endPage + 5; $pg < $lastPage; $pg += 15) {
                push @forePointers, PageThing($cgi, $pg, $pg, $url);
            }
            push @forePointers, PageThing($cgi, ">>", $lastPage, $url);
        }
        # Finally, add some jump links at the front.
        my @backPointers = ();
        if ($startPage > 1) {
            for ($pg = $startPage - 5; $pg > 1; $pg -= 15) {
                unshift @backPointers, PageThing($cgi, $pg, $pg, $url);
            }
            unshift @backPointers, PageThing($cgi, "<<", 1, $url);
        }
        # Put it all together.
        my $middle = join(" ", @pageThings);
        $retVal = join " ... ", @backPointers, $middle, @forePointers;
    }
    # Return the result.
    return $retVal;
}

=head3 PageThing

    my $htmlText = PageThing($cgi, $pageLabel, $pageNumber, $url);

Create an entry for the page navigator. The entry consists of a label that
is hyperlinked to the specified page number of the search results.

=over 4

=item cgi

CGI object, used to access the CGI HTML-building methods.

=item pageLabel

Text to be hyperlinked. This is usually the page number, but sometimes it will be
arrows.

=item pageNumber

Number of the page to be presented when the link is followed.

=item url

Base URL for viewing a page.

=item RETURN

Returns HTML for the specified label, hyperlinked to the desired page.

=back

=cut

sub PageThing {
    # Get the parameters.
    my ($cgi, $pageLabel, $pageNumber, $url) = @_;
    # Compute the full URL.
    my $purl = "$url&Page=$pageNumber";
    # Form it into a hyperlink.
    my $retVal = "<a href=\"$purl\" title=\"Results page $pageNumber\">$pageLabel</a>";
    # Return the result.
    return $retVal;
}

=head3 StatusURL

    my $queryUrl = StatusURL($cgi, %overrides);

Create a URL for the current script containing status information for the search in progress.
The values in the incoming CGI object will be used for all parameters except the ones
specified as overrides. So, for example

    StatusURL($cgi, PageNum => 3)

would specify a page number of 3, but all the other parameters will be taken as is from
the CGI object. The complete list of session variables is given in the L</Session Data>
section.

=over 4

=item cgi

CGI query object containing the session variables.

=item overrides

A hash mapping key names to override values. These are used to override values in the
I<$cgi> parameter.

=item RETURN

Returns a relative URL for the current page with GET-style values for all the session
variables.

=back

=cut

sub StatusURL {
    # Get the parameters.
    my ($cgi, %overrides) = @_;
    # Create a hash of the session variables we want to keep.
    my %varHash;
    for my $varKey (@Keepers) {
        # Check for an override.
        if (exists $overrides{$varKey}) {
            my $override = $overrides{$varKey};
            # Use the override if it is not null or undefined.
            if (defined($override) && $override ne "") {
                $varHash{$varKey} = $override;
            }
        } else {
            # Check for a CGI value.
            my $normal = $cgi->param($varKey);
            # Use it if it exists.
            if (defined($normal)) {
                $varHash{$varKey} = $normal;
            }
        }
    }
    # Compute the full URL.
    my $retVal = Tracer::GenerateURL("$FIG_Config::cgi_url/SearchSkeleton.cgi", %varHash);
    # Return the result.
    return $retVal;
}

=head3 SaveSearchParms

    SaveSearchParms($cgi, $shelp);

Save the search parameters from the CGI object to a session file. The
session file will be in the temporary directory named by the session
ID with a suffix of C<.parms>.

=over 4

=item cgi

CGI object containing the parameters to save.

=item shelp

Currently-active search helper object (used to compute the file name).

=back

=cut

sub SaveSearchParms {
    # Get the parameters.
    my ($cgi, $shelp) = @_;
    # Get the name for the parameters file.
    my $parmFileName = $shelp->GetTempFileName('parms');
    # Create a hash of the parameters we don't want to keep.
    my %excludeParms = map { $_ => 1 } @Keepers;
    # Create a list to store the parameter lines.
    my @lines = ();
    # Loop through the parameters, writing them to the file in tab-delimited format.
    for my $parm ($cgi->param) {
        # Only proceed if this is NOT an excluded parm.
        if (! exists $excludeParms{$parm}) {
            # We output the parameters in tab-delimited format. The first field is the parameter
            # itself. The remaining fields are the values of the parameter. Normally there is
            # only one value, but quite a few of the search forms have at least one multi-valued
            # parameter. Note that we can have new-lines in a field, just not tabs.
            my @values = $cgi->param($parm);
            my $line = join("\t", $parm, @values);
            push @lines, $line;
        }
    }
    # Open the parameters file for output.
    my $oh = Open(undef, ">$parmFileName");
    # Because there are new-lines inside fields, we use a special marker to join the lines into
    # a result file.
    my $wholeFile = join("\n##\n", @lines);
    print $oh $wholeFile;
    # Close the output file.
    close $oh;
}

=head3 LoadSearchParms

    LoadSearchParms($cgi, $shelp);

Load the saved search parameters into the specified CGI object. This reads the search data
saved by L</SaveSearchParms>.

=over 4

=item cgi

CGI object into which the parameters will be stored.

=item shelp

Currently-active search helper object (used to compute the file name).

=back

=cut

sub LoadSearchParms {
    # Get the parameters.
    my ($cgi, $shelp) = @_;
    # Get the name for the parameters file.
    my $parmFileName = $shelp->GetTempFileName('parms');
    # Only proceed if the parameter file exists. If the file does not exist,
    # we assume all the parameter values are blank and do nothing.
    if (-f $parmFileName) {
        # Read the parameters file.
        my $wholeFile = Tracer::GetFile($parmFileName);
        # Split it into sections. The delimiter is ## surrounded by new-lines. We
        # can't use just plain \n because it might occur in the middle of a parameter
        # value.
        my @lines = split /\n##\n/, $wholeFile;
        # Loop through the lines.
        for my $line (@lines) {
            # Parse this line into fields.
            my ($parm, @fields) = split /\t/, $line;
            # Store them in the CGI object.
            $cgi->param($parm, @fields);
        }
    }
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3