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

Annotation of /FigWebServices/SearchSkeleton.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     BEGIN {
4 :     # Print the HTML header.
5 :     print "CONTENT-TYPE: text/html\n\n";
6 :     }
7 :    
8 :     =head1 NMPDR Search Skeleton
9 :    
10 :     This script executes a search and displays the results. If, on entry,
11 :     it sees a session ID, then it will assume search results have been
12 :     cached and the cached results are to be displayed. Otherwise, it
13 :     will perform the search, cache the results, and display the first
14 :     page. The search itself is performed by an object that subclasses
15 :     B<SearchHelper>. To allow for additional search types, you need
16 :     merely implement a new subclass of B<SearchHelper> and add it
17 :     to the C<use> list below. By convention, all search helper
18 :     subclasses begin with the letters C<SH>. This is not consistent
19 :     with normal PERL practice, but it fits better into the way we
20 :     do builds.
21 :    
22 :     =head2 Session Data
23 :    
24 :     The following parameters are expected from the CGI query object.
25 :     Additional parameters may be required by whichever B<SearchHelper>
26 :     subclass is selected. By convention, the parameters required by
27 :     the subclasses will be lower-case and the parameters used by this
28 :     script are capital-case. Note that some parameters are only required
29 :     by old sessions, that is, sessions which are established with
30 :     existing search result cache files.
31 :    
32 :     =over 4
33 :    
34 :     =item Trace
35 :    
36 :     Trace level and list of trace modules to turn on, space-delimited.
37 :    
38 :     =item NoForm
39 :    
40 :     If specified, then no search form will be generated.
41 :    
42 :     =item SessionID
43 :    
44 :     Unique session ID for this user. This is used to generate the name of the user's
45 :     cache file in the temporary directory. The actual filename will be
46 :     C<tmp_>I<SessionID>C<.cache>.
47 :    
48 :     =item Page (old only)
49 :    
50 :     Number of the current page to display.
51 :    
52 :     =item PageSize
53 :    
54 :     Number of items per page.
55 :    
56 :     =item ResultCount (old only)
57 :    
58 :     Total number of search result lines.
59 :    
60 :     =item Class
61 :    
62 :     Name of the B<SearchHelper> subclass for this type of search. The name does not include
63 :     the C<SH> prefix. So, to specify a B<SHFidSearch> type of
64 :     search, you would specify a class of C<FidSearch>. If this parameter is omitted,
65 :     then all of the advanced search forms will be displayed.
66 :    
67 :     =back
68 :    
69 :     =head2 The Cache File
70 :    
71 :     The cache file is a tab-delimited file. The first line of the file contains the
72 :     column names and the remaining lines contain the data for each result item.
73 :    
74 :     The column contents may contain HTML tags, including hyperlinks and buttons. For best
75 :     results, all links should be relative.
76 :    
77 :     It is presumed that the cache file is small, containing no more than a few thousand
78 :     lines of data. If this is not the case, an entirely different strategy will be
79 :     needed for displaying search results.
80 :    
81 :     If the cache file is empty or has only a single line, a stock "No Search Results"
82 :     message will be displayed.
83 :    
84 :     =cut
85 :    
86 :     use strict;
87 :     use Tracer;
88 :     use CGI;
89 :     use Sprout;
90 :     use SearchHelper;
91 :     use SHFidSearch;
92 :     use SHBlastSearch;
93 :     use SHSigGenes;
94 :     use POSIX qw(ceil);
95 :    
96 :     # This next list specifies all of the search classes to be used in the advanced
97 :     # search form.
98 :     my @advancedClasses = qw(FidSearch BlastSearch SigGenes);
99 :    
100 :     my ($cgi, $varHash) = ScriptSetup();
101 :     eval {
102 :     # Get the search class.
103 :     my $class = $cgi->param("Class");
104 :     if (! $class) {
105 : parrello 1.2 Trace("Producing index of search tools.") if T(3);
106 :     # No class specified, so we simply generate an index of the
107 :     # searches. First, make sure the template knows there are no search results.
108 : parrello 1.1 $varHash->{result_count} = 0;
109 : parrello 1.2 Trace("Building URL.") if T(3);
110 :     # Get a copy of our URL. Note we include the query fields so that any
111 :     # tracing parameters are preserved.
112 :     my $selfURL = $cgi->url(-relative => 1, -query => 1);
113 :     # Append a question mark or ampersand to the URL, depending on whether or not
114 :     # there's already a question mark present.
115 :     $selfURL .= ($selfURL =~ /\?/ ? '&' : '?');
116 :     # Loop through the search classes building a table of contents.
117 : parrello 1.1 my @contents = ();
118 :     for my $className (@advancedClasses) {
119 : parrello 1.2 Trace("Processing $className") if T(3);
120 : parrello 1.1 my $shelp = GetHelper($cgi, $className);
121 : parrello 1.2 push @contents, "<a href=\"${selfURL}Class=$className\">$className</a>: " . $shelp->Description();
122 : parrello 1.1 }
123 :     # Create the table of contents.
124 : parrello 1.2 Trace("Building index.") if T(3);
125 :     my $index = $cgi->h3("Index of Search Tools") .
126 : parrello 1.1 $cgi->ul($cgi->li(\@contents));
127 : parrello 1.2 # Store it as the form.
128 :     $varHash->{form} = $index;
129 :     # Tell the template we don't have a class.
130 :     $varHash->{class} = "";
131 :     Trace("Index built.") if T(3);
132 : parrello 1.1 } else {
133 : parrello 1.2 Trace("Class $class detected.") if T(3);
134 : parrello 1.1 # Here we have a class, so we're working with a single type of search.
135 :     my $shelp = GetHelper($cgi, $class);
136 : parrello 1.2 # Tell the template what the class is.
137 :     $varHash->{class} = $class;
138 : parrello 1.1 # Display the form, if desired.
139 :     if (! $cgi->param("NoForm")) {
140 :     $varHash->{form} = $shelp->Form();
141 :     }
142 :     # Now there are three different directions we can go. If a
143 :     # "Search" button has been pressed, then we need to perform a
144 :     # search. If this is a new session and the button has not
145 :     # been pressed, we do nothing. If this is an old session
146 :     # and the button has not been pressed, we display results. Note
147 :     # that we allow for regular buttons (Search) or image buttons
148 :     # (Search.x).
149 :     if (!$cgi->param("Search") && !$cgi->param("Search.x")) {
150 :     # No button, so check for results. If this is a new session, we do
151 :     # nothing. The form is displayed and nothing else need be done.
152 :     # Otherwise, we going into display-results mode.
153 :     Trace("No search requested.") if T(3);
154 :     if (! $shelp->IsNew()) {
155 :     $varHash->{results} = DisplayResults($shelp, $cgi);
156 :     }
157 :     } else {
158 :     # Here we have a button press, so we need to find stuff and
159 :     # then display it. First, we set the result count to 0 for
160 :     # future reference.
161 :     Trace("Performing the search.") if T(3);
162 :     $cgi->param(-name => "ResultCount", -value => 0);
163 :     my $result_count = $shelp->Find();
164 :     # Check to see what kind of results we got.
165 : parrello 1.2 if (! defined($result_count)) {
166 : parrello 1.1 # Here an error occurred, so we display the error message.
167 :     $varHash->{results} = $cgi->h3("ERROR: " . $shelp->Message());
168 :     } elsif ($result_count == 0) {
169 :     # Here nothing matched.
170 :     $varHash->{results} = $cgi->h3("No match found.");
171 :     } else {
172 :     # Here we have results. Save the result count and set up to display
173 :     # the first page of results.
174 :     $cgi->param(-name => "ResultCount", -value => $result_count);
175 :     $cgi->param(-name => "Page", -value => 1);
176 :     # Start with a message about how many matches we found.
177 :     my $countText = ($result_count == 1 ? "One match" : "$result_count matches");
178 :     $varHash->{results} = $cgi->h3("$countText found.");
179 :     # Append the page display.
180 :     $varHash->{results} .= DisplayResults($shelp, $cgi);
181 :     }
182 :     }
183 :     # Save the result count so that the results helper text appears if it
184 :     # is needed. This text is in the template, but it's protected by a TMPL_IF
185 :     # on "result_count".
186 :     $varHash->{result_count} = $cgi->param("ResultCount");
187 :     }
188 :     };
189 :     if ($@) {
190 :     my $errorMessage = $@;
191 :     Trace("Script Error: $errorMessage") if T(0);
192 :     $varHash->{results} = $cgi->h3("Script Error: $errorMessage");
193 :     }
194 :     ScriptFinish("SproutSearch_tmpl.php", $varHash);
195 :    
196 :     =head3 DisplayResults
197 :    
198 :     C<< my $htmlText = DisplayResults($shelp, $cgi); >>
199 :    
200 :     Display the results of a search. A page of results will be displayed, along with links to get to
201 :     other pages. The HTML for the results display is returned.
202 :    
203 :     =over 4
204 :    
205 :     =item shelp
206 :    
207 :     Search helper object representing the search. The column headers and search rows will be
208 :     stored in the session file attached to it.
209 :    
210 :     =item cgi
211 :    
212 :     CGI query object for the current session. This includes the page number, size, and result
213 :     counts.
214 :    
215 :     =item RETURN
216 :    
217 :     Returns the HTML text for displaying the current page of search results.
218 :    
219 :     =back
220 :    
221 :     =cut
222 :    
223 :     sub DisplayResults {
224 :     # Get the parameters.
225 :     my ($shelp, $cgi) = @_;
226 :     # Declare the return variable.
227 :     my $retVal;
228 :     # Extract the result parameters.
229 :     my ($pageSize, $pageNum, $resultCount) = ($cgi->param('PageSize'),
230 :     $cgi->param('Page'),
231 :     $cgi->param('ResultCount'));
232 :     # Only proceed if there are actual results.
233 :     if ($resultCount <= 0) {
234 :     $retVal = $cgi->h3("No matches found.");
235 :     } else {
236 :     # Check the state of the session file.
237 :     my $fileName = $shelp->GetCacheFileName();
238 :     if (! -e $fileName) {
239 :     $retVal = $cgi->h3("Search session has expired. Please resubmit your query.");
240 :     } else {
241 :     # The file is here, so we can open it.
242 :     my $sessionH = Open(undef, "<$fileName");
243 :     # Read the column headers.
244 :     my @colHdrs = Tracer::GetLine($sessionH);
245 :     # Compute the page navigation string.
246 :     my $pageNavigator = PageNavigator($cgi);
247 :     # Now we need to find our page. The line number we compute will be
248 :     # zero-based. We'll read from the session file until it drops to zero.
249 :     # This may push us past end-of-file, but it won't cause an exception, and
250 :     # it's something that should only happen very rarely in any case.
251 :     for (my $lines = ($pageNum - 1) * $pageSize; $lines > 0; $lines--) {
252 :     Tracer::GetLine($sessionH);
253 :     }
254 :     # The session file is now positioned at the beginning of our line.
255 :     # We build the table rows one line at a time until we run out of data
256 :     # or exceed the page size.
257 :     my @tableRows = ();
258 :     my $linesLeft = $pageSize;
259 :     while ($linesLeft-- > 0 && (my @cols = Tracer::GetLine($sessionH))) {
260 :     push @tableRows, \@cols;
261 :     }
262 :     # Now we're ready. We do a page navigator, a spacer, the table, a spacer,
263 :     # and another page navigator.
264 :     $retVal = join("\n", $pageNavigator,
265 :     $cgi->p("&nbsp;"),
266 :     HTML::make_table(\@colHdrs, \@tableRows, "Search Results Page $pageNum"),
267 :     $cgi->p("&nbsp;"),
268 :     $pageNavigator,
269 :     "");
270 :     }
271 :     }
272 :     # Return the result.
273 :     return $retVal;
274 :     }
275 :    
276 :     =head3 PageNavigator
277 :    
278 :     C<< my $htmlText = PageNavigator($cgi); >>
279 :    
280 :     Return a page navigation string for the specified query.
281 :    
282 :     =over 4
283 :    
284 :     =item cgi
285 :    
286 :     CGI query object for the current session. The key values are described in the
287 :     introduction to this document.
288 :    
289 :     =back
290 :    
291 :     =cut
292 :    
293 :     sub PageNavigator {
294 :     # Get the parameters.
295 :     my ($cgi) = @_;
296 :     # Extract the result parameters.
297 :     my ($pageSize, $pageNum, $resultCount) = ($cgi->param('PageSize'),
298 :     $cgi->param('Page'),
299 :     $cgi->param('ResultCount'));
300 :     # Create a URL without a page number. All the other URLs will be generated
301 :     # from this one by appending the new page number.
302 :     my $url = StatusURL($cgi, Page => undef);
303 :     # Compute the number of the last page.
304 :     my $lastPage = ceil($resultCount / $pageSize);
305 :     # Now compute the start and end pages for the display. We display ten pages,
306 :     # with the current one more or less centered.
307 :     my $startPage = $pageNum - 4;
308 :     if ($startPage < 1) { $startPage = 1; }
309 :     my $endPage = $startPage + 9;
310 :     if ($endPage > $lastPage) { $endPage = $lastPage; }
311 :     # Create a list of URL/page-number combinations.
312 :     my @pageThings = ();
313 :     for (my $linkPage = $startPage; $linkPage <= $endPage; $linkPage++) {
314 :     # Check for the current page. It gets a page number with no link.
315 :     if ($linkPage == $pageNum) {
316 :     push @pageThings, $linkPage;
317 :     } else {
318 :     # This is not the current page, so it gets the full treatment.
319 :     push @pageThings, PageThing($cgi, $linkPage, $linkPage, $url);
320 :     }
321 :     }
322 :     # Add the forward and back pointers.
323 :     my $backPointer = ($startPage <= 1 ? "<<" : PageThing($cgi, "<<", $startPage - 1, $url));
324 :     my $forePointer = ($endPage >= $lastPage ? ">>" : PageThing($cgi, ">>", $endPage + 1, $url));
325 :     # Put it all together.
326 :     my $retVal = join(" ", $backPointer, @pageThings, $forePointer);
327 :     # Return the result.
328 :     return $retVal;
329 :     }
330 :    
331 :     =head3 PageThing
332 :    
333 :     C<< my $htmlText = PageThing($cgi, $pageLabel, $pageNumber, $url); >>
334 :    
335 :     Create an entry for the page navigator. The entry consists of a label that
336 :     is hyperlinked to the specified page number of the search results.
337 :    
338 :     =over 4
339 :    
340 :     =item cgi
341 :    
342 :     CGI object, used to access the CGI HTML-building methods.
343 :    
344 :     =item pageLabel
345 :    
346 :     Text to be hyperlinked. This is usually the page number, but sometimes it will be
347 :     arrows.
348 :    
349 :     =item pageNumber
350 :    
351 :     Number of the page to be presented when the link is followed.
352 :    
353 :     =item url
354 :    
355 :     Base URL for viewing a page.
356 :    
357 :     =item RETURN
358 :    
359 :     Returns HTML for the specified label, hyperlinked to the desired page.
360 :    
361 :     =back
362 :    
363 :     =cut
364 :    
365 :     sub PageThing {
366 :     # Get the parameters.
367 :     my ($cgi, $pageLabel, $pageNumber, $url) = @_;
368 :     # Compute the full URL.
369 :     my $purl = "$url&Page=$pageNumber";
370 :     # Form it into a hyperlink.
371 :     my $retVal = "<a href=\"$purl\" title=\"Results page $pageNumber\">$pageLabel</a>";
372 :     # Return the result.
373 :     return $retVal;
374 :     }
375 :    
376 :     =head3 StatusURL
377 :    
378 :     C<< my $queryUrl = StatusURL($cgi, %overrides); >>
379 :    
380 :     Create a URL for the current script containing status information for the search in progress.
381 :     The values in the incoming CGI object will be used for all parameters except the ones
382 :     specified as overrides. So, for example
383 :    
384 :     StatusURL($cgi, PageNum => 3)
385 :    
386 :     would specify a page number of 3, but all the other parameters will be taken as is from
387 :     the CGI object. The complete list of session variables is given in the L</Session Data>
388 :     section.
389 :    
390 :     =over 4
391 :    
392 :     =item cgi
393 :    
394 :     CGI query object containing the session variables.
395 :    
396 :     =item overrides
397 :    
398 :     A hash mapping key names to override values. These are used to override values in the
399 :     I<$cgi> parameter.
400 :    
401 :     =item RETURN
402 :    
403 :     Returns a relative URL for the current page with GET-style values for all the session
404 :     variables.
405 :    
406 :     =back
407 :    
408 :     =cut
409 :    
410 :     sub StatusURL {
411 :     # Get the parameters.
412 :     my ($cgi, %overrides) = @_;
413 :     # Create a hash of the session variables we want to keep.
414 :     my %varHash;
415 :     for my $varKey (qw(SessionID Trace NoForm ResultCount Page PageSize Class SPROUT)) {
416 :     # Check for an override.
417 :     if (exists $overrides{$varKey}) {
418 :     my $override = $overrides{$varKey};
419 :     # Use the override if it is not null or undefined.
420 :     if (defined($override) && $override ne "") {
421 :     $varHash{$varKey} = $override;
422 :     }
423 :     } else {
424 :     # Check for a CGI value.
425 :     my $normal = $cgi->param($varKey);
426 :     # Use it if it exists.
427 :     if (defined($normal)) {
428 :     $varHash{$varKey} = $normal;
429 :     }
430 :     }
431 :     }
432 :     # Compute the full URL.
433 :     my $retVal = Tracer::GenerateURL($cgi->url(-relative => 1), %varHash);
434 :     # Return the result.
435 :     return $retVal;
436 :     }
437 :    
438 :     =head3 GetHelper
439 :    
440 :     C<< my $shelp = GetHelper($className); >>
441 :    
442 :     Return a helper object with the given class name. If no such class exists, an
443 :     error will be thrown.
444 :    
445 :     =over 4
446 :    
447 :     =item cgi
448 :    
449 :     Active CGI query object.
450 :    
451 :     =item className
452 :    
453 :     Class name for the search helper object, without the preceding C<SH>. This is
454 :     identical to what the script expects for the C<Class> parameter.
455 :    
456 :     =item RETURN
457 :    
458 :     Returns a search helper object for the specified class.
459 :    
460 :     =back
461 :    
462 :     =cut
463 :    
464 :     sub GetHelper {
465 :     # Get the parameters.
466 :     my ($cgi, $className) = @_;
467 :     # Try to create the search helper.
468 :     my $retVal = eval("SH$className->new(\$cgi)");
469 :     if (! defined $retVal) {
470 :     Confess("Could not find a search handler of type $className.");
471 :     }
472 :     # Return the result.
473 :     return $retVal;
474 :     }
475 :    
476 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3