Parent Directory
| 
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> </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> </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(" "), | ||
| 812 : | $cgi->h3($resultCountLine), | ||
| 813 : | $tableText, | ||
| 814 : | $cgi->p(" "), | ||
| 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 |