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

View of /Sprout/SHBatchSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (as text) (annotate)
Mon Jan 19 21:56:19 2009 UTC (10 years, 9 months ago) by parrello
Branch: MAIN
CVS Tags: rast_rel_2009_02_05
Improved search result support.

#!/usr/bin/perl -w

package SHBatchSearch;

    use strict;
    use Tracer;
    use CGI qw(-nosticky);

    use RHFeatures;
    use base 'SearchHelper';

=head1 

=head2 Introduction

This search uploads a set of gene IDs from a sequential file and displays them
as search results. Everything in the file except quotes, commas, and whitespace
will be interpreted as a potential gene ID. The ID must either be a FIG ID or an
alias in the alias table.

This search has the following extra parameters.

=over 4

=item inFile

Sequential file to upload.

=back

=head2 Virtual Methods

=head3 Form

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

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

=cut

sub Form {
    # Get the parameters.
    my ($self) = @_;
    # Get the CGI and sprout objects.
    my $cgi = $self->Q();
    my $sprout = $self->DB();
    # Start the form.
    my $retVal = $self->FormStart("Batch Target Search");
    # Add a hidden field to turn off the form on the result pages.
    $retVal .= CGI::hidden(-name => 'NoForm', -value => 1);
    # Declare a variable to hold the table rows.
    my @rows = ();
    # Create a table cell containing the upload control and help text.
    my $uploader = join("<br />",
                        CGI::filefield(-name => 'inFile', -size => 50),
                        "Specify a text file containing %FIG{FIG IDs}% or %FIG{aliases}%.");
    # The first row is for the file to upload.
    push @rows, CGI::Tr(CGI::td("File to Upload"),
                        CGI::td({ colspan => 2 }, $uploader),
                       );
    # The other row is for the submit button.
    push @rows, $self->SubmitRow();
    # Create the table.
    $retVal .= $self->MakeTable(\@rows);
    # Close the form.
    $retVal .= $self->FormEnd();
    # Return the result.
    return $retVal;
}

=head3 Find

    my $resultCount = $shelp->Find();

Conduct a search based on the current CGI query parameters. The search results will
be written to the session cache file and the number of results will be
returned. If the search parameters are invalid, a result count of C<undef> will be
returned and a result message will be stored in this object describing the problem.

=cut

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;
    # Get the result helper.
    my $rhelp = RHFeatures->new($self);
    # Validate the filtering parameters.
    if ($rhelp->Valid()) {
        # Get the list of feature IDs from the input file. If the file
        # is missing or invalid, this method will set an error message
        # and return UNDEF.
        $self->PrintLine("Reading input file.<br />");
        my $ih = $cgi->upload('inFile');
        my $flist = $self->GetFeatureList($ih);
        if (defined $flist) {
            # Initialize the result counter.
            $retVal = 0;
            # Get the default columns.
            $self->DefaultColumns($rhelp);
            # Add aliases.
            $rhelp->AddOptionalColumn('alias');
            Trace("Column list is " . join(", ", @{$rhelp->GetColumnHeaders()})) if T(3);
            # Start the output session.
            $self->OpenSession($rhelp);
            $self->PrintLine("Processing feature list.<br />");
            for my $fid (@$flist) {
                # We'll put the features we find in here. We expect only one at
                # a time, but for some aliases there can be two or more.
                my @features;
                # Is this a FIG ID?
                if ($fid =~ /^fig\|/) {
                    # Yes, get the feature by ID.
                    @features = $sprout->GetList("Genome HasFeature Feature",
                                                 "Feature(id) = ?", [$fid]);
                } else {
                    # Here we have an alias.
                    @features = $sprout->GetList("Genome HasFeature Feature IsAliasOf",
                                                 "IsAliasOf(from-link) = ?", [$fid]);
                }
                # Compute the number of features found.
                my $features = scalar(@features);
                Trace("$features found for \"$fid\".") if T(3);
                if (! $features) {
                    # None, tell the user.
                    $self->SetNotice("No data found for \"$fid\".");
                } elsif ($features > 1) {
                    # Multiple is also worth a warning.
                    $self->SetNotice("$features genes found for ID \"$fid\".");
                }
                # Process the features found.
                for my $feature (@features) {
                    # Count this feature.
                    $retVal++;
                    # Get its ID.
                    my $realID = $feature->PrimaryValue('Feature(id)');
                    # Store it in the result set.
                    $rhelp->PutData($retVal, $realID, $feature);
                }
            }
            # Close the session file.
            $self->CloseSession();
            Trace("Session closed.") if T(3);
        }
    }
    # Return the result count.
    return $retVal;
}

=head3 SearchTitle

    my $titleHtml = $shelp->SearchTitle();

Return the display title for this search. The display title appears above the search results.
If no result is returned, no title will be displayed. The result should be an html string
that can be legally put inside a block tag such as C<h3> or C<p>.

=cut

sub SearchTitle {
    # Get the parameters.
    my ($self) = @_;
    # Compute the title.
    my $cgi = $self->Q();
    my $retVal = "Batch Upload Search Results.";
    # Return it.
    return $retVal;
}

=head3 Description

    my $htmlText = $shelp->Description();

Return a description of this search. The description is used for the table of contents
on the main search tools page. It may contain HTML, but it should be character-level,
not block-level, since the description is going to appear in a list.

=cut

sub Description {
    # Get the parameters.
    my ($self) = @_;
    # Return the result.
    return "Display %FIG{genes}% listed in a sequential file.";
}

=head2 Internal Methods

=head3 GetFeatureList

    my $flist = $self->GetFeatureList($ih);

Read a list of feature IDs from the specified input handle and return it
as a list reference. If the file handle or its contents is missing or
invalid, returns C<undef>.

=over 4

=item ih

An open file handle for the input file. The file will be treated as a set
of feature IDs (or aliases), with quotes, white space, and commas treated as
delimiters.

=item RETURN

Returns a reference to a list of the ID sequences from the file, or C<undef>
if the file was empty or invald.

=back

=cut

sub GetFeatureList {
    # Get the parameters.
    my ($self, $ih) = @_;
    # Declare the return variable.
    my $retVal;
    # Do we really have a file handle?
    if (! defined $ih) {
        $self->SetMessage("Please specify a file to upload.");
    } else {
        # We'll put our IDs in here.
        my @fids;
        # Protect from errors.
        eval {
            # Loop through the file.
            while (! eof $ih) {
                # Get this line.
                my $line = <$ih>;
                # Convert all delimiter sequences to spaces.
                $line =~ s/[\s"',\n]+/ /gs;
                # Split the line and remove empty entries.
                push @fids, grep { $_ } split / /, $line;
            }
            # Did we find anything?
            if (! @fids) {
                $self->SetMessage("No data found in file.");
            } else {
                # Yes, return it.
                $retVal = \@fids;
                $self->PrintLine(scalar(@fids) . " identifiers uploaded.");
            }
        };
        if ($@) {
            $self->SetMessage("Error processing input file: $@");
            undef $retVal;
        }
    }
    # Return the result.
    return $retVal;
}

1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3