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

Annotation of /Sprout/SearchSkeleton.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 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :     package SearchSkeleton;
20 :    
21 :     use strict;
22 :     use Tracer;
23 :     use CGI;
24 :     use Sprout;
25 :     use SearchHelper;
26 :     use POSIX qw(ceil);
27 :     use File::stat;
28 :     use FIGRules;
29 :     use TWiki::Func;
30 :     use HTML::Template;
31 :    
32 :     =head1 NMPDR Search Skeleton
33 :    
34 :     This package executes a search and displays the results. If, on entry,
35 :     it sees a session ID, then it will assume search results have been
36 :     cached and the cached results are to be displayed. Otherwise, it
37 :     will perform the search, cache the results, and display the first
38 :     page. The search itself is performed by an object that subclasses
39 :     B<SearchHelper>. The results are formatted by an object that
40 :     subclasses C<ResultHelper>.To allow for additional search types, you need
41 :     merely implement a new subclass of B<SearchHelper> and possibly a
42 :     new subclass of B<ResultHelper>. By convention, all search helper
43 :     subclasses begin with the letters C<SH> and all result helper
44 :     subclasses begin with the letters C<RH>. This is not consistent
45 :     with normal PERL practice, but it fits better into the way we
46 :     do builds.
47 :    
48 :     =head2 Session Data
49 :    
50 :     The following parameters are expected from the CGI query object.
51 :     Additional parameters may be required by whichever B<SearchHelper>
52 :     subclass is selected. By convention, the parameters required by
53 :     the subclasses will be lower-case and the parameters used by this
54 :     script are capital-case. Note that some parameters are only required
55 :     by old sessions, that is, sessions which are established with
56 :     existing search result cache files.
57 :    
58 :     =over 4
59 :    
60 :     =item Trace
61 :    
62 :     Trace level and list of trace modules to turn on, space-delimited.
63 :    
64 :     =item NoForm
65 :    
66 :     If specified, then no search form will be generated.
67 :    
68 :     =item SessionID
69 :    
70 :     Unique session ID for this user. This is used to generate the name of the user's
71 :     cache file in the temporary directory. The actual filename will be
72 :     C<tmp_>I<SessionID>C<.cache>.
73 :    
74 :     =item Page (old only)
75 :    
76 :     Number of the current page to display.
77 :    
78 :     =item PageSize
79 :    
80 :     Number of items per page.
81 :    
82 :     =item ResultCount (old only)
83 :    
84 :     Total number of search result lines.
85 :    
86 :     =item ResultType (old only)
87 :    
88 :     Type of result displayed.
89 :    
90 :     =item Class
91 :    
92 :     Name of the B<SearchHelper> subclass for this type of search. The name does not include
93 :     the C<SH> prefix. So, to specify a B<SHFidSearch> type of
94 :     search, you would specify a class of C<FidSearch>. If this parameter is omitted,
95 :     then all of the advanced search forms will be displayed.
96 :    
97 :     =item Alternate
98 :    
99 :     If specified, then a list of advanced search forms will be shown.
100 :    
101 :     =item Download
102 :    
103 :     If specified, then the table of search results will be downloaded. The value
104 :     indicates the download format. Currently, C<tbl> will download the search results
105 :     in a tab-delimited file, and C<fasta> will download the search results as a
106 :     FASTA file.
107 :    
108 :     =item DownloadItem
109 :    
110 :     If specified, then only the item specified will be downloaded rather than
111 :     all of the search results. At some point this will be a list-type thing so
112 :     the user can download more than one item.
113 :    
114 :     =back
115 :    
116 :     =head2 The Cache File
117 :    
118 :     The cache file is a tab-delimited file. The first line of the file contains the
119 :     column names and the remaining lines contain the data for each result item.
120 :    
121 :     The column contents may contain HTML tags, including hyperlinks and buttons. For best
122 :     results, all links should be relative.
123 :    
124 :     Some columns will consist of a doubled percent sign followed by a name, an equal sign,
125 :     and some text. This tells the display code to call the B<RunTimeColumns> method of
126 :     the B<SearchHelper> object to compute the column value. This facility is designed for
127 :     columns that require a lot of time to calculate, so we don't want to calculate them
128 :     until we absolutely have to display them.
129 :    
130 :     If the cache file is empty or has only a single line, a stock "No Search Results"
131 :     message will be displayed.
132 :    
133 :     =cut
134 :    
135 :     # Global variable containing the names of the parameters that get stored in the status URL.
136 :     my @Keepers = qw(SessionID Trace NoForm ResultCount ResultType Page PageSize Class SPROUT Download FavoredAlias);
137 :     # Map of old class names to new class names.
138 :     my %ClassMap = (BlastSearch => 'ToolSearch', FidSearch => 'GeneSearch');
139 :     # List of searches we want to hide from users. This will go away when we've fixed up the wiki.
140 :     my %Hidden = (PropSearch => 1);
141 :    
142 :     =head3 Package Methods
143 :    
144 :     =head3 main
145 :    
146 :     SearchSkeleton::main($cgi, $session, $varHash);
147 :    
148 :     Process a search request. This method will analyze the CGI parameters and
149 :     write output directly to the user's browser.
150 :    
151 :     =over 4
152 :    
153 :     =item cgi
154 :    
155 :     CGI query object to use for accessing the search parameters.
156 :    
157 :     =item session
158 :    
159 :     TWiki session object.
160 :    
161 :     =item varHash
162 :    
163 :     Hash to use for computing screen data to display.
164 :    
165 :     =back
166 :    
167 :     =cut
168 :    
169 :     sub main {
170 :     # Get the parameters.
171 :     my ($cgi, $session, $varHash) = @_;
172 :     # Turn on emergency tracing.
173 :     ETracing($cgi);
174 :     # If this next variable is set to Download, then a download is in progress and the output
175 :     # is saved to the user's hard drive. If it's set to "Search", then a search is in
176 :     # progress and we don't produce the template at the end.
177 :     my $mode = "Display";
178 :     # If search mode is 1, the search helper will be in here.
179 :     my $shelp;
180 :     # If there are results, the results helper will be in here.
181 :     my $rhelp;
182 :     eval {
183 :     # Get the search class.
184 :     my $class = $cgi->param("Class");
185 :     # Get the result type (if any).
186 :     my $resultType = $cgi->param("ResultType");
187 :     # Check for advanced mode.
188 :     if ($cgi->param("Alternate")) {
189 :     Trace("Advanced mode selected.") if T(3);
190 :     # In advanced mode, we list all the search forms listed in
191 :     # $FIG_Config::advanced_class.
192 :     my @classes = split(/\s+/, $FIG_Config::advanced_class);
193 :     # Set the page size to the default.
194 :     $cgi->param(-name => 'PageSize', -value => $FIG_Config::results_per_page);
195 :     # Tell the template we have no search results and no class.
196 :     $varHash->{result_count} = 0;
197 :     $varHash->{class} = "";
198 :     # Loop through the classes, creating the table of contents and
199 :     # the forms.
200 :     $varHash->{formIndex} = $cgi->h3("Contents") . $cgi->start_ul();
201 :     for my $className (@classes) {
202 :     my $shelp = SearchHelper::GetHelper($cgi, SH => $className);
203 :     # Produce the contents entry.
204 :     $varHash->{formIndex} .= $cgi->li($cgi->a({href => "#X$className"}, $className) .
205 :     ": " . $shelp->Description());
206 :     # Produce the bookmark.
207 :     $varHash->{form} .= $cgi->a({ name => "X$className" });
208 :     # Produce the form.
209 :     $varHash->{form} .= $shelp->Form();
210 :     # Produce the help text.
211 :     $varHash->{form} .= $shelp->GetHelpText();
212 :     # Put some space between us and whatever comes next.
213 :     $varHash->{form} .= "<p>&nbsp;</p>";
214 :     }
215 :     # Check the number of classes.
216 :     if (@classes < 2) {
217 :     # Only one class, so we don't need the table of contents.
218 :     $varHash->{formIndex} = "";
219 :     } else {
220 :     # Multiple classes, so close the table of contents.
221 :     $varHash->{formIndex} .= $cgi->end_ul();
222 :     }
223 :     } elsif (! $class) {
224 :     Trace("Producing index of search tools.") if T(3);
225 :     # No class specified, so we simply generate an index of the
226 :     # searches. First, make sure the template knows there are no search results.
227 :     $varHash->{result_count} = 0;
228 :     Trace("Building URL.") if T(3);
229 :     # Get a copy of our URL and append a question mark.
230 :     my $selfURL = "$FIG_Config::cgi_url/SearchSkeleton.cgi?";
231 :     # Loop through the search classes building a table of contents.
232 :     my @contents = ();
233 :     for my $className (SearchHelper::AdvancedClassList()) {
234 :     if ($Hidden{$className}) {
235 :     Trace("Skipping hidden class $className.") if T(3);
236 :     } else {
237 :     Trace("Processing $className") if T(3);
238 :     my $shelp = SearchHelper::GetHelper($cgi, SH => $className);
239 :     push @contents, "<a href=\"${selfURL}Class=$className\">$className</a>: " . $shelp->Description();
240 :     }
241 :     }
242 :     # Create the table of contents.
243 :     Trace("Building index.") if T(3);
244 :     my $index = $cgi->h3("Index of Search Tools") .
245 :     $cgi->ul($cgi->li(\@contents));
246 :     # Store it as the results.
247 :     $varHash->{results} = $index;
248 :     # Tell the template we don't have a class.
249 :     $varHash->{class} = "";
250 :     Trace("Index built.") if T(3);
251 :     } else {
252 :     Trace("Class $class detected.") if T(3);
253 :     # If this class has had its name changed, use the new name.
254 :     if (exists $ClassMap{$class}) {
255 :     $class = $ClassMap{$class};
256 :     $cgi->param(Class => $class);
257 :     Trace("New class name is $class.") if T(3);
258 :     }
259 :     # Here we have a class, so we're working with a single type of search.
260 :     $shelp = SearchHelper::GetHelper($cgi, SH => $class);
261 :     # Tell the template what the class is.
262 :     $varHash->{class} = $class;
263 :     # Insure we have a page size.
264 :     if (! $cgi->param("PageSize")) {
265 :     $cgi->param(-name => 'PageSize', -value => $FIG_Config::results_per_page);
266 :     }
267 :     # Declare the result count variable.
268 :     my $result_count = 0;
269 :     # Now there are three different directions we can go. If a
270 :     # "Search" button has been pressed, then we need to perform a
271 :     # search. If this is a new session and the button has not
272 :     # been pressed, we do nothing. If this is an old session
273 :     # and the button has not been pressed, we display results. Note
274 :     # that we allow for regular buttons (Search) or image buttons
275 :     # (Search.x).
276 :     if (!$cgi->param("Search") && !$cgi->param("Search.x")) {
277 :     # No button, so check for results. Note we only do this if this is not
278 :     # a new session. A new session won't have results.
279 :     Trace("No search requested.") if T(3);
280 :     # Check for a result type.
281 :     if (defined $resultType) {
282 :     # Get the object that controls the result type.
283 :     $rhelp = SearchHelper::GetHelper($shelp, RH => $resultType);
284 :     }
285 :     # Get the result count, which should have been set when we did the search. If
286 :     # we did no search, it won't be set, so in that case we want to make it zero.
287 :     $result_count = $cgi->param("ResultCount") || 0;
288 :     # Get the download type (if any).
289 :     my $dlType = $cgi->param("Download") | "";
290 :     # Check for a Download request.
291 :     if ($dlType) {
292 :     # Here we're downloading.
293 :     $mode = "Download";
294 :     # Download the results.
295 :     DownloadResults($dlType, $shelp, $rhelp, $cgi);
296 :     } else {
297 :     # If we have a saved search, load its parameters so they show up in the form.
298 :     LoadSearchParms($cgi, $shelp);
299 :     # Display the form, if desired. This absolutely must happen before we do the ShowURL
300 :     # thing when we display the results. The form can actually appear after the results,
301 :     # however, thanks to the template.
302 :     my $formShown = ! $cgi->param("NoForm");
303 :     if (! $cgi->param("NoForm")) {
304 :     Trace("Displaying form.") if T(3);
305 :     $varHash->{form} = $shelp->Form();
306 :     }
307 :     if (! $shelp->IsNew()) {
308 :     # We have results
309 :     $varHash->{results} = DisplayResults($shelp, $rhelp, $cgi);
310 :     }
311 :     # Save the result count so that the results helper text appears if it
312 :     # is needed. This text is in the template, but it's protected by a TMPL_IF
313 :     # on "result_count".
314 :     $varHash->{result_count} = $result_count;
315 :     }
316 :     } else {
317 :     # Here we have a button press, so we need to find stuff. In this case the
318 :     # template is not used. Instead, status is displayed while we search, and
319 :     # then a JavaScript trick is used to switch the user to the first page of
320 :     # results. This prevents the server from giving up if the search takes a long
321 :     # time.
322 :     Trace("Performing the search.") if T(3);
323 :     # Denote we're in searching mode. This means we'll be displaying the HTML as we go along.
324 :     $mode = "Searching";
325 :     # Make sure the output is unbuffered.
326 :     $| = 1;
327 :     # Start the HTML page.
328 :     print $cgi->header();
329 :     print $cgi->start_html(-title => 'NMPDR Search in Progress',
330 :     -style => { src => "$FIG_Config::cgi_url/wiki/pub/Main/TWikiPreferences/NmpdrStyleOverrides.css" }
331 :     );
332 :     # Print the banner.
333 :     print $cgi->img({ src => "$FIG_Config::cgi_url/wiki/pub/Main/TWikiPreferences/banner2.png" });
334 :     # Tell the user the type of this search.
335 :     print $cgi->h2($shelp->Description()) . "\n";
336 :     # Start a paragraph.
337 :     print "<p>\n";
338 :     # Perform the search.
339 :     Trace("Calling FIND method.") if T(3);
340 :     $result_count = $shelp->Find();
341 :     Trace("Processing results.") if T(3);
342 :     # End the paragraph.
343 :     print "</p>\n";
344 :     # Save the search parameters so we can display them on the result pages.
345 :     Trace("Saving search parameters.") if T(3);
346 :     SaveSearchParms($cgi, $shelp);
347 :     # Check to see what kind of results we got.
348 :     if (! defined($result_count)) {
349 :     # Here an error occurred, so we display the error message.
350 :     $shelp->PrintLine($cgi->h3("ERROR: " . $shelp->Message()));
351 :     $result_count = 0;
352 :     $shelp->PrintLine($cgi->p("Use your browser's BACK button to try again."));
353 :     } else {
354 :     # Here we have results (even though there may be zero of them. Save
355 :     # the result count and set up to display the first page of results.
356 :     $cgi->param(-name => "ResultCount", -value => $result_count);
357 :     $cgi->param(-name => "Page", -value => 1);
358 :     # Now we create the URL for the first page of results.
359 :     my $page1Url = StatusURL($cgi);
360 :     # Create the Javascript thingie to pull up the results.
361 :     $shelp->PrintLine('<script type="text/javascript">');
362 :     $shelp->PrintLine(" location.href = \"$page1Url\";");
363 :     $shelp->PrintLine('</script>');
364 :     }
365 :     }
366 :     }
367 :     };
368 :     if ($@) {
369 :     my $errorMessage = $@;
370 :     # Trace the error.
371 :     Trace("Script Error: $errorMessage") if T(0);
372 :     # Store the HTML version of the error message.
373 :     $varHash->{results} = $cgi->h3("Script Error: $errorMessage");
374 :     if ($mode eq "Searching") {
375 :     # Here we've already started the page, so we output the error message immediately.
376 :     $shelp->PrintLine($varHash->{results});
377 :     } elsif ($mode eq "Download") {
378 :     print "\n\n*** ERROR: $errorMessage\n";
379 :     }
380 :     }
381 :     if ($mode eq "Searching") {
382 :     # We've already started the page, so all we have to do is terminate it.
383 :     $shelp->PrintLine($cgi->end_html());
384 :     } elsif ($mode eq "Display") {
385 :     # Here there's been no output. Print the CGI header.
386 :     print $cgi->header();
387 :     # Produce the output using a template.
388 :     print MyPage($varHash);
389 :     }
390 :     }
391 :    
392 :     =head3 MyPage
393 :    
394 :     my $html = MyPage($varHash);
395 :    
396 :     Output a search form or result page. The incoming hash contains
397 :     parameters that are plugged into a template.
398 :    
399 :     =over 4
400 :    
401 :     =item varHash
402 :    
403 :     Hash containing the variable data to be placed on the page.
404 :    
405 :     =item RETURN
406 :    
407 :     Returns the page HTML to display.
408 :    
409 :     =back
410 :    
411 :     The variables in the hash should be as follows.
412 :    
413 :     =over 4
414 :    
415 :     =item result_count
416 :    
417 :     Number of search results.
418 :    
419 :     =item results
420 :    
421 :     Table displaying the search results.
422 :    
423 :     =item formIndex
424 :    
425 :     If multiple search forms are displayed, this should contain the table of contents.
426 :    
427 :     =item form
428 :    
429 :     Search form.
430 :    
431 :     =item tracing
432 :    
433 :     Debugging output.
434 :    
435 :     =back
436 :    
437 :     =cut
438 :    
439 :     sub MyPage {
440 :     # Get the parameters.
441 :     my ($varHash) = @_;
442 :     # Compute the page title.
443 :     my $resultsFound = $varHash->{result_count};
444 :     my $title = ($resultsFound ? 'SearchResults' : 'SearchPage');
445 :     # Get the text template. This is an HTML template, not a TWiki template.
446 :     my $htmlTemplate = TWiki::Func::readAttachment('Main', 'TWikiPreferences', 'Search.tmpl');
447 :     my $templateObject = HTML::Template->new(scalarref => \$htmlTemplate,
448 :     die_on_bad_params => 0);
449 :     # Next, we pass in the variable values.
450 :     for my $varKey (keys %{$varHash}) {
451 :     # Get the variable value.
452 :     my $varValue = $varHash->{$varKey};
453 :     # Check for an undefined value.
454 :     if (! defined($varValue)) {
455 :     # Treat it as a null string.
456 :     $templateObject->param($varKey => "");
457 :     } else {
458 :     # Check for an array of scalars. We convert this into a string
459 :     # for compatibility with earlier stuff. An array of hashes is
460 :     # okay, because it's used for loops.
461 :     if (ref $varValue eq 'ARRAY') {
462 :     if (scalar @{$varValue} > 0 && ! ref $varValue->[0]) {
463 :     $varValue = join("\n", @{$varValue});
464 :     }
465 :     }
466 :     # Record the parameter.
467 :     Trace("Variable $varKey has value \"$varValue\".") if T(3);
468 :     $templateObject->param($varKey => $varValue);
469 :     }
470 :     }
471 :     # Finally, we produce the text.
472 :     my $text = $templateObject->output();
473 :     # Get the view template. This IS a TWiki template.
474 :     my $template = TWiki::Func::loadTemplate('view');
475 :     # Set the meta-variable values.
476 :     $template =~ s/%TEXT%/$text/g;
477 :     $template =~ s/%REVTITLE%//g;
478 :     Trace("Template string is:\n$template") if T(3);
479 :     # Expand it.
480 :     my $raw = TWiki::Func::expandCommonVariables($template, $title, 'Main');
481 :     # Render it into HTML.
482 :     my $retVal = TWiki::Func::renderText($raw, 'Main');
483 :     # Clean the nops.
484 :     $retVal =~ s/<nop>//g;
485 :     # Return the result.
486 :     return $retVal;
487 :     }
488 :    
489 :    
490 :     =head3 DownloadResults
491 :    
492 :     DownloadResults($dlType, $shelp, $rhelp, $cgi);
493 :    
494 :     Download the search results as a text file. We use a content-disposition header to create
495 :     output that will be saved automatically to the user's hard drive.
496 :    
497 :     =over 4
498 :    
499 :     =item dlType
500 :    
501 :     Download type (e.g. C<tbl>, C<fasta>).
502 :    
503 :     =item shelp
504 :    
505 :     Actice search helper.
506 :    
507 :     =item rhelp
508 :    
509 :     Relevant result helper. This is used to retrieve and process the results.
510 :    
511 :     =item cgi
512 :    
513 :     CGI query object used to format the output.
514 :    
515 :     =back
516 :    
517 :     =cut
518 :    
519 :     sub DownloadResults {
520 :     # Get the parameters.
521 :     my ($dlType, $shelp, $rhelp, $cgi) = @_;
522 :     # Get the operating system type.
523 :     my $osType = $cgi->param('os');
524 :     # Compute the appropriate EOL marker based on the web user's OS. Unfortunately,
525 :     # on the Mac download files are always treated as binary, and in all environments,
526 :     # FireFox doesn't display the download dialog correctly unless it's binary.
527 :     my $eol = FIGRules::ComputeEol($osType);
528 :     # Compute a file name.
529 :     my $defaultName = $cgi->param('Class') . ".$dlType";
530 :     # Check the state of the session file.
531 :     my $fileName = $shelp->GetCacheFileName();
532 :     if (! -e $fileName) {
533 :     Confess("Search session has expired. Please resubmit your query.");
534 :     } else {
535 :     # Write the CGI header.
536 :     print $cgi->header(-type => 'application/octet-stream',
537 :     -attachment => $defaultName);
538 :     # Put us in binary mode so that the output doesn't do screwy stuff with new-lines.
539 :     binmode(STDOUT);
540 :     # The session file is here, so we can open it.
541 :     my $sessionH = Open(undef, "<$fileName");
542 :     if (T(3)) {
543 :     my $fileData = stat($sessionH);
544 :     Trace($fileData->size . " bytes in $fileName.");
545 :     }
546 :     # Read the column headers.
547 :     my @colHdrs = $shelp->ReadColumnHeaders($sessionH);
548 :     # Get the list of items to keep. If the list is empty, we keep everything. The idea here is that the user
549 :     # might have the option to select certain rows to be downloaded. The rows are identified by the row key,
550 :     # which is the first column in each row.
551 :     my %keepers = map { $_ => 1 } $cgi->param('DownloadItem');
552 :     # Here we get the number of lines to be downloaded. If we're not downloading everything,
553 :     # we'll decrement this number each time we download a kept item, and stop when it hits zero.
554 :     my $selections = scalar(keys %keepers);
555 :     my $selective = ($selections > 0);
556 :     # Download the header.
557 :     Trace("Downloading header. " . scalar(@colHdrs) . " columns present.") if T(3);
558 :     my @lines = $rhelp->DownloadDataLine(undef, $dlType, 'header', \@colHdrs);
559 :     DownloadLines($eol, @lines);
560 :     Trace("Downloading data lines.") if T(3);
561 :     # Now loop through the lines in the file, converting them to output text.
562 :     while (! eof $sessionH && (! $selective || $selections > 0)) {
563 :     # Get the current line of columns.
564 :     Trace("Reading line from session file.") if T(3);
565 :     my @cols = Tracer::GetLine($sessionH);
566 :     # Extract the object ID, which is the first column of the results.
567 :     my $objectID = shift @cols;
568 :     # Test to see if we're keeping this line.
569 :     if (! $selective || $keepers{$objectID}) {
570 :     # If so, we download it. Decrement the selection counter.
571 :     $selections--;
572 :     # Call the DownloadDataLine method to produce the lines of data to write.
573 :     @lines = $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs);
574 :     # Write them out with the appropriate line-end character.
575 :     DownloadLines($eol, @lines);
576 :     }
577 :     }
578 :     # Download the footer.
579 :     Trace("Downloading footer.") if T(3);
580 :     @lines = $rhelp->DownloadDataLine(undef, $dlType, 'footer', \@colHdrs);
581 :     DownloadLines($eol, @lines);
582 :     }
583 :     }
584 :    
585 :     =head3 DownloadLines
586 :    
587 :     DownloadLines($eol, @lines);
588 :    
589 :     Write the specified lines to the download output using the given end-of-line character.
590 :    
591 :     =over 4
592 :    
593 :     =item eol
594 :    
595 :     End-of-line character to use.
596 :    
597 :     =item lines
598 :    
599 :     List of lines to write.
600 :    
601 :     =back
602 :    
603 :     =cut
604 :    
605 :     sub DownloadLines {
606 :     # Get the parameters.
607 :     my ($eol, @lines) = @_;
608 :     # Output the lines.
609 :     print join($eol, @lines, "");
610 :     }
611 :    
612 :     =head3 DisplayResults
613 :    
614 :     my $htmlText = DisplayResults($shelp, $rhelp, $cgi);
615 :    
616 :     Display the results of a search. A page of results will be displayed, along with links to get to
617 :     other pages. The HTML for the results display is returned.
618 :    
619 :     =over 4
620 :    
621 :     =item shelp
622 :    
623 :     Search helper object representing the search. The column headers and search rows will be
624 :     stored in the session file attached to it.
625 :    
626 :     =item rhelp
627 :    
628 :     Result helper object used to format the results.
629 :    
630 :     =item cgi
631 :    
632 :     CGI query object for the current session. This includes the page number, size, and result
633 :     counts.
634 :    
635 :     =item RETURN
636 :    
637 :     Returns the HTML text for displaying the current page of search results.
638 :    
639 :     =back
640 :    
641 :     =cut
642 :    
643 :     sub DisplayResults {
644 :     # Get the parameters.
645 :     my ($shelp, $rhelp, $cgi) = @_;
646 :     # Declare the return variable.
647 :     my $retVal = "";
648 :     # Check for a title.
649 :     my $title = $shelp->SearchTitle();
650 :     if ($title) {
651 :     $title = $cgi->h3($title);
652 :     }
653 :     # Extract the result parameters.
654 :     my ($pageSize, $pageNum, $resultCount) = ($cgi->param('PageSize'),
655 :     $cgi->param('Page'),
656 :     $cgi->param('ResultCount'));
657 :     Trace("Result count is $resultCount on page $pageNum for $pageSize/page.") if T(3);
658 :     Trace("Preferred ID style is " . $shelp->GetPreferredAliasType() . ".") if T(3);
659 :     # Only proceed if there are actual results.
660 :     if ($resultCount <= 0) {
661 :     $retVal .= $cgi->h3("No matches found.");
662 :     } else {
663 :     # Check the state of the session file.
664 :     my $fileName = $shelp->GetCacheFileName();
665 :     if (! -e $fileName) {
666 :     $retVal .= $cgi->h3("Search session has expired. Please resubmit your query.");
667 :     } else {
668 :     # The file is here, so we can open it.
669 :     my $sessionH = Open(undef, "<$fileName");
670 :     if (T(3)) {
671 :     my $fileData = stat($sessionH);
672 :     Trace($fileData->size . " bytes in $fileName.");
673 :     }
674 :     # Read the column headers.
675 :     my @colHdrs = $shelp->ReadColumnHeaders($sessionH);
676 :     # Compute the page navigation string.
677 :     my $formFlag = ($cgi->param('NoForm') ? 0 : 1);
678 :     my $pageNavigator = PageNavigator($shelp, $formFlag);
679 :     # Now we need to find our page. The line number we compute will be
680 :     # zero-based. We'll read from the session file until it drops to zero.
681 :     # This may push us past end-of-file, but it won't cause an exception, and
682 :     # it's something that should only happen very rarely in any case.
683 :     my $linesToSkip = ($pageNum - 1) * $pageSize;
684 :     Trace("Skipping $linesToSkip lines in session file $fileName.") if T(3);
685 :     for (my $lines = $linesToSkip; $lines > 0; $lines--) {
686 :     Tracer::GetLine($sessionH);
687 :     }
688 :     # The session file is now positioned at the beginning of our line.
689 :     # We build the table rows one line at a time until we run out of data
690 :     # or exceed the page size.
691 :     my @tableRows = ();
692 :     my $linesLeft = $pageSize;
693 :     Trace("$linesLeft lines to read from session file.") if T(3);
694 :     while ($linesLeft-- > 0) {
695 :     Trace("Reading line from session file.") if T(3);
696 :     my @cols = Tracer::GetLine($sessionH);
697 :     if (! @cols) {
698 :     Trace("End of file read.") if T(3);
699 :     $linesLeft = 0;
700 :     } else {
701 :     Trace("Line has " . scalar(@cols) . " columns. $linesLeft lines left.") if T(3);
702 :     # Peel off the first column. This is the ID of the result object. We don't use
703 :     # it, but other methods do.
704 :     shift @cols;
705 :     # Check the columns for run-time generation.
706 :     my @actual = $rhelp->GetRunTimeValues(@cols);
707 :     # Put the actual data into the table list.
708 :     push @tableRows, \@actual;
709 :     }
710 :     }
711 :     # Start the list of links. The first one is the URL-save link.
712 :     my $downloadScript = $cgi->start_table({ border => "2" });
713 :     if (! $cgi->param("NoForm")) {
714 :     my $searchURL = $shelp->ComputeSearchURL();
715 :     $downloadScript .= $cgi->Tr($cgi->td("URL to repeat this search"), $cgi->td($cgi->a({ href => $searchURL }, "Save"))) . "\n";
716 :     }
717 :     # Now compute the download links. This is actually a JavaScript thing, because we need to know
718 :     # name of the user's operating system and handle fields inside the link text.
719 :     my $downloadURL = StatusURL($cgi);
720 :     my $dlType;
721 :     # Ask the result helper which download types are supported.
722 :     my %myDlTypes = $rhelp->DownloadFormatsAvailable();
723 :     # First we display the links themselves.
724 :     for $dlType (sort keys %myDlTypes) {
725 :     my $dlDesc = $myDlTypes{$dlType};
726 :     # Check the description for a data field.
727 :     if ($dlDesc =~ /^([^\[]+)(\[[^\]]+\])(.+)/) {
728 :     my ($prefix, $data, $suffix) = ($1, $2, $3);
729 :     # We want to replace the data thing with a text field. First, we parse out the field name.
730 :     $data =~ /\[(\w+)\]/;
731 :     my ($fieldName) = ($1, $2);
732 :     # Generate the text field HTML.
733 :     my $textField = $cgi->textfield(-name => $fieldName, -size => 5,
734 :     -onKeyUp => "updateAnchor('$dlType', '$fieldName', this.value)");
735 :     # Put it all together.
736 :     $dlDesc = "$prefix$textField$suffix";
737 :     }
738 :     $downloadScript .= $cgi->Tr($cgi->td("$dlDesc"), $cgi->td($cgi->a({ id => "dlLink$dlType", class => "button2 button" }, "Download"))) . "\n";
739 :     }
740 :     $downloadScript .= $cgi->end_table();
741 :     # Now we create the javascript to fill the URLs into the link anchors. Each URL adds the download
742 :     # type, operating system ID, and data-thing parameters to the link URL. We have one method that
743 :     # initializes all the links, and another that updates a link when a parameter changes.
744 :     $downloadScript .= "<script type=\"text/javascript\">\n" .
745 :     " function setAnchors() {\n" .
746 :     " var sysType = checkOS();\n" .
747 :     " var linkAnchor;\n";
748 :     for $dlType (keys %myDlTypes) {
749 :     $downloadScript .= " linkAnchor = document.getElementById('dlLink$dlType');\n" .
750 :     " linkAnchor.href = '$downloadURL;Download=$dlType;os=' + sysType;\n";
751 :     }
752 :     $downloadScript .= " };\n";
753 :     # Now we've got the method for initializes all the links. The next one updates a link when its parameter
754 :     # field changes.
755 :     $downloadScript .= " function updateAnchor(dlType, name, value) {\n" .
756 :     " var sysType = checkOS();\n" .
757 :     " var linkAnchor;\n" .
758 :     " linkAnchor = document.getElementById('dlLink' + dlType);\n" .
759 :     " linkAnchor.href = '$downloadURL;Download=' + dlType + ';os=' + sysType + ';' + name + '=' + value;\n" .
760 :     " };\n" .
761 :     " setAnchors();\n" .
762 :     "</script>";
763 :     # Finally, a spacer to separate the table from the page navigator.
764 :     $downloadScript .= "<p>&nbsp;</p>\n";
765 :     # Now we build the table. Create an array for the row styles.
766 :     my @styles = ('even', 'odd');
767 :     # Start the table.
768 :     my @tableLines = ($cgi->start_table({border => 0}));
769 :     # Put in the column headers.
770 :     push @tableLines, $cgi->Tr({class => $styles[1]}, map { $cgi->th({ class => $rhelp->ColumnStyle($_) },
771 :     $rhelp->ColumnTitle($_)) } @colHdrs );
772 :     # Start the first data row with the even style.
773 :     my $styleMode = 0;
774 :     # Loop through the rows.
775 :     for my $row (@tableRows) {
776 :     # We'll put the table cells in here.
777 :     my @cells = ();
778 :     # Loop through the cells in this row. We use a numeric index because we're moving through
779 :     # the column headers list and the row list in parallel.
780 :     for (my $i = 0; $i <= $#colHdrs; $i++) {
781 :     push @cells, $cgi->td({class => $rhelp->ColumnStyle($colHdrs[$i]) }, $row->[$i]);
782 :     }
783 :     # Push this row into the result list.
784 :     push @tableLines, $cgi->Tr({class => $styles[$styleMode]}, @cells);
785 :     # Flip the style.
786 :     $styleMode = 1 - $styleMode;
787 :     }
788 :     # Close the table.
789 :     push @tableLines, $cgi->end_table();
790 :     # Assemble the result.
791 :     my $tableText = join("\n", @tableLines);
792 :     # Finally, we compute the page label, which contains the page number, the number of results
793 :     # displayed, and the total results found. If the total found is zero, we would not even be here,
794 :     # so when we create our fancy English result count, we only have to worry about singular or
795 :     # plural.
796 :     my $resultCountLine;
797 :     my $linesFound = scalar @tableRows;
798 :     if ($resultCount == 1) {
799 :     $resultCountLine = "One Result Found.";
800 :     } elsif ($resultCount <= $linesFound) {
801 :     $resultCountLine = "$resultCount Results Found";
802 :     } else {
803 :     $resultCountLine = "Search Results Page $pageNum: $linesFound of $resultCount Results Displayed.";
804 :     }
805 :     # Now we're ready. We do a the results counter, a page navigator, a spacer, the table, a spacer,
806 :     # and another page navigator.
807 :     $retVal = join("\n",
808 :     $title,
809 :     $downloadScript,
810 :     $pageNavigator,
811 :     $cgi->p("&nbsp;"),
812 :     $cgi->h3($resultCountLine),
813 :     $tableText,
814 :     $cgi->p("&nbsp;"),
815 :     $pageNavigator,
816 :     "");
817 :     }
818 :     }
819 :     # Return the result.
820 :     return $retVal;
821 :     }
822 :    
823 :     =head3 PageNavigator
824 :    
825 :     my $htmlText = PageNavigator($shelp, $formFlag);
826 :    
827 :     Return a page navigation string for the specified query.
828 :    
829 :     =over 4
830 :    
831 :     =item shelp
832 :    
833 :     Search helper object for the current session.
834 :    
835 :     =item formFlag
836 :    
837 :     TRUE if a form has been displayed, else FALSE.
838 :    
839 :     =item RETURN
840 :    
841 :     Returns a page navigation string for the specified search operation. If a form
842 :     has been displayed, the navigation elements will include the complete form
843 :     information; otherwise they will only include position and status.
844 :    
845 :     =back
846 :    
847 :     =cut
848 :    
849 :     sub PageNavigator {
850 :     # Get the parameters.
851 :     my ($shelp, $formFlag) = @_;
852 :     # Get the CGI query object.
853 :     my $cgi = $shelp->Q();
854 :     # Extract the result parameters.
855 :     my ($pageSize, $pageNum, $resultCount) = ($cgi->param('PageSize'),
856 :     $cgi->param('Page'),
857 :     $cgi->param('ResultCount'));
858 :     # Declare the return variable.
859 :     my $retVal = "";
860 :     # Compute the number of the last page.
861 :     my $lastPage = ceil($resultCount / $pageSize);
862 :     # Only proceed if there's more than one page.
863 :     if ($lastPage > 1) {
864 :     # Create a URL without a page number. All the other URLs will be generated
865 :     # from this one by appending the new page number.
866 :     my $url = StatusURL($cgi, SessionID => $shelp->ID(), Page => undef);
867 :     # Now compute the start and end pages for the display. We display ten pages,
868 :     # with the current one more or less centered.
869 :     my $startPage = $pageNum - 4;
870 :     if ($startPage < 1) { $startPage = 1; }
871 :     my $endPage = $startPage + 9;
872 :     if ($endPage > $lastPage) { $endPage = $lastPage; }
873 :     # Create a list of URL/page-number combinations.
874 :     my @pageThings = ();
875 :     for (my $linkPage = $startPage; $linkPage <= $endPage; $linkPage++) {
876 :     # Check for the current page. It gets a page number with no link.
877 :     if ($linkPage == $pageNum) {
878 :     push @pageThings, $linkPage;
879 :     } else {
880 :     # This is not the current page, so it gets the full treatment.
881 :     push @pageThings, PageThing($cgi, $linkPage, $linkPage, $url);
882 :     }
883 :     }
884 :     # Now add some jump links at the end.
885 :     my @forePointers = ();
886 :     my $pg;
887 :     if ($endPage < $lastPage) {
888 :     for ($pg = $endPage + 5; $pg < $lastPage; $pg += 15) {
889 :     push @forePointers, PageThing($cgi, $pg, $pg, $url);
890 :     }
891 :     push @forePointers, PageThing($cgi, ">>", $lastPage, $url);
892 :     }
893 :     # Finally, add some jump links at the front.
894 :     my @backPointers = ();
895 :     if ($startPage > 1) {
896 :     for ($pg = $startPage - 5; $pg > 1; $pg -= 15) {
897 :     unshift @backPointers, PageThing($cgi, $pg, $pg, $url);
898 :     }
899 :     unshift @backPointers, PageThing($cgi, "<<", 1, $url);
900 :     }
901 :     # Put it all together.
902 :     my $middle = join(" ", @pageThings);
903 :     $retVal = join " ... ", @backPointers, $middle, @forePointers;
904 :     }
905 :     # Return the result.
906 :     return $retVal;
907 :     }
908 :    
909 :     =head3 PageThing
910 :    
911 :     my $htmlText = PageThing($cgi, $pageLabel, $pageNumber, $url);
912 :    
913 :     Create an entry for the page navigator. The entry consists of a label that
914 :     is hyperlinked to the specified page number of the search results.
915 :    
916 :     =over 4
917 :    
918 :     =item cgi
919 :    
920 :     CGI object, used to access the CGI HTML-building methods.
921 :    
922 :     =item pageLabel
923 :    
924 :     Text to be hyperlinked. This is usually the page number, but sometimes it will be
925 :     arrows.
926 :    
927 :     =item pageNumber
928 :    
929 :     Number of the page to be presented when the link is followed.
930 :    
931 :     =item url
932 :    
933 :     Base URL for viewing a page.
934 :    
935 :     =item RETURN
936 :    
937 :     Returns HTML for the specified label, hyperlinked to the desired page.
938 :    
939 :     =back
940 :    
941 :     =cut
942 :    
943 :     sub PageThing {
944 :     # Get the parameters.
945 :     my ($cgi, $pageLabel, $pageNumber, $url) = @_;
946 :     # Compute the full URL.
947 :     my $purl = "$url&Page=$pageNumber";
948 :     # Form it into a hyperlink.
949 :     my $retVal = "<a href=\"$purl\" title=\"Results page $pageNumber\">$pageLabel</a>";
950 :     # Return the result.
951 :     return $retVal;
952 :     }
953 :    
954 :     =head3 StatusURL
955 :    
956 :     my $queryUrl = StatusURL($cgi, %overrides);
957 :    
958 :     Create a URL for the current script containing status information for the search in progress.
959 :     The values in the incoming CGI object will be used for all parameters except the ones
960 :     specified as overrides. So, for example
961 :    
962 :     StatusURL($cgi, PageNum => 3)
963 :    
964 :     would specify a page number of 3, but all the other parameters will be taken as is from
965 :     the CGI object. The complete list of session variables is given in the L</Session Data>
966 :     section.
967 :    
968 :     =over 4
969 :    
970 :     =item cgi
971 :    
972 :     CGI query object containing the session variables.
973 :    
974 :     =item overrides
975 :    
976 :     A hash mapping key names to override values. These are used to override values in the
977 :     I<$cgi> parameter.
978 :    
979 :     =item RETURN
980 :    
981 :     Returns a relative URL for the current page with GET-style values for all the session
982 :     variables.
983 :    
984 :     =back
985 :    
986 :     =cut
987 :    
988 :     sub StatusURL {
989 :     # Get the parameters.
990 :     my ($cgi, %overrides) = @_;
991 :     # Create a hash of the session variables we want to keep.
992 :     my %varHash;
993 :     for my $varKey (@Keepers) {
994 :     # Check for an override.
995 :     if (exists $overrides{$varKey}) {
996 :     my $override = $overrides{$varKey};
997 :     # Use the override if it is not null or undefined.
998 :     if (defined($override) && $override ne "") {
999 :     $varHash{$varKey} = $override;
1000 :     }
1001 :     } else {
1002 :     # Check for a CGI value.
1003 :     my $normal = $cgi->param($varKey);
1004 :     # Use it if it exists.
1005 :     if (defined($normal)) {
1006 :     $varHash{$varKey} = $normal;
1007 :     }
1008 :     }
1009 :     }
1010 :     # Compute the full URL.
1011 :     my $retVal = Tracer::GenerateURL("$FIG_Config::cgi_url/SearchSkeleton.cgi", %varHash);
1012 :     # Return the result.
1013 :     return $retVal;
1014 :     }
1015 :    
1016 :     =head3 SaveSearchParms
1017 :    
1018 :     SaveSearchParms($cgi, $shelp);
1019 :    
1020 :     Save the search parameters from the CGI object to a session file. The
1021 :     session file will be in the temporary directory named by the session
1022 :     ID with a suffix of C<.parms>.
1023 :    
1024 :     =over 4
1025 :    
1026 :     =item cgi
1027 :    
1028 :     CGI object containing the parameters to save.
1029 :    
1030 :     =item shelp
1031 :    
1032 :     Currently-active search helper object (used to compute the file name).
1033 :    
1034 :     =back
1035 :    
1036 :     =cut
1037 :    
1038 :     sub SaveSearchParms {
1039 :     # Get the parameters.
1040 :     my ($cgi, $shelp) = @_;
1041 :     # Get the name for the parameters file.
1042 :     my $parmFileName = $shelp->GetTempFileName('parms');
1043 :     # Create a hash of the parameters we don't want to keep.
1044 :     my %excludeParms = map { $_ => 1 } @Keepers;
1045 :     # Create a list to store the parameter lines.
1046 :     my @lines = ();
1047 :     # Loop through the parameters, writing them to the file in tab-delimited format.
1048 :     for my $parm ($cgi->param) {
1049 :     # Only proceed if this is NOT an excluded parm.
1050 :     if (! exists $excludeParms{$parm}) {
1051 :     # We output the parameters in tab-delimited format. The first field is the parameter
1052 :     # itself. The remaining fields are the values of the parameter. Normally there is
1053 :     # only one value, but quite a few of the search forms have at least one multi-valued
1054 :     # parameter. Note that we can have new-lines in a field, just not tabs.
1055 :     my @values = $cgi->param($parm);
1056 :     my $line = join("\t", $parm, @values);
1057 :     push @lines, $line;
1058 :     }
1059 :     }
1060 :     # Open the parameters file for output.
1061 :     my $oh = Open(undef, ">$parmFileName");
1062 :     # Because there are new-lines inside fields, we use a special marker to join the lines into
1063 :     # a result file.
1064 :     my $wholeFile = join("\n##\n", @lines);
1065 :     print $oh $wholeFile;
1066 :     # Close the output file.
1067 :     close $oh;
1068 :     }
1069 :    
1070 :     =head3 LoadSearchParms
1071 :    
1072 :     LoadSearchParms($cgi, $shelp);
1073 :    
1074 :     Load the saved search parameters into the specified CGI object. This reads the search data
1075 :     saved by L</SaveSearchParms>.
1076 :    
1077 :     =over 4
1078 :    
1079 :     =item cgi
1080 :    
1081 :     CGI object into which the parameters will be stored.
1082 :    
1083 :     =item shelp
1084 :    
1085 :     Currently-active search helper object (used to compute the file name).
1086 :    
1087 :     =back
1088 :    
1089 :     =cut
1090 :    
1091 :     sub LoadSearchParms {
1092 :     # Get the parameters.
1093 :     my ($cgi, $shelp) = @_;
1094 :     # Only proceed if this is an old session. A new session won't have saved parameters.
1095 :     if (! $shelp->IsNew()) {
1096 :     # Get the name for the parameters file.
1097 :     my $parmFileName = $shelp->GetTempFileName('parms');
1098 :     # Only proceed if this is an old file exists. If the file does not exist,
1099 :     # we assume all the parameter values are blank and do nothing.
1100 :     if (-f $parmFileName) {
1101 :     # Read the parameters file.
1102 :     my $wholeFile = Tracer::GetFile($parmFileName);
1103 :     # Split it into sections. The delimiter is ## surrounded by new-lines. We
1104 :     # can't use just plain \n because it might occur in the middle of a parameter
1105 :     # value.
1106 :     my @lines = split /\n##\n/, $wholeFile;
1107 :     # Loop through the lines.
1108 :     for my $line (@lines) {
1109 :     # Parse this line into fields.
1110 :     my ($parm, @fields) = split /\t/, $line;
1111 :     # Store them in the CGI object.
1112 :     $cgi->param($parm, @fields);
1113 :     }
1114 :     }
1115 :     }
1116 :     }
1117 :    
1118 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3