[Bio] / FigWebServices / SearchSkeleton.cgi Repository:
ViewVC logotype

View of /FigWebServices/SearchSkeleton.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.21 - (download) (annotate)
Thu Apr 19 00:03:37 2007 UTC (12 years, 11 months ago) by parrello
Branch: MAIN
Changes since 1.20: +1 -0 lines
Added support for operon search.

#!/usr/bin/perl -w

use strict;
use Tracer;
use CGI;
use Sprout;
use SearchHelper;
use POSIX qw(ceil);
use File::stat;

# Add USE statements for new search helpers below.
use SHFidSearch;
use SHBlastSearch;
use SHSigGenes;
use SHWordSearch;
use SHPropSearch;
use SHDrugSearch;
use SHSubSearch;
use SHOpSearch;

=head1 NMPDR Search Skeleton

This script 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>. To allow for additional search types, you need
merely implement a new subclass of B<SearchHelper> and add it
to the C<use> list below. By convention, all search helper
subclasses begin with the letters C<SH>. 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 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 ShowURL

If specified, then a URL for repeating the search will be shown as a hyperlink on the
results page.

=item ShowAliases

If specified, then hyperlinked aliases will be shown for each feature.

=item FavoredAlias

If specified, then feature aliases beginning with the indicated string are shown in
the FASTA download; otherwise, the FIG ID is used.

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

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

It is presumed that the cache file is small, containing no more than a few thousand
lines of data. If this is not the case, an entirely different strategy will be
needed for displaying search results.

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 Page PageSize Class SPROUT Download FavoredAlias);
# Global variable containing the supported download types. If you add a new type here,
# you must also update L</DownloadDataLine> to support the new type.
my %DownloadTypes = (tbl   => 'as a tab-delimited file',
                     fasta =>  'in FASTA format',
                    );

my ($cgi, $varHash) = ScriptSetup();
# If this 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;
eval {
    # Get the search class.
    my $class = $cgi->param("Class");
    # Check for advanced mode.
    if ($cgi->param("Alternate")) {
        Trace("Advanced mode selected.") if T(3);
        # In advanced mode, we list all the search forms listed 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 = GetHelper($cgi, $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. Note we include the query fields so that any
        # tracing parameters are preserved.
        my $selfURL = $cgi->url(-relative => 1, -query => 1);
        # Append a question mark or semicolon to the URL, depending on whether or not
        # there's already a question mark present.
        $selfURL .= ($selfURL =~ /\?/ ? ';' : '?');
        # Loop through the search classes building a table of contents.
        my @contents = ();
        for my $className (SearchHelper::AdvancedClassList()) {
            Trace("Processing $className") if T(3);
            my $shelp = GetHelper($cgi, $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") .
                    $cgi->ul($cgi->li(\@contents));
        # 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);
        # Here we have a class, so we're working with a single type of search.
        $shelp = GetHelper($cgi, $class);
        # Tell the template what the class is.
        $varHash->{class} = $class;
        # 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);
            # 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, $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 below. The form can actually appear after the results, however, thanks to the
                # template.
                my $formShown = ! $cgi->param("NoForm");
                if ($formShown) {
                    Trace("Displaying form.") if T(3);
                    $varHash->{form} = $shelp->Form();
                }
                if (! $shelp->IsNew()) {
                    # We have results 
                    $varHash->{results} = "";
                    # If the form was shown, display the search URL.
                    if ($formShown) {
                        my $searchURL = $shelp->ComputeSearchURL();
                        $varHash->{results} .= $cgi->p("<a href=\"$searchURL\">Right-click to save a URL for this search</a>");
                    }
                    $varHash->{results} .= DisplayResults($shelp, $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;
                # If there are no results and the form was shown, add the help text. We are
                # assuming that if the user got the search to work, he doesn't need help.
                # In addition, if the form was not shown, a description of how to use it
                # makes no sense.
                if (! $result_count && $formShown) {
                    $varHash->{helptext} = $shelp->GetHelpText();
                }
            }
        } 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);
            # 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 => '../NMPDR.css' }
                                  );
            # Print the animated banner.
            print "<object classid=\"clsid:d27cdb6e-ae6d-11cf-96b8-444553540000\" \n";
            print "  codebase=\"http://fpdownload.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0\" \n";
            print "  width=\"980\" height=\"85\" id=\"NMPDRBanner\" align=\"middle\">\n";
            print "<param name=\"allowScriptAccess\" value=\"sameDomain\" />\n";
            print "<param name=\"movie\" value=\"../images/banners/NMPDRBanner.swf\" />\n";
            print "<param name=\"quality\" value=\"high\" /><param name=\"bgcolor\" value=\"#ffffff\" />\n";
            print "<embed src=\"../images/banners/NMPDRBanner.swf\" quality=\"high\" bgcolor=\"#ffffff\" width=\"980\"\n"; 
            print "  height=\"85\" name=\"NMPDRBanner\" align=\"middle\" allowScriptAccess=\"sameDomain\" \n";
            print "  type=\"application/x-shockwave-flash\" pluginspage=\"http://www.macromedia.com/go/getflashplayer\" />\n";
            print "</object>\n";
            # Tell the user the type of this search.
            print $cgi->h2($shelp->Description()) . "\n";
            # Print a spacer to get the data out to the user faster.
            print "\n<!-- " . ("a" x 1000) . " -->\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";
            # Save the search parameters so we can display them on the result pages.
            Trace("Saving search parameters.") if T(3);
            SaveSearchParms($cgi, $shelp);
            # 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 ($@) {
    my $errorMessage = $@;
    # Trace the error.
    Trace("Script Error: $errorMessage") if T(0);
    # Store the HTML version of the error message.
    $varHash->{results} = $cgi->h3("Script Error: $errorMessage");
    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") {
        print "\n\n*** ERROR: $errorMessage\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. Print the CGI header.
    print $cgi->header();
    # Produce the output using the template.
    ScriptFinish("SproutSearch_tmpl.php", $varHash);
}

=head3 DownloadResults

C<< DownloadResults($dlType, $shelp, $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

Relevant search 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, $cgi) = @_;
    # Get the operating system type.
    my $osType = $cgi->param('os');
    # Compute the appropriate EOL marker based on the web user's OS. Unfortunately,
    # for Mac used download files are always treated as binary.
    my $eol;
    if ($osType eq 'Windows') {
        $eol = "\r\n";
    } elsif ($osType eq 'MacIntosh') {
        $eol = "\r";
    } else {
        $eol = "\r\n";
    }
    # Compute a file name.
    my $defaultName = $cgi->param('Class') . ".$dlType";
    # 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);
    # Check the state of the session file.
    my $fileName = $shelp->GetCacheFileName();
    if (! -e $fileName) {
        Confess("Search session has expired. Please resubmit your query.");
    } else {
        # 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 = Tracer::GetLine($sessionH);
        # Get a map of which columns to keep. This is an array and not a hash because the key is
        # the column position.
        my @keepCols = map { $shelp->FeatureColumnDownload($_) } @colHdrs;
        Trace("Keep-column data is " . join(", ", map { "$colHdrs[$_] = $keepCols[$_]" } 0..$#colHdrs) . ".") if T(3);
        # Now loop through the lines in the file, converting them to output text.
        while (! eof $sessionH) {
            # Get the current line of columns.
            Trace("Reading line from session file.") if T(3);
            my @cols = Tracer::GetLine($sessionH);
            # Extract the object ID.
            my $objectID = shift @cols;
            # Call the DownloadDataLine method to produce the file data.
            DownloadDataLine($shelp, $objectID, $dlType, $eol, \@cols, \@colHdrs)
        }
    }
}

=head3 DownloadDataLine

C<< DownloadDataLine($shelp, $objectID, $dlType, $eol, \@cols, \@colHdrs); >>

Write a line of download data to the target output. The exact data written
depends on the download type. In addition, each line may be more than
one physical line of text.

=over 4

=item shelp

Currently-active search helper object.

=item objectID

ID of the object whose data is in this line of results.

=item dlType

The type of download (e.g. C<tbl>, C<fasta>).

=item eol

The end-of-line character to use.

=item cols

A reference to a list of the data columns.

=item colHdrs

A reference to a list of the column headers. Each header describes the data found
in the corresponding column of the I<cols> list.

=back

=cut

sub DownloadDataLine {
    # Get the parameters.
    my ($shelp, $objectID, $dlType, $eol, $cols, $colHdrs) = @_;
    # Check the download type.
    if ($dlType eq 'tbl') {
        # Here we are downloading the displayed columns as a tab-delimited file. The first task is
        # to get a map of which columns to keep. This is an array and not a hash because the key is
        # the column position. For each column position, $keepCols[$i] will be 1 of the column is
        # to be kept and 0 otherwise.
        my @keepCols = map { $shelp->FeatureColumnDownload($_) } @{$colHdrs};
        # Remove the columns that are not being kept.
        my @actualCols = ();
        for (my $i = 0; $i <= $#keepCols; $i++) {
            if ($keepCols[$i]) {
                push @actualCols, $cols->[$i];
            }
        }
        # Check the columns for run-time generation and clean out the HTML.
        my @actual = map { HtmlCleanup(substr($_,0,2) eq "%%" ? $shelp->GetRunTimeValue($_) : $_) } @actualCols;
        # Write the data to the output.
        Tracer::PutLine(\*STDOUT, \@actual, $eol);
    } elsif ($dlType eq 'fasta') {
        # Here we are downloading the objects found in FASTA format. Currently, the objects must be features
        # for this to work. Start by getting the FASTA thing.
        my $fastaLines = $shelp->ComputeFASTA(dna => $objectID);
        # Break it into lines.
        my @lines = split /\n/, $fastaLines;
        # Output the lines using the standard EOL marker. Note we ignore blank lines.
        for my $line (@lines) {
            if ($line =~ /\S/) {
                print "$line$eol";
            }
        }
    }
}

=head3 DisplayResults

C<< my $htmlText = DisplayResults($shelp, $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 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, $cgi) = @_;
    # Declare the return variable.
    my $retVal;
    # Extract the result parameters.
    my ($pageSize, $pageNum, $resultCount) = ($cgi->param('PageSize'),
                                              $cgi->param('Page'),
                                              $cgi->param('ResultCount'));
    # 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 and convert them to column titles.
            my @colHdrs = map { $shelp->FeatureColumnTitle($_) } Tracer::GetLine($sessionH);
            # 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 = map { substr($_,0,2) eq "%%" ? $shelp->GetRunTimeValue($_) : $_ } @cols;
                    # Put the actual data into the table list.
                    push @tableRows, \@actual;
                }
            }
            # Now compute the download links. This is actually a JavaScript thing, because we need to know
            # name of the user's operating system.
            my $downloadURL = StatusURL($cgi);
            my $dlType;
            # First we display the links themselves.
            my $downloadScript =   "<ul>\n";
            for $dlType (sort keys %DownloadTypes) {
                my $dlDesc = $DownloadTypes{$dlType};
                $downloadScript .= "<li><a id=\"dlLink$dlType\">Click here to download these results $dlDesc.</a></li>\n";
            }
            $downloadScript .=     "</ul>";
            # Now we create the javascript to fill the URLs into the link anchors. Each URL adds the download
            # type and operating system ID to the link URL.
            $downloadScript     .= "<script type=\"text/javascript\">\n" .
                                   "  var sysType = checkOS();\n" .
                                   "  var linkAnchor;\n";
            for $dlType (sort keys %DownloadTypes) {
                $downloadScript .= "  linkAnchor = document.getElementById('dlLink$dlType');\n" .
                                   "  linkAnchor.href = '$downloadURL;Download=$dlType;os=' + sysType;\n";
            }
            $downloadScript     .= "</script>";
            # 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.";
            }
            # Now we're ready. We do a the results counter, a page navigator, a spacer, the table, a spacer,
            # and another page navigator.
            $retVal = join("\n",
                                 $downloadScript,
                                 $pageNavigator,
                                 $cgi->p("&nbsp;"),
                                 $cgi->h3($resultCountLine),
                                 PageBuilder::MakeFancyTable($cgi, \@colHdrs, \@tableRows),
                                 $cgi->p("&nbsp;"),
                                 $pageNavigator,
                                 "");
        }
    } 
    # Return the result.
    return $retVal;
}

=head3 PageNavigator

C<< 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;
        if ($formFlag) {
            $url = $shelp->ComputeSearchURL(PageSize => $pageSize, ResultCount => $resultCount,
                                            Search => undef, 'Search.x' => undef,
                                            'Search.y' => undef, SessionID => $shelp->ID());
        } else {
            $url = StatusURL($cgi, 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

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

C<< 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($cgi->url(-relative => 1), %varHash);
    # Return the result.
    return $retVal;
}

=head3 GetHelper

C<< my $shelp = GetHelper($className); >>

Return a helper object with the given class name. If no such class exists, an
error will be thrown.

=over 4

=item cgi

Active CGI query object.

=item className

Class name for the search helper object, without the preceding C<SH>. This is
identical to what the script expects for the C<Class> parameter.

=item RETURN

Returns a search helper object for the specified class.

=back

=cut

sub GetHelper {
    # Get the parameters.
    my ($cgi, $className) = @_;
    # Try to create the search helper.
    my $retVal = eval("SH$className->new(\$cgi)");
    if (! defined $retVal) {
        Confess("Could not find a search handler of type $className.");
    }
    # Return the result.
    return $retVal;
}

=head3 SaveSearchParms

C<< 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;
    # Open the parameters file for output.
    my $oh = Open(undef, ">$parmFileName");
    # 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.
            Tracer::PutLine($oh, [$parm, $cgi->param($parm)]);
        }
    }
    # Close the output file.
    close $oh;
}

=head3 LoadSearchParms

C<< 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) = @_;
    # Only proceed if this is an old session. A new session won't have saved parameters.
    if (! $shelp->IsNew()) {
        # Get the name for the parameters file.
        my $parmFileName = $shelp->GetTempFileName('parms');
        # Only proceed if this is an old  file exists. If the file does not exist,
        # we assume all the parameter values are blank and do nothing.
        if (-f $parmFileName) {
            # Open the parameters file for input.
            my $ih = Open(undef, "<$parmFileName");
            while (! eof $ih) {
                # Get the current line of file data.
                my @fields = Tracer::GetLine($ih);
                # Get the parameter name.
                my $parm = shift @fields;
                # Store the parameter value.
                $cgi->param($parm, @fields);
            }
            # Close the input file.
            close $ih;
        }
    }
}

=head3 HtmlCleanup

C<< my $text = HtmlCleanup($htmlText); >>

Take a string of Html text and clean it up so it appears as real text.
Note that this method is not yet sophisticated enough to detect right-angle brackets
inside tag parameters, nor can it handle style or script tags. This is a dirt simple
method that suffices for search result processing.

=over 4

=item htmlText

Html text to clean up. All of the tags will be removed, leaving only the bare text.

=item RETURN

Returns the bare text of the Html string, without any of the Html tags.

=back

=cut

sub HtmlCleanup {
    # Get the parameters.
    my ($htmlText) = @_;
    # Declare the return variable.
    my $retVal = $htmlText;
    # Convert new-lines to spaces.
    $retVal =~ tr/\n/ /s;
    # Delete any tags. This is a simplistic algorithm that will fail if there is a right angle bracket inside a parameter
    # string.
    $retVal =~ s/<[^>]+>//g;
    # Unescape the & tags.
    $retVal = CGI::unescapeHTML($retVal);
    # Return the result.
    return $retVal;
}



1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3