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

Annotation of /Sprout/SHGeneBbhSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package SHGeneBbhSearch;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use CGI qw(-nosticky);
8 :     use Sprout;
9 :     use Stats;
10 :    
11 :     use RHFeatures;
12 :     use base 'SearchHelper';
13 :    
14 :     =head1
15 :    
16 :     =head2 Introduction
17 :    
18 :     This is a simple search that accepts as input a FIG ID or alias and lists all of
19 :     the bidirectional best hits for the indicated gene. Because some aliases
20 :     indicate multiple genes, the source gene is included in the result set.
21 :    
22 :     This search has the following extra parameters.
23 :    
24 :     =over 4
25 :    
26 :     =item gene_id
27 :    
28 :     FIG ID or alias for the gene of interest
29 :    
30 :     =back
31 :    
32 :     =head2 Virtual Methods
33 :    
34 :     =head3 Form
35 :    
36 :     my $html = $shelp->Form();
37 :    
38 :     Generate the HTML for a form to request a new search.
39 :    
40 :     =cut
41 :    
42 :     sub Form {
43 :     # Get the parameters.
44 :     my ($self) = @_;
45 :     # Get the CGI and sprout objects.
46 :     my $cgi = $self->Q();
47 :     my $sprout = $self->DB();
48 :     # Start the form.
49 :     my $retVal = $self->FormStart("Find Bidirectional Best Hits");
50 :     # Declare a variable to hold the table rows.
51 :     my @rows = ();
52 :     push @rows, CGI::Tr(CGI::td("%FIG{FIG ID}% or %FIG{alias}%"),
53 :     CGI::td({ colSpan => 2 },
54 :     CGI::textfield(-name => 'gene_id', -size => 30)));
55 :     # Get the display options for features.
56 :     push @rows, RHFeatures::FeatureFilterFormRows($self, 'options');
57 :     # The last row is for the submit button.
58 :     push @rows, $self->SubmitRow();
59 :     # Create the table.
60 :     $retVal .= $self->MakeTable(\@rows);
61 :     # Close the form.
62 :     $retVal .= $self->FormEnd();
63 :     # Return the result.
64 :     return $retVal;
65 :     }
66 :    
67 :     =head3 Find
68 :    
69 :     my $resultCount = $shelp->Find();
70 :    
71 :     Conduct a search based on the current CGI query parameters. The search results will
72 :     be written to the session cache file and the number of results will be
73 :     returned. If the search parameters are invalid, a result count of C<undef> will be
74 :     returned and a result message will be stored in this object describing the problem.
75 :    
76 :     =cut
77 :    
78 :     sub Find {
79 :     my ($self) = @_;
80 :     # Get the CGI and Sprout objects.
81 :     my $cgi = $self->Q();
82 :     my $sprout = $self->DB();
83 :     # Declare the return variable. If it remains undefined, the caller will
84 :     # know that an error occurred.
85 :     my $retVal;
86 :     # Get the result helper.
87 :     my $rhelp = RHFeatures->new($self);
88 :     # Validate the filtering parameters.
89 :     if ($rhelp->Valid()) {
90 :     # Get the search parameters.
91 :     my $gene_id = $cgi->param('gene_id');
92 :     # Get the default columns.
93 :     $self->DefaultColumns($rhelp);
94 :     Trace("Column list is " . join(", ", @{$rhelp->GetColumnHeaders()})) if T(3);
95 :     # Add the source gene and the score.
96 :     $rhelp->AddExtraColumn(queryGene => undef, title => 'Query Gene',
97 :     style => 'leftAlign', download => 'text');
98 :     $rhelp->AddExtraColumn(score => undef, title => 'Score',
99 :     style => 'left', download => 'num');
100 :     # Start the output session.
101 :     $self->OpenSession($rhelp);
102 :     # Find the genes for the specified ID. If it's a FIG ID, this is easy;
103 :     # otherwise, we have to get an alias.
104 :     my $input_id = $cgi->param('gene_id');
105 :     if (! $input_id) {
106 :     $self->SetMessage("Please specify a valid ID.");
107 :     } else {
108 :     # We have an ID. We'll put its list of aliases in here.
109 :     my @queryGenes;
110 :     if ($input_id =~ /^fig|/) {
111 :     # It's a FIG ID. if it exists, we want to keep it.
112 :     if ($sprout->Exists(Feature => $input_id)) {
113 :     push @queryGenes, $input_id;
114 :     }
115 :     } else {
116 :     # Look for aliases.
117 :     push @queryGenes, $sprout->GetFlat('IsAliasOf',
118 :     "IsAliasOf(from-link) = ?",
119 :     [$input_id],
120 :     'to-link');
121 :     }
122 :     Trace("Query gene list is " . join(", ", @queryGenes) . ".") if T(3);
123 :     # If we don't have anything, the ID is not found.
124 :     if (! @queryGenes) {
125 :     $self->SetMessage("The ID \"$input_id\" was not found in our database.");
126 :     } else {
127 :     # Initialize the result counter.
128 :     $retVal = 0;
129 :     # We're finally ready to search. Loop through the IDs.
130 :     for my $queryGene (@queryGenes) {
131 :     $self->PrintLine("Locating BBHs of $queryGene.<br />");
132 :     Trace("Processing $queryGene.") if T(3);
133 :     # Get this feature's BBHs.
134 :     my $bbhList = FIGRules::BBHData($queryGene);
135 :     # Loop through the results.
136 :     $self->PrintLine(scalar(@$bbhList) . " hits found.<br />");
137 :     for my $bbh (@$bbhList) {
138 :     # Get the data.
139 :     my ($hit, $score) = @$bbh;
140 :     Trace("Hit found at $hit.") if T(3);
141 :     # Only proceed if this BBH exists in our database.
142 :     my $record = $sprout->GetEntity(Feature => $hit);
143 :     if (defined $record) {
144 :     Trace("Hit confirmed in Sprout.") if T(3);
145 :     # Compute the sort key.
146 :     my $sortKey = $rhelp->SortKey($record);
147 :     # Store the extra columns.
148 :     $rhelp->PutExtraColumns(queryGene => $queryGene,
149 :     score => $score);
150 :     # Put the data into the output.
151 :     $rhelp->PutData($sortKey, $hit, $record);
152 :     # Count it.
153 :     $retVal++;
154 :     }
155 :     }
156 :     }
157 :     }
158 :     }
159 :     # Close the session file.
160 :     $self->CloseSession();
161 :     Trace("Session closed.") if T(3);
162 :     }
163 :     # Return the result count.
164 :     return $retVal;
165 :     }
166 :    
167 :     =head3 SearchTitle
168 :    
169 :     my $titleHtml = $shelp->SearchTitle();
170 :    
171 :     Return the display title for this search. The display title appears above the search results.
172 :     If no result is returned, no title will be displayed. The result should be an html string
173 :     that can be legally put inside a block tag such as C<h3> or C<p>.
174 :    
175 :     =cut
176 :    
177 :     sub SearchTitle {
178 :     # Get the parameters.
179 :     my ($self) = @_;
180 :     # Compute the title.
181 :     my $cgi = $self->Q();
182 :     # Get a safe copy of the input value.
183 :     my $input = CGI::escapeHTML($cgi->param('gene_id') || "Unknown Gene");
184 :     # Generate the title.
185 :     my $retVal = "Bidirectional Best Hits for $input.";
186 :     # Return it.
187 :     return $retVal;
188 :     }
189 :    
190 :     =head3 Description
191 :    
192 :     my $htmlText = $shelp->Description();
193 :    
194 :     Return a description of this search. The description is used for the table of contents
195 :     on the main search tools page. It may contain HTML, but it should be character-level,
196 :     not block-level, since the description is going to appear in a list.
197 :    
198 :     =cut
199 :    
200 :     sub Description {
201 :     # Get the parameters.
202 :     my ($self) = @_;
203 :     # Return the result.
204 :     return "Display the %FIG{bidirectional best hits}% of a specified %FIG{gene}%.";
205 :     }
206 :    
207 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3