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

Annotation of /Sprout/SHBatchSearch.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 SHBatchSearch;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use CGI qw(-nosticky);
8 :    
9 :     use RHFeatures;
10 :     use base 'SearchHelper';
11 :    
12 :     =head1
13 :    
14 :     =head2 Introduction
15 :    
16 :     This search uploads a set of gene IDs from a sequential file and displays them
17 :     as search results. Everything in the file except quotes, commas, and whitespace
18 :     will be interpreted as a potential gene ID. The ID must either be a FIG ID or an
19 :     alias in the alias table.
20 :    
21 :     This search has the following extra parameters.
22 :    
23 :     =over 4
24 :    
25 :     =item inFile
26 :    
27 :     Sequential file to upload.
28 :    
29 :     =back
30 :    
31 :     =head2 Virtual Methods
32 :    
33 :     =head3 Form
34 :    
35 :     my $html = $shelp->Form();
36 :    
37 :     Generate the HTML for a form to request a new search.
38 :    
39 :     =cut
40 :    
41 :     sub Form {
42 :     # Get the parameters.
43 :     my ($self) = @_;
44 :     # Get the CGI and sprout objects.
45 :     my $cgi = $self->Q();
46 :     my $sprout = $self->DB();
47 :     # Start the form.
48 :     my $retVal = $self->FormStart("Batch Target Search");
49 :     # Add a hidden field to turn off the form on the result pages.
50 :     $retVal .= CGI::hidden(-name => 'NoForm', -value => 1);
51 :     # Declare a variable to hold the table rows.
52 :     my @rows = ();
53 :     # Create a table cell containing the upload control and help text.
54 :     my $uploader = join("<br />",
55 :     CGI::filefield(-name => 'inFile', -size => 50),
56 :     "Specify a text file containing %FIG{FIG IDs}% or %FIG{aliases}%.");
57 :     # The first row is for the file to upload.
58 :     push @rows, CGI::Tr(CGI::td("File to Upload"),
59 :     CGI::td({ colspan => 2 }, $uploader),
60 :     );
61 :     # The other row is for the submit button.
62 :     push @rows, $self->SubmitRow();
63 :     # Create the table.
64 :     $retVal .= $self->MakeTable(\@rows);
65 :     # Close the form.
66 :     $retVal .= $self->FormEnd();
67 :     # Return the result.
68 :     return $retVal;
69 :     }
70 :    
71 :     =head3 Find
72 :    
73 :     my $resultCount = $shelp->Find();
74 :    
75 :     Conduct a search based on the current CGI query parameters. The search results will
76 :     be written to the session cache file and the number of results will be
77 :     returned. If the search parameters are invalid, a result count of C<undef> will be
78 :     returned and a result message will be stored in this object describing the problem.
79 :    
80 :     =cut
81 :    
82 :     sub Find {
83 :     my ($self) = @_;
84 :     # Get the CGI and Sprout objects.
85 :     my $cgi = $self->Q();
86 :     my $sprout = $self->DB();
87 :     # Declare the return variable. If it remains undefined, the caller will
88 :     # know that an error occurred.
89 :     my $retVal;
90 :     # Get the result helper.
91 :     my $rhelp = RHFeatures->new($self);
92 :     # Validate the filtering parameters.
93 :     if ($rhelp->Valid()) {
94 :     # Get the list of feature IDs from the input file. If the file
95 :     # is missing or invalid, this method will set an error message
96 :     # and return UNDEF.
97 :     $self->PrintLine("Reading input file.<br />");
98 :     my $ih = $cgi->upload('inFile');
99 :     my $flist = $self->GetFeatureList($ih);
100 :     if (defined $flist) {
101 :     # Initialize the result counter.
102 :     $retVal = 0;
103 :     # Get the default columns.
104 :     $self->DefaultColumns($rhelp);
105 :     # Add aliases.
106 :     $rhelp->AddOptionalColumn('alias');
107 :     Trace("Column list is " . join(", ", @{$rhelp->GetColumnHeaders()})) if T(3);
108 :     # Start the output session.
109 :     $self->OpenSession($rhelp);
110 :     $self->PrintLine("Processing feature list.<br />");
111 :     for my $fid (@$flist) {
112 :     # We'll put the features we find in here. We expect only one at
113 :     # a time, but for some aliases there can be two or more.
114 :     my @features;
115 :     # Is this a FIG ID?
116 :     if ($fid =~ /^fig\|/) {
117 :     # Yes, get the feature by ID.
118 :     @features = $sprout->GetList("Genome HasFeature Feature",
119 :     "Feature(id) = ?", [$fid]);
120 :     } else {
121 :     # Here we have an alias.
122 :     @features = $sprout->GetList("Genome HasFeature Feature IsAliasOf",
123 :     "IsAliasOf(from-link) = ?", [$fid]);
124 :     }
125 :     # Compute the number of features found.
126 :     my $features = scalar(@features);
127 :     Trace("$features found for \"$fid\".") if T(3);
128 :     if (! $features) {
129 :     # None, tell the user.
130 :     $self->SetNotice("No data found for \"$fid\".");
131 :     } elsif ($features > 1) {
132 :     # Multiple is also worth a warning.
133 :     $self->SetNotice("$features genes found for ID \"$fid\".");
134 :     }
135 :     # Process the features found.
136 :     for my $feature (@features) {
137 :     # Count this feature.
138 :     $retVal++;
139 :     # Get its ID.
140 :     my $realID = $feature->PrimaryValue('Feature(id)');
141 :     # Store it in the result set.
142 :     $rhelp->PutData($retVal, $realID, $feature);
143 :     }
144 :     }
145 :     # Close the session file.
146 :     $self->CloseSession();
147 :     Trace("Session closed.") if T(3);
148 :     }
149 :     }
150 :     # Return the result count.
151 :     return $retVal;
152 :     }
153 :    
154 :     =head3 SearchTitle
155 :    
156 :     my $titleHtml = $shelp->SearchTitle();
157 :    
158 :     Return the display title for this search. The display title appears above the search results.
159 :     If no result is returned, no title will be displayed. The result should be an html string
160 :     that can be legally put inside a block tag such as C<h3> or C<p>.
161 :    
162 :     =cut
163 :    
164 :     sub SearchTitle {
165 :     # Get the parameters.
166 :     my ($self) = @_;
167 :     # Compute the title.
168 :     my $cgi = $self->Q();
169 :     my $retVal = "Batch Upload Search Results.";
170 :     # Return it.
171 :     return $retVal;
172 :     }
173 :    
174 :     =head3 Description
175 :    
176 :     my $htmlText = $shelp->Description();
177 :    
178 :     Return a description of this search. The description is used for the table of contents
179 :     on the main search tools page. It may contain HTML, but it should be character-level,
180 :     not block-level, since the description is going to appear in a list.
181 :    
182 :     =cut
183 :    
184 :     sub Description {
185 :     # Get the parameters.
186 :     my ($self) = @_;
187 :     # Return the result.
188 :     return "Display %FIG{genes}% listed in a sequential file.";
189 :     }
190 :    
191 :     =head2 Internal Methods
192 :    
193 :     =head3 GetFeatureList
194 :    
195 :     my $flist = $self->GetFeatureList($ih);
196 :    
197 :     Read a list of feature IDs from the specified input handle and return it
198 :     as a list reference. If the file handle or its contents is missing or
199 :     invalid, returns C<undef>.
200 :    
201 :     =over 4
202 :    
203 :     =item ih
204 :    
205 :     An open file handle for the input file. The file will be treated as a set
206 :     of feature IDs (or aliases), with quotes, white space, and commas treated as
207 :     delimiters.
208 :    
209 :     =item RETURN
210 :    
211 :     Returns a reference to a list of the ID sequences from the file, or C<undef>
212 :     if the file was empty or invald.
213 :    
214 :     =back
215 :    
216 :     =cut
217 :    
218 :     sub GetFeatureList {
219 :     # Get the parameters.
220 :     my ($self, $ih) = @_;
221 :     # Declare the return variable.
222 :     my $retVal;
223 :     # Do we really have a file handle?
224 :     if (! defined $ih) {
225 :     $self->SetMessage("Please specify a file to upload.");
226 :     } else {
227 :     # We'll put our IDs in here.
228 :     my @fids;
229 :     # Protect from errors.
230 :     eval {
231 :     # Loop through the file.
232 :     while (! eof $ih) {
233 :     # Get this line.
234 :     my $line = <$ih>;
235 :     # Convert all delimiter sequences to spaces.
236 :     $line =~ s/[\s"',\n]+/ /gs;
237 :     # Split the line and remove empty entries.
238 :     push @fids, grep { $_ } split / /, $line;
239 :     }
240 :     # Did we find anything?
241 :     if (! @fids) {
242 :     $self->SetMessage("No data found in file.");
243 :     } else {
244 :     # Yes, return it.
245 :     $retVal = \@fids;
246 :     $self->PrintLine(scalar(@fids) . " identifiers uploaded.");
247 :     }
248 :     };
249 :     if ($@) {
250 :     $self->SetMessage("Error processing input file: $@");
251 :     undef $retVal;
252 :     }
253 :     }
254 :     # Return the result.
255 :     return $retVal;
256 :     }
257 :    
258 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3