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

Annotation of /Sprout/ResultHelper.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package ResultHelper;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use FIG;
8 :     use URI::Escape;
9 :    
10 :     =head1 Search Result Display Helper
11 :    
12 :     =head2 Introduction
13 :    
14 :     This is the base class for search output. It provides common methods for formatting the
15 :     output and providing options to the caller. This class is never used by itself.
16 :     Instead, a subclass (whose name begins with C<RH> is constructed.
17 :    
18 :     The following fields are maintained by this object.
19 :    
20 :     =over 4
21 :    
22 :     =item parent
23 :    
24 :     The parent search helper.
25 :    
26 :     =item record
27 :    
28 :     An B<ERDBObject> representing the current data.
29 :    
30 :     =item columns
31 :    
32 :     Reference to a hash specifying the different possible columns that can be
33 :     included in the result.
34 :    
35 :     =back
36 :    
37 :     Additional fields may be appended by the subclasses.
38 :    
39 :     =head2 Column Processing
40 :    
41 :     The subclass will generally have multiple column names defined. For each column,
42 :     several bits of information are needed-- how to format the column, how to compute
43 :     the column value at search time, how to compute it at run time (which is optional),
44 :     the column title to be used, and whether or not the column should be included in
45 :     a download. The orthodox object-oriented method for doing this would be to define
46 :     a B<Column> class and define each possible column using a subclass. To make things
47 :     a little less cumbersome, we instead define each column using a static method in
48 :     the subclass. The method gets as its parameters the result helper object and
49 :     the type of information required. For example, the following call would ask for
50 :     the title of a column called C<orgName>.
51 :    
52 :     my $title = RHFeatures::orgName(title => $rhelp);
53 :    
54 :     The B<orgName> method itself would look like this.
55 :    
56 :     sub orgName {
57 :     # Get the parameters.
58 :     my ($type, $rhelp, $key) = @_;
59 :     # Declare the return variable.
60 :     my $retVal;
61 :     # Process according to the information requested.
62 :     if ($type eq 'title' {
63 :     # Return the title for this column.
64 :     $retVal = 'Organism and Gene ID';
65 :     } elsif ($type eq 'download') {
66 :     # This field should be included in a download.
67 :     $retVal = 'text'; # or 'num', or 'list', or ''
68 :     } elsif ($type eq 'style') {
69 :     # This is a text field, so it's left-aligned.
70 :     $retVal = "leftAlign";
71 :     } elsif ($type eq 'value') {
72 :     # Get the organism and feature name.
73 :     $rhelp->FeatureName();
74 :     } elsif ($type eq 'runTimeValue') {
75 :     # This field does not require a runtime value.
76 : parrello 1.7 } elsif ($type eq 'valueFromKey') {
77 :     # Get the feature name from the feature ID.
78 :     $rhelp->FeatureNameFromID($key);
79 : parrello 1.1 };
80 :     return $retVal;
81 :     }
82 :    
83 :     The method is essentially a giant case statement based on the type of data desired. The
84 :     types are
85 :    
86 :     =over 4
87 :    
88 :     =item title
89 :    
90 :     Return the title of the column to be used when it is displayed.
91 :    
92 :     =item download
93 :    
94 :     Identifies how the column should be downloaded. An empty string means it should not
95 :     be downloaded at all. The other values are C<num>, indicating that the column contains
96 :     numeric data, C<text>, indicating that the column contains an html-escaped string,
97 : parrello 1.2 C<link>, indicating that the column contains a L</Formlet> or L</FakeButton>,
98 :     C<list>, indicating that the column contains a comma-separated list with optional
99 :     hyperlinks, or C<align>,indicating that the column contains multi-line
100 :     aligned text with individual lines separated by a C<br> tag.
101 : parrello 1.1
102 :     =item style
103 :    
104 :     Return the style to be used to display each table cell in the column. The return
105 :     value is a valid C<TD> class name from the style sheet. The style sheet should
106 :     contain styles for C<leftAlign>, C<rightAlign>, and C<center> to accomodate the
107 :     most common requirements.
108 :    
109 :     =item value
110 :    
111 :     Return the value to be stored in the result cache. In most cases, this should be an
112 :     html string. If the value is to be computed when the data is displayed (which is
113 :     sometimes necessary for performance reasons), then the return value should be of
114 :     the form C<%%>I<colName>C<=>I<key>, where I<colName> is the column name and
115 :     I<key> is a value used to compute the result at display time. The key value will
116 :     be passed as a third parameter to the column method.
117 :    
118 :     =item runTimeValue
119 :    
120 :     Return the value to be displayed. This method is only used when the information
121 :     is not easily available at the time the result cache is built.
122 :    
123 : parrello 1.7 =item valueFromKey
124 :    
125 :     Compute the value from a row ID. This method is used when the results are being
126 :     loaded asynchronously into a WebApplication table.
127 :    
128 : parrello 1.1 =back
129 :    
130 :     The idea behind this somewhat cumbersome design is that new columns can be added
131 :     very easily by simply adding a new method to the result helper.
132 :    
133 :     Note that a column name must be a valid PERL method name! This means no spaces
134 :     or other fancy stuff.
135 :    
136 :     Run-time values are a bit tricky, and require some explanation. The normal procedure
137 :     during a search is to compute the values to be displayed as soon as an item is found
138 :     and store them directly in the result cache. Run-time values are those that are too
139 :     expensive to compute during the search, so they are not computed until the result
140 :     cache is displayed. Because a search can return thousands of results, but only 50 or
141 :     so are displayed at a time, this makes a big difference.
142 :    
143 : parrello 1.7 =head3 Extra Columns
144 : parrello 1.1
145 :     It is necessary for individual searches to be able to create output columns specific
146 :     to the type of search. These are called extra columns.
147 :    
148 :     To create extra columns, you use the L</AddExtraColumn> method. This method
149 :     specifies the location of an extra column in the column list, its name, and its format.
150 :    
151 :     The extra columns are put in whatever positions the user specifies, although if
152 :     you try to put two columns in the same place or add a column before another added
153 :     column, this could cause the position to shift.
154 :    
155 :     Unlike regular columns, there is no need to compute a value or run-time value. The
156 :     other column properties (title, style, etc.) are stored in the extra column's
157 :     definition in this object. When the column headers are written, the header for an
158 :     extra column is in the form C<X=>I<something>. The I<something> is a frozen copy
159 :     of the extra column's hash. When the headers are read back in, the extra column data
160 :     is thawed into the hash so that the various options are identical to what they were
161 :     when the result cache was created.
162 :    
163 : parrello 1.7 =head3 Object-Based Columns
164 :    
165 :     Some result helpers need to be much more fluid with column definitions than is possible
166 :     with the standard column-processing model. These helpers should override the L</VirtualCompute>
167 :     method. The L</Compute> method calls L</VirtualCompute> to give the subclass an opportunity
168 :     to process the column computation request before it tries working with a built-in column.
169 :     It is expected that eventually all columns will be converted to this object-based
170 :     approach, but there is no hurry.
171 : parrello 1.1
172 :     =cut
173 :    
174 :     # This value is used to do a single indent level in the XML output.
175 :     use constant XML_INDENT => " ";
176 :    
177 :     =head2 Public Methods
178 :    
179 :     =head3 new
180 :    
181 : parrello 1.5 my $rhelp = ResultHelper->new($shelp);
182 : parrello 1.1
183 :     Construct a new ResultHelper object to serve the specified search helper.
184 :    
185 :     =over 4
186 :    
187 :     =item shelp
188 :    
189 :     Parent search helper that is generating the output.
190 :    
191 :     =item type
192 :    
193 :     Classname used to format requests for columns.
194 :    
195 :     =item extras
196 :    
197 :     Reference to a hash of extra column data keyed on extra column name. For each extra column,
198 :     it contains the column's current value.
199 :    
200 :     =item cache
201 :    
202 :     A hash for use by the run-time value methods, to save time when multiple run-time values
203 :     use the same base object.
204 :    
205 :     =item columns
206 :    
207 :     The list of the columns to displayed in the search results. Normal columns are stored as
208 :     strings. Extra columns are stored as hash references.
209 :    
210 :     =item record
211 :    
212 :     Data record for the current output row.
213 :    
214 :     =item id
215 :    
216 :     ID for the current output row.
217 :    
218 :     =item RETURN
219 :    
220 :     Returns a newly-constructed result helper.
221 :    
222 :     =back
223 :    
224 :     =cut
225 :    
226 :     sub new {
227 :     # Get the parameters.
228 :     my ($class, $shelp) = @_;
229 :     # Save the result type in the CGI parms.
230 :     my $cgi = $shelp->Q();
231 :     $cgi->param(-name => 'ResultType', -value => substr($class, 2));
232 :     Trace("Result helper created of type $class.") if T(3);
233 :     # Create the $rhelp object.
234 :     my $retVal = {
235 :     parent => $shelp,
236 :     record => undef,
237 :     id => undef,
238 :     type => $class,
239 :     extras => {},
240 :     cache => {},
241 :     columns => [],
242 :     };
243 :     # Return it.
244 :     return $retVal;
245 :     }
246 :    
247 :     =head3 DB
248 :    
249 : parrello 1.5 my $sprout = $rhelp->DB();
250 : parrello 1.1
251 :     Return the Sprout object for accessing the database.
252 :    
253 :     =cut
254 :    
255 :     sub DB {
256 :     # Get the parameters.
257 :     my ($self) = @_;
258 :     # Return the parent helper's database object.
259 :     return $self->Parent()->DB();
260 :     }
261 :    
262 :     =head3 PutData
263 :    
264 : parrello 1.5 $rhelp->PutData($sortKey, $id, $record);
265 : parrello 1.1
266 :     Store a line of data in the result file.
267 :    
268 :     =over 4
269 :    
270 :     =item sortKey
271 :    
272 :     String to be used for sorting this line of data among the others.
273 :    
274 :     =item id
275 :    
276 :     ID string for the result line. This is not shown in the results, but
277 :     is used by some of the download methods.
278 :    
279 :     =item record
280 :    
281 :     An B<ERDBObject> containing data to be used by the column methods.
282 :    
283 :     =back
284 :    
285 :     =cut
286 :    
287 :     sub PutData {
288 :     # Get the parameters.
289 :     my ($self, $sortKey, $id, $record) = @_;
290 :     # Save the data record and ID so the column methods can get to it.
291 :     $self->{record} = $record;
292 :     $self->{id} = $id;
293 :     # Loop through the columns, producing output data.
294 :     my @outputCols = ();
295 :     for my $column (@{$self->{columns}}) {
296 :     push @outputCols, $self->ColumnValue($column);
297 :     }
298 :     # Get the parent search helper.
299 :     my $shelp = $self->{parent};
300 :     # Write the column data.
301 :     $shelp->WriteColumnData($sortKey, $id, @outputCols);
302 :     }
303 :    
304 :     =head3 GetColumnHeaders
305 :    
306 : parrello 1.5 my $colHdrs = $rhelp->GetColumnHeaders();
307 : parrello 1.1
308 :     Return the list of column headers for this session. The return value is a
309 :     reference to the live column header list.
310 :    
311 :     =cut
312 :    
313 :     sub GetColumnHeaders {
314 :     # Get the parameters.
315 :     my ($self) = @_;
316 :     # Return the column headers.
317 :     return $self->{columns};
318 :     }
319 :    
320 :     =head3 DownloadFormatsAvailable
321 :    
322 : parrello 1.5 my %dlTypes = $rhelp->DownloadFormatsAvailable();
323 : parrello 1.1
324 :     Return a hash mapping each download type to a download description. The default is
325 :     the C<tbl> format, which is a tab-delimited download, and the C<xml> format,
326 :     which is XML. If you want additional formats, override L</MoreDownloadFormats>.
327 :    
328 :     =cut
329 :    
330 :     sub DownloadFormatsAvailable {
331 :     # Get the parameters.
332 :     my ($self) = @_;
333 :     Trace("Creating download type hash.") if T(3);
334 :     # Declare the return variable.
335 :     my %retVal = ( tbl => 'Results table as a tab-delimited file',
336 :     xml => 'Results table in XML format');
337 :     Trace("Asking for download formats from the helper.") if T(3);
338 :     # Ask for more formats.
339 :     $self->MoreDownloadFormats(\%retVal);
340 :     # Return the resulting hash.
341 :     return %retVal;
342 :     }
343 :    
344 :     =head3 DownloadDataLine
345 :    
346 : parrello 1.5 $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs);
347 : parrello 1.1
348 :     Return one or more lines of download data. The exact data returned depends on the
349 : parrello 1.5 download type.
350 : parrello 1.1
351 :     =over 4
352 :    
353 :     =item objectID
354 :    
355 :     ID of the object whose data is in this line of results.
356 :    
357 :     =item dlType
358 :    
359 :     The type of download (e.g. C<tbl>, C<fasta>).
360 :    
361 :     =item eol
362 :    
363 :     The end-of-line character to use.
364 :    
365 :     =item cols
366 :    
367 :     A reference to a list of the data columns, or a string containing
368 :     C<header> or C<footer>. The strings will cause the header lines
369 :     or footer lines to be output rather than a data line.
370 :    
371 :     =item colHdrs
372 :    
373 :     A reference to a list of the column headers. Each header describes the data found
374 :     in the corresponding column of the I<cols> list.
375 :    
376 :     =item RETURN
377 :    
378 :     Returns a list of strings that can be written to the download output.
379 :    
380 :     =back
381 :    
382 :     =cut
383 :    
384 :     sub DownloadDataLine {
385 :     # Get the parameters.
386 :     my ($self, $objectID, $dlType, $cols, $colHdrs) = @_;
387 :     # Declare the return variable.
388 :     my @retVal = ();
389 :     # Check the download type.
390 :     if ($dlType eq 'tbl' || $dlType eq 'xml') {
391 :     # Check for headers or footers.
392 :     if ($cols eq 'header') {
393 :     # Here we want headers. Only the XML type has them.
394 :     if ($dlType eq 'xml') {
395 :     @retVal = ('<?xml version="1.0" encoding="utf-8" ?>',
396 :     '<Results>');
397 :     }
398 :     } elsif ($cols eq 'footer') {
399 :     # Here we want footers. Again, only the XML type requires them.
400 :     if ($dlType eq 'xml') {
401 :     @retVal = ('</Results>');
402 :     }
403 :     } else {
404 :     # Here we are downloading the displayed columns as a tab-delimited file or
405 :     # as XML and we are tasked with producing the output lines for the current
406 :     # row of data. The first thing is to get the download format information
407 :     # about the columns.
408 :     my @keepCols = map { $self->ColumnDownload($_) } @{$colHdrs};
409 :     # Remove the columns that are not being kept. The list we create here
410 :     # will contain the name of each column, its value, and its download format.
411 :     my @actualCols = ();
412 :     for (my $i = 0; $i <= $#keepCols; $i++) {
413 : parrello 1.3 Trace("Keep flag for $i is $keepCols[$i].") if T(4);
414 : parrello 1.1 if ($keepCols[$i]) {
415 :     push @actualCols, [$colHdrs->[$i], $self->GetRunTimeValues($cols->[$i]), $keepCols[$i]];
416 :     }
417 :     }
418 : parrello 1.3 Trace(scalar(@actualCols) . " columns kept.") if T(4);
419 : parrello 1.1 # Now it's time to do the actual writing, so we need to know if this
420 :     # is XML or tab-delimited.
421 :     if ($dlType eq 'tbl') {
422 :     # Clean up the HTML.
423 :     my @actual = map { HtmlCleanup($_->[1], $_->[2]) } @actualCols;
424 :     # Return the line of data.
425 :     push @retVal, join("\t", @actual);
426 : parrello 1.3 Trace("Output line is\n" . join("\n", @actual)) if T(4);
427 : parrello 1.1 } elsif ($dlType eq 'xml') {
428 : parrello 1.3 # Convert to XML.
429 :     my @actual = ();
430 :     for my $actualCol (@actualCols) {
431 :     # First we need the column name. This is the column header for an ordinary column,
432 :     # and the title for an extra column.
433 :     my $colName;
434 :     if (ref $actualCol->[0]) {
435 :     # Here we have an extra column.
436 :     $colName = $actualCol->[0]->{title};
437 :     # Remove internal spaces to make it name-like.
438 :     $colName =~ s/\s+//g;
439 :     } else {
440 :     # For a normal column, the value is the name.
441 :     $colName = $actualCol->[0];
442 :     }
443 :     # Create the tag for this column. Since a single XML tag can contain multiple
444 :     # lines, we re-split them. This is important, because when the lines are output
445 :     # we need to insure the correct EOL character is used.
446 :     push @actual, split /\n/, "<$colName>" . XmlCleanup($actualCol->[1], $actualCol->[2]) . "</$colName>";
447 :     }
448 : parrello 1.1 # Return the XML object.
449 :     push @retVal, XML_INDENT x 1 . "<Item id=\"$objectID\">";
450 :     push @retVal, map { XML_INDENT x 2 . $_ } @actual;
451 :     push @retVal, XML_INDENT x 1 . "</Item>";
452 :     }
453 :     }
454 :     } else {
455 :     # Now we have a special-purpose download format, so we let the subclass deal
456 :     # with it.
457 :     @retVal = $self->MoreDownloadDataMethods($objectID, $dlType, $cols, $colHdrs);
458 :     }
459 :     # Return the result.
460 :     return @retVal;
461 :     }
462 :    
463 :     =head3 Formlet
464 :    
465 : parrello 1.5 my $html = $rhelp->Formlet($caption, $url, $target, %parms);
466 : parrello 1.1
467 :     Create a mini-form that posts to the specified URL with the specified parameters. The
468 :     parameters will be stored in hidden fields, and the form's only visible control will
469 :     be a submit button with the specified caption.
470 :    
471 :     Note that we don't use B<CGI.pm> services here because they generate forms with extra characters
472 :     and tags that we don't want to deal with.
473 :    
474 :     This method is tightly bound to L</FormletToLink>, which converts a formlet to a URL. A
475 :     change here will require a change to the other method.
476 :    
477 :     =over 4
478 :    
479 :     =item caption
480 :    
481 :     Caption to be put on the form button.
482 :    
483 :     =item url
484 :    
485 :     URL to be put in the form's action parameter.
486 :    
487 :     =item target
488 :    
489 :     Frame or target in which the form results should appear. If C<undef> is specified,
490 :     the default target will be used.
491 :    
492 :     =item parms
493 :    
494 :     Hash containing the parameter names as keys and the parameter values as values.
495 :    
496 :     =back
497 :    
498 :     =cut
499 :    
500 :     sub Formlet {
501 :     # Get the parameters.
502 :     my ($self, $caption, $url, $target, %parms) = @_;
503 :     # Compute the target HTML.
504 :     my $targetHtml = ($target ? " target=\"$target\"" : "");
505 :     # Start the form.
506 : parrello 1.6 my $retVal = "<form method=\"POST\" action=\"$FIG_Config::cgi_url/$url\"$target>";
507 : parrello 1.1 # Add the parameters.
508 :     for my $parm (keys %parms) {
509 :     $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
510 :     }
511 :     # Put in the button.
512 :     $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";
513 :     # Close the form.
514 :     $retVal .= "</form>";
515 :     # Return the result.
516 :     return $retVal;
517 :     }
518 :    
519 :     =head3 HtmlCleanup
520 :    
521 : parrello 1.5 my $text = ResultHelper::HtmlCleanup($htmlText, $type);
522 : parrello 1.1
523 :     Take a string of Html text and clean it up so it appears as real text.
524 :     Note that this method is not yet sophisticated enough to detect right-angle brackets
525 :     inside tag parameters, nor can it handle style or script tags. Its only sophistication
526 : parrello 1.2 is that it knows how to convert formlets or fake buttons URLs. Otherwise, it is a dirt simple
527 : parrello 1.1 method that suffices for search result processing.
528 :    
529 :     =over 4
530 :    
531 :     =item htmlText
532 :    
533 :     Html text to clean up.
534 :    
535 :     =item type
536 :    
537 :     Type of column: C<num> for a number, C<text> for a string, C<list> for a
538 :     comma-separated list, and C<link> for a formlet link.
539 :    
540 :     =item RETURN
541 :    
542 :     Returns the downloadable form of the Html string.
543 :    
544 :     =back
545 :    
546 :     =cut
547 :    
548 :     sub HtmlCleanup {
549 :     # Get the parameters.
550 :     my ($htmlText, $type) = @_;
551 :     # Declare the return variable.
552 :     my $retVal;
553 :     # Check for a formlet.
554 :     if ($type eq 'link') {
555 : parrello 1.2 # Here we have a formlet or fake button and we want to convert it to a URL.
556 :     $retVal = ButtonToLink($htmlText);
557 : parrello 1.1 } elsif ($type eq 'align') {
558 :     # Here we have multiple lines. Convert the new-lines to serial commas.
559 : parrello 1.3 $retVal = $htmlText;
560 : parrello 1.1 $retVal =~ s/<br\s*\/?>/, /g;
561 : parrello 1.4 # Convert &nbsp; marks to real spaces.
562 :     $retVal =~ s/&nbsp;/ /g;
563 : parrello 1.1 } else {
564 :     # Here we have normal HTML. Start by taking the raw text.
565 :     $retVal = $htmlText;
566 :     # Delete any tags. This is a very simplistic algorithm that will fail if there
567 :     # is a right angle bracket inside a parameter string.
568 :     $retVal =~ s/<[^>]+>//g;
569 : parrello 1.3 # Convert &nbsp; marks to real spaces.
570 :     $retVal =~ s/&nbsp;/ /g;
571 : parrello 1.1 # Unescape the & tags.
572 :     $retVal = CGI::unescapeHTML($retVal);
573 :     }
574 :     # Return the result.
575 :     return $retVal;
576 :     }
577 :    
578 :     =head3 XmlCleanup
579 :    
580 : parrello 1.5 my $text = ResultHelper::XmlCleanup($htmlText, $type);
581 : parrello 1.1
582 :     Take a string of Html text and clean it up so it appears as html.
583 :    
584 :     =over 4
585 :    
586 :     =item htmlText
587 :    
588 :     Html text to clean up.
589 :    
590 :     =item type
591 :    
592 :     Type of column: C<num> for a number, C<text> for a string, C<list> for a
593 : parrello 1.2 comma-separated list, and C<link> for a formlet or fake button.
594 : parrello 1.1
595 :     =item RETURN
596 :    
597 :     Returns the column data in XML format.
598 :    
599 :     =back
600 :    
601 :     =cut
602 :    
603 :     sub XmlCleanup {
604 :     # Get the parameters.
605 :     my ($htmlText, $type) = @_;
606 :     # Declare the return variable.
607 :     my $retVal;
608 :     # Check for a formlet.
609 :     if ($type eq 'link') {
610 : parrello 1.2 # Here we have a formlet or fake button and we want to convert it to a URL.
611 :     $retVal = ButtonToLink($htmlText);
612 : parrello 1.1 } elsif ($type eq 'num' || $type eq 'text') {
613 :     # Here we have a number or text. Return the raw value.
614 :     $retVal = $htmlText;
615 :     } elsif ($type eq 'align') {
616 :     # Here we have aligned text. This is converted into an XML array of lines.
617 :     # First, we find the break tags.
618 : parrello 1.3 Trace("Alignment cleanup of: $htmlText") if T(4);
619 : parrello 1.1 my @lines = split /<br[^>]+>/, $htmlText;
620 : parrello 1.3 Trace(scalar(@lines) . " lines found.") if T(4);
621 : parrello 1.1 # Format the lines as an XML array. The extra new-line causes the first array
622 :     # element to be on a separate line from the first item tag.
623 : parrello 1.3 $retVal = "\n" . join("", map { XML_INDENT . "<line>$_</line>\n" } @lines);
624 : parrello 1.1 } elsif ($type eq 'list') {
625 :     # Here we have a comma-delimited list of possibly-linked strings. We will convert it to
626 :     # an XML array. First, we get the pieces.
627 :     my @entries = split /\s*,\s*/, $htmlText;
628 :     # Each piece is processed individually, so we can check for hyperlinks.
629 :     # The return value starts with a new-line, so that the first list element
630 :     # is not on the same line as the open tag.
631 :     $retVal = "\n";
632 :     for my $entry (@entries) {
633 :     # Check for a hyperlink.
634 :     if ($entry =~ /<a[^>]+(href="[^"]+")[^>]*>(.+)<\/a>/) {
635 :     # Put the URL in the tag.
636 :     $retVal .= XML_INDENT . "<value $1>$2</value>\n";
637 :     } else {
638 :     # No URL, so the tag is unadorned.
639 :     $retVal .= XML_INDENT . "<value>$entry</value>\n";
640 :     }
641 :     }
642 :     }
643 :     # Return the result.
644 :     return $retVal;
645 :     }
646 :    
647 : parrello 1.2 =head3 ButtonToLink
648 : parrello 1.1
649 : parrello 1.5 my $url = ResultHelper::ButtonToLink($htmlText);
650 : parrello 1.1
651 : parrello 1.2 Convert a formlet or fake button to a link. This process is bound very tightly with
652 :     the way L</Formlet> and L</FakeButton> generate Html. A change there requires a
653 :     change here.
654 : parrello 1.1
655 :     =over 4
656 :    
657 :     =item htmlText
658 :    
659 :     HTML text for the formlet.
660 :    
661 :     =item RETURN
662 :    
663 :     Returns a URL that will produce the same result as clicking the formlet button.
664 :    
665 :     =back
666 :    
667 :     =cut
668 :    
669 : parrello 1.2 sub ButtonToLink {
670 : parrello 1.1 # Get the parameters.
671 :     my ($htmlText) = @_;
672 :     # Declare the return variable.
673 :     my $retVal;
674 :     # We begin with the action.
675 : parrello 1.2 if ($htmlText =~ /action="([^"]+)"/i) {
676 :     # Action found, so this is a formlet. The action is the base of the URL.
677 :     $retVal = $1;
678 :     # Now, parse out the parameters, all of which are stored in the formlet as hidden
679 :     # input fields. This is the point where we assume that the formlet generates things
680 :     # in a well-defined format.
681 :     my @parms = ();
682 :     while ($htmlText =~ /<input\s+type="hidden"\s+name="([^"]+)"\s+value="([^"]+)"/ig) {
683 :     push @parms, "$1=" . uri_escape($2);
684 :     }
685 :     # If there were any parameters, assemble them into the URL.
686 :     if (scalar(@parms)) {
687 :     $retVal .= "?" . join(";", @parms);
688 :     }
689 :     } elsif ($htmlText =~ /<a\s+href="([^"]+)"/) {
690 :     # Here we have a fake button. The URL is the HREF.
691 :     $retVal = $1;
692 :     } else {
693 :     # Here the column is empty. We output an empty string.
694 :     $retVal = '';
695 : parrello 1.1 }
696 : parrello 1.2 # Now a final cleanup. If we have a URL and it's relative, we need to add our path to it.
697 :     if ($retVal && $retVal !~ m#http://#) {
698 : parrello 1.6 # The link doesn't begin with http, so we must fix it.
699 :     $retVal = "$FIG_Config::cgi_url/$retVal";
700 : parrello 1.1 }
701 :     # Return the result.
702 :     return $retVal;
703 :     }
704 :    
705 :     =head3 FakeButton
706 :    
707 : parrello 1.5 my $html = $rhelp->FakeButton($caption, $url, $target, %parms);
708 : parrello 1.1
709 :     Create a fake button that hyperlinks to the specified URL with the specified parameters.
710 :     Unlike a real button, this one won't visibly click, but it will take the user to the
711 :     correct place.
712 :    
713 :     The parameters of this method are deliberately identical to L</Formlet> so that we
714 :     can switch easily from real buttons to fake ones in the code.
715 :    
716 :     =over 4
717 :    
718 :     =item caption
719 :    
720 :     Caption to be put on the button.
721 :    
722 :     =item url
723 :    
724 :     URL for the target page or script.
725 :    
726 :     =item target
727 :    
728 :     Frame or target in which the new page should appear. If C<undef> is specified,
729 :     the default target will be used.
730 :    
731 :     =item parms
732 :    
733 :     Hash containing the parameter names as keys and the parameter values as values.
734 :     These will be appended to the URL.
735 :    
736 :     =back
737 :    
738 :     =cut
739 :    
740 :     sub FakeButton {
741 :     # Get the parameters.
742 :     my ($self, $caption, $url, $target, %parms) = @_;
743 :     # Declare the return variable.
744 :     my $retVal;
745 :     # Compute the target URL.
746 : parrello 1.6 my $targetUrl = "$FIG_Config::cgi_url/$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
747 : parrello 1.1 # Compute the target-frame HTML.
748 :     my $targetHtml = ($target ? " target=\"$target\"" : "");
749 :     # Assemble the result.
750 :     return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";
751 :     }
752 :    
753 :     =head3 Parent
754 :    
755 : parrello 1.5 my $shelp = $rhelp->Parent();
756 : parrello 1.1
757 :     Return this helper's parent search helper.
758 :    
759 :     =cut
760 :    
761 :     sub Parent {
762 :     # Get the parameters.
763 :     my ($self) = @_;
764 :     # Return the parent.
765 :     return $self->{parent};
766 :     }
767 :    
768 :     =head3 Record
769 :    
770 : parrello 1.5 my $erdbObject = $rhelp->Record();
771 : parrello 1.1
772 :     Return the record currently stored in this object. The record contains the data for
773 :     the result output line being built, and is in the form of a B<ERDBObject>.
774 :    
775 :     =cut
776 :    
777 :     sub Record {
778 :     # Get the parameters.
779 :     my ($self) = @_;
780 :     # Get the record.
781 :     my $retVal = $self->{record};
782 :     # If it does not exist, trace a message.
783 :     Trace("No record found in result helper.") if T(3) && ! defined($retVal);
784 :     # Return the record.
785 :     return $retVal;
786 :     }
787 :    
788 :     =head3 ID
789 :    
790 : parrello 1.5 my $id = $rhelp->ID();
791 : parrello 1.1
792 :     Return the ID for the record currently stored in this object (if any).
793 :    
794 :    
795 :     =cut
796 :    
797 :     sub ID {
798 :     # Get the parameters.
799 :     my ($self) = @_;
800 :     # Get the record.
801 :     my $retVal = $self->{id};
802 :     # If it does not exist, trace a message. We say "no record found" because a
803 :     # missing ID implies a missing record.
804 :     Trace("No record found in result helper.") if T(3) && ! defined($retVal);
805 :     # Return the ID.
806 :     return $retVal;
807 :     }
808 :    
809 :    
810 :    
811 :     =head3 Cache
812 :    
813 : parrello 1.5 my $cacheHash = $rhelp->Cache();
814 : parrello 1.1
815 :     Return a reference to the internal cache. The internal cache is used by the
816 :     run-time value methods to keep stuff in memory between calls for the same
817 :     output line.
818 :    
819 :     =cut
820 :    
821 :     sub Cache {
822 :     # Get the parameters.
823 :     my ($self) = @_;
824 :     # Return the cache.
825 :     return $self->{cache};
826 :     }
827 :    
828 :     =head3 PreferredID
829 :    
830 : parrello 1.5 my $featureID = $rhelp->PreferredID($featureObject);
831 : parrello 1.1
832 :     Return the preferred ID for the specified feature. The feature passed in must be in the
833 :     form of an ERDB feature object. The preferred alias type will be determined using the
834 :     CGI C<AliasType> parameter, and then cached in the feature object using the name
835 :     C<Feature(alias)> so this method can find it easily if it is needed again.
836 :    
837 :     =over 4
838 :    
839 :     =item featureObject
840 :    
841 :     An B<ERDBObject> for the relevant feature.
842 :    
843 :     =item RETURN
844 :    
845 :     The preferred ID for the feature (Locus Tag, Uniprot ID, etc.) if one exists, otherwise
846 :     the FIG ID.
847 :    
848 :     =back
849 :    
850 :     =cut
851 :    
852 :     sub PreferredID {
853 :     # Get the parameters.
854 :     my ($self, $featureObject) = @_;
855 :     # Declare the return variable.
856 :     my $retVal;
857 :     # Check for a cached value.
858 :     if ($featureObject->HasField('Feature(alias)')) {
859 :     $retVal = $featureObject->PrimaryValue('Feature(alias)');
860 :     } else {
861 :     # Here we need to compute the alias. First, get the preferred type.
862 :     my $aliasType = $self->Parent()->GetPreferredAliasType();
863 :     # The fallback is to use the FIG ID.
864 :     my $fid = $featureObject->PrimaryValue('Feature(id)');
865 :     $retVal = $fid;
866 :     # We only need to proceed if the preferred type is NOT FIG.
867 :     if ($aliasType ne 'FIG') {
868 :     # Here we need to find a real alias of the specified type. To start,
869 :     # we need a Sprout object.
870 :     my $sprout = $self->DB();
871 :     # Ask for all the aliases connected to this feature ID.
872 :     my @aliases = $sprout->GetFlat(['IsAliasOf'], 'IsAliasOf(to-link) = ?',
873 :     [$fid], 'IsAliasOf(from-link)');
874 :     # Extract an alias of the preferred type.
875 :     my $foundAlias = AliasAnalysis::Find($aliasType, \@aliases);
876 :     # If an alias was found, use it. Otherwise, the FIG ID will stay in place.
877 :     if (defined($foundAlias)) {
878 :     $retVal = $foundAlias;
879 :     }
880 :     }
881 :     # Save the alias type for future calls.
882 :     $featureObject->AddValues('Feature(alias)', $retVal);
883 :     }
884 :     # Return the ID computed.
885 :     return $retVal;
886 :     }
887 :    
888 :    
889 :     =head2 Column-Related Methods
890 :    
891 :     =head3 Compute
892 :    
893 : parrello 1.5 my $retVal = $rhelp->Compute($type, $colName, $runTimeKey);
894 : parrello 1.1
895 :     Call a column method to return a result. This involves some fancy C<eval> stuff.
896 :     The column method is called as a static method of the relevant subclass.
897 :    
898 :     =over 4
899 :    
900 :     =item type
901 :    
902 :     The type of column data requested: C<title> for the column title, C<style> for the
903 :     column's display style, C<value> for the value to be put in the result cache,
904 :     C<download> for the indicator of how the column should be included in
905 : parrello 1.7 downloads, C<runTimeValue> for the value to be used when the result is
906 :     displayed, and C<valueFromKey> for the value when all we have is the object ID. Note
907 :     that if a run-time value is required, then the normal value must be formatted in
908 :     a special way (see L<Column Processing>).
909 : parrello 1.1
910 :     A little fancy dancing is required for extra columns. For extra columns, only
911 : parrello 1.5 the title, style, and download status are ever requested.
912 : parrello 1.1
913 :     =item colName
914 :    
915 :     Name of the column of interest. The name may contain a colon, in which case
916 :     the column name is the part before the colon and the value after it is
917 : parrello 1.7 passed to the column method as the run-time key. For an extra column, this is
918 :     the extra-column hash.
919 : parrello 1.1
920 :     =item runTimeKey (optional)
921 :    
922 :     If a run-time value is desired, this should be the key taken from the value stored
923 :     in the result cache.
924 :    
925 :     =item RETURN
926 :    
927 :     Returns the desired result for the specified column.
928 :    
929 :     =back
930 :    
931 :     =cut
932 :    
933 :     sub Compute {
934 :     # Get the parameters.
935 :     my ($self, $type, $colName, $runTimeKey) = @_;
936 :     # Declare the return variable.
937 :     my $retVal;
938 :     # Check for an extra column.
939 :     if (ref $colName eq 'HASH') {
940 :     # Look for the appropriate data from the hash.
941 :     if ($type eq 'value') {
942 :     # The caller wants the column value, which is stored in the "extras"
943 :     # member keyed by column name.
944 :     my $realName = $colName->{name};
945 :     $retVal = $self->{extras}->{$realName};
946 : parrello 1.7 Trace("Extra column $realName retrieved value is $retVal.") if T(ResultCache => 3);
947 : parrello 1.1 } else {
948 :     # The other data items are stored in the column name itself.
949 :     $retVal = $colName->{$type};
950 :     }
951 :     } else {
952 : parrello 1.7 # Here we have a built-in column or an object-based column. The search
953 :     # helper chooses which of these to use (usually by adding to a default
954 :     # list), and we use static methods in our subclass to process them. An
955 :     # eval call is used to accomplish the result. First, we do some
956 :     # goofiness so we can deal with the possible absence of a run-time key.
957 :     my $realRunTimeKey = (defined $runTimeKey ? $runTimeKey : undef);
958 :     # Check for a complex column name. The column name fragment is made
959 :     # part of the run-time key.
960 : parrello 1.1 if ($colName =~ /(\S+):(.+)/) {
961 :     $colName = $1;
962 : parrello 1.7 $realRunTimeKey = $2;
963 :     if (defined $runTimeKey) {
964 :     $realRunTimeKey .= "/$runTimeKey";
965 :     }
966 : parrello 1.1 }
967 : parrello 1.7 # Check to see if this is an object-based column.
968 :     $retVal = $self->VirtualCompute($colName, $type, $realRunTimeKey);
969 :     # If we didn't get a result, then the column is truly built-in.
970 :     if (defined $retVal) {
971 :     Trace("Virtual compute for \"colName\" type $type is \"$retVal\".") if T(ResultCache => 3);
972 :     } else {
973 :     # Format a parameter list containing a self reference and optionally
974 :     # the run-time key.
975 :     my @parms = '$self';
976 :     push @parms, "'$realRunTimeKey'" if defined $realRunTimeKey;
977 :     my $parms = join(", ", @parms);
978 :     # Get the result helper type.
979 :     my $rhType = $self->{type};
980 :     # Create the string for returning the desired results.
981 :     my $expression = "${rhType}::$colName($type => $parms)";
982 :     Trace("Evaluating: $expression") if T(ResultCache => 3);
983 :     # Evaluate to get the result. Note we automatically translate
984 :     # undefined results to an empty string.
985 :     $retVal = eval($expression) || "";
986 :     # Check for an error.
987 :     if ($@) {
988 :     Trace("Evaluation failed in Compute of $expression") if T(1);
989 :     Confess("$self->{type} column request failed: $@");
990 :     }
991 :     Trace("Found \"$retVal\" for $colName type $type.") if T(ResultCache => 3);
992 : parrello 1.1 }
993 :     }
994 :     # Return the computed result.
995 :     return $retVal;
996 :     }
997 :    
998 : parrello 1.7 =head3 ColumnMetaData
999 :    
1000 :     my $metadata = $rhelp->ColumnMetaData($colHdr, $idx, $visible);
1001 :    
1002 :     Compute the [[ColumnDisplayList]] metadata for a column. The column is
1003 :     identified either by its name or by the hash reference that specifies the
1004 :     characteristics of an extra column.
1005 :    
1006 :     =over 4
1007 :    
1008 :     =item colHdr
1009 :    
1010 :     Name of the column in question, or the extra column hash for an extra column.
1011 :    
1012 :     =item idx
1013 :    
1014 :     Index position at which the column is to be displayed.
1015 :    
1016 :     =item visible
1017 :    
1018 :     If TRUE, the column will be marked visible; otherwise, it will initially be hidden.
1019 :    
1020 :     =item RETURN
1021 :    
1022 :     Returns a metadata structure suitable for use by the [[DisplayListSelectPm]]
1023 :     component in manipulating this column.
1024 :    
1025 :     =back
1026 :    
1027 :     =cut
1028 :    
1029 :     sub ColumnMetaData {
1030 :     # Get the parameters.
1031 :     my ($self, $colHdr, $idx, $visible) = @_;
1032 :     # Declare the return variable.
1033 :     my $retVal = {};
1034 :     # Get the column label.
1035 :     my $label = $self->Compute(title => $colHdr);
1036 :     # Create the table column object.
1037 :     my $columnThing = { name => $label };
1038 :     # Get our download type.
1039 :     my $dlType = $self->Compute(download => $colHdr);
1040 :     # We use the download type to decide how fancy the column should be. For a
1041 :     # list-type column we want no fanciness. For numbers we allow inequalities,
1042 :     # for strings we allow LIKE stuff.
1043 :     if ($dlType eq 'num') {
1044 :     $columnThing->{filter} = 1;
1045 :     $columnThing->{operator} = "equal";
1046 :     $columnThing->{operators} = [qw(equal unequal less more)];
1047 :     $columnThing->{sortable} = 1;
1048 :     } elsif ($dlType eq 'text') {
1049 :     $columnThing->{filter} = 1;
1050 :     $columnThing->{operator} = "equal";
1051 :     $columnThing->{operators} = [qw(equal unequal like unlike)];
1052 :     $columnThing->{sortable} = 1;
1053 :     }
1054 :     # Store the table column object in the metadata we're returning.
1055 :     $retVal->{header} = $columnThing;
1056 :     # Now we set the visibility, permanence, and order.
1057 :     $retVal->{visible} = ($visible ? 1 : 0);
1058 :     $retVal->{order} = $idx;
1059 :     $retVal->{permanent} = $self->Permanent($colHdr);
1060 :     # Return the result.
1061 :     return $retVal;
1062 :     }
1063 :    
1064 :     =head3 ColumnName
1065 :    
1066 :     my $name = $rhelp->ColumnName($colName);
1067 :    
1068 :     Return the name of a column. Normally, this involves just returning the
1069 :     parameter unmodified. If it's an extra column, however, the input is a
1070 :     hash reference and we have to pull out the name.
1071 :    
1072 :     =over 4
1073 :    
1074 :     =item colName
1075 :    
1076 :     Column name, or the extra column hash.
1077 :    
1078 :     =item RETURN
1079 :    
1080 :     Returns a string that may be used as a column identifier.
1081 :    
1082 :     =back
1083 :    
1084 :     =cut
1085 :    
1086 :     sub ColumnName {
1087 :     # Get the parameters.
1088 :     my ($self, $colName) = @_;
1089 :     # Declare the return variable.
1090 :     my $retVal;
1091 :     # Check the column type.
1092 :     if (ref $colName eq 'HASH') {
1093 :     $retVal = $colName->{name};
1094 :     } else {
1095 :     $retVal = $colName;
1096 :     }
1097 :     # Return the result.
1098 :     return $retVal;
1099 :     }
1100 :    
1101 :    
1102 : parrello 1.1 =head3 ColumnDownload
1103 :    
1104 : parrello 1.5 my $flag = $rhelp->ColumnDownload($colName);
1105 : parrello 1.1
1106 :     Return the type of data in the column, or an empty string if it should
1107 :     not be downloaded. In general, all columns are downloaded except those
1108 :     that are graphic representations of something.
1109 :    
1110 :     =over 4
1111 :    
1112 :     =item colName
1113 :    
1114 :     Name of the column in question.
1115 :    
1116 :     =item RETURN
1117 :    
1118 :     Returns one of the download data types discussed in L</Column Processing>.
1119 :    
1120 :     =back
1121 :    
1122 :     =cut
1123 :    
1124 :     sub ColumnDownload {
1125 :     # Get the parameters.
1126 :     my ($self, $colName) = @_;
1127 :     # Compute the result.
1128 :     my $retVal = $self->Compute(download => $colName);
1129 :     # Return it.
1130 :     return $retVal;
1131 :     }
1132 :    
1133 :     =head3 ColumnTitle
1134 :    
1135 : parrello 1.5 my $titleHtml = $rhelp->ColumnTitle($colName);
1136 : parrello 1.1
1137 :     Return the title to be used in the result table for the specified column.
1138 :    
1139 :     =over 4
1140 :    
1141 :     =item colName
1142 :    
1143 :     Name of the relevant column.
1144 :    
1145 :     =item RETURN
1146 :    
1147 :     Returns the html to be used for the column title.
1148 :    
1149 :     =back
1150 :    
1151 :     =cut
1152 :    
1153 :     sub ColumnTitle {
1154 :     # Get the parameters.
1155 :     my ($self, $colName) = @_;
1156 :     # Compute the result.
1157 :     my $retVal = $self->Compute(title => $colName);
1158 :     # Return it.
1159 :     return $retVal;
1160 :     }
1161 :    
1162 :     =head3 ColumnValue
1163 :    
1164 : parrello 1.5 my $htmlValue = $rhelp->ColumnValue($colName);
1165 : parrello 1.1
1166 :     Return the display value for a column. This could be HTML text or it
1167 :     could be a run-time value specification. The column value is computed
1168 :     using the data record currently stored in the result helper.
1169 :    
1170 :     =over 4
1171 :    
1172 :     =item colName
1173 :    
1174 :     Name of the column whose value is desired.
1175 :    
1176 :     =item RETURN
1177 :    
1178 :     Returns the value to be stored in the result cache.
1179 :    
1180 :     =back
1181 :    
1182 :     =cut
1183 :    
1184 :     sub ColumnValue {
1185 :     # Get the parameters.
1186 :     my ($self, $colName) = @_;
1187 :     # Compute the return value.
1188 :     my $retVal = $self->Compute(value => $colName);
1189 :     # Return it.
1190 :     return $retVal;
1191 :     }
1192 :    
1193 :     =head3 ColumnStyle
1194 :    
1195 : parrello 1.5 my $className = $rhelp->ColumnStyle($colName);
1196 : parrello 1.1
1197 :     Return the display style for the specified column. This must be a classname
1198 :     defined for C<TD> tags in the active style sheet.
1199 :    
1200 :     =over 4
1201 :    
1202 :     =item colName
1203 :    
1204 :     Name of the relevant column.
1205 :    
1206 :     =item RETURN
1207 :    
1208 :     Returns the name of the style class to be used for this column's cells.
1209 :    
1210 :     =back
1211 :    
1212 :     =cut
1213 :    
1214 :     sub ColumnStyle {
1215 :     # Get the parameters.
1216 :     my ($self, $colName) = @_;
1217 :     # Compute the return value.
1218 :     my $retVal = $self->Compute(style => $colName);
1219 :     # Return it.
1220 :     return $retVal;
1221 :     }
1222 :    
1223 :     =head3 GetRunTimeValues
1224 :    
1225 : parrello 1.5 my @valueHtml = $rhelp->GetRunTimeValues(@cols);
1226 : parrello 1.1
1227 :     Return the run-time values of a row of columns. The incoming values contain
1228 :     the actual column contents. Run-time columns will be identified by the
1229 :     leading C<%%> marker. The run-time columns are converted in sequence
1230 :     using methods in the base class.
1231 :    
1232 :     =over 4
1233 :    
1234 :     =item cols
1235 :    
1236 :     A list of columns. Runtime columns will be of the format C<%%>I<colName>C<=>I<key>,
1237 :     where I<colName> is the actual column name and I<key> is the key to be passed to
1238 :     the evaluator. Columns that do not have this format are unchanged.
1239 :    
1240 :     =item RETURN
1241 :    
1242 :     Returns a list of the final values for all the run-time columns.
1243 :    
1244 :     =back
1245 :    
1246 :     =cut
1247 :    
1248 :     sub GetRunTimeValues {
1249 :     # Get the parameters.
1250 :     my ($self, @cols) = @_;
1251 :     # Declare the return value.
1252 :     my @retVal = ();
1253 :     # Clear the cache. The run-time value methods can store stuff
1254 :     # in here to save computation time.
1255 :     $self->{cache} = {};
1256 :     # Loop through the columns.
1257 :     for my $col (@cols) {
1258 :     # Declare a holding variable.
1259 :     my $retVal;
1260 : parrello 1.7 Trace("Value \"$retVal\" found in column.") if T(ResultCache => 3);
1261 : parrello 1.1 # Parse the column data.
1262 :     if ($col =~ /^%%(\w+)=(.+)/) {
1263 :     # It parsed as a run-time value, so call the Compute method.
1264 :     $retVal = $self->Compute(runTimeValue => $1, $2);
1265 :     } else {
1266 :     # Here it's a search-time value, so we leave it unchanged.
1267 :     $retVal = $col;
1268 :     }
1269 :     # Add this column to the result list.
1270 :     push @retVal, $retVal;
1271 :     }
1272 :     # Return the result.
1273 :     return @retVal;
1274 :     }
1275 :    
1276 :     =head3 SetColumns
1277 :    
1278 : parrello 1.5 $rhelp->SetColumns(@cols);
1279 : parrello 1.1
1280 :     Store the specified object columns. These are the columns computed by the search
1281 :     framework, and should generally be specified first. If the search itself is
1282 :     going to generate additional data, the columns for displaying this additional
1283 :     data should be specified by a subsequent call to L</AddExtraColumn>.
1284 :    
1285 :     =over 4
1286 :    
1287 :     =item cols
1288 :    
1289 :     A list of column names. These must correspond to names defined in the result
1290 :     helper subclass (see L</Column Processing>).
1291 :    
1292 :     =back
1293 :    
1294 :     =cut
1295 :    
1296 :     sub SetColumns {
1297 :     # Get the parameters.
1298 :     my ($self, @cols) = @_;
1299 :     # Store the columns in the column list. Note that this erases any
1300 :     # previous column information.
1301 :     $self->{columns} = \@cols;
1302 :     }
1303 :    
1304 :     =head3 AddExtraColumn
1305 :    
1306 : parrello 1.5 $rhelp->AddExtraColumn($name => $loc, %data);
1307 : parrello 1.1
1308 :     Add an extra column to the column list at a specified location.
1309 :    
1310 :     =over 4
1311 :    
1312 :     =item name
1313 :    
1314 :     The name of the column to add.
1315 :    
1316 :     =item loc
1317 :    
1318 :     The location at which the column should be displayed. The column is added
1319 :     at the specified column location in the column list. It may be moved,
1320 :     however, if subsequent column additions are placed at or before its
1321 :     specified location. To put a column at the beginning, specify C<0>;
1322 :     to put it at the end specify C<undef>.
1323 :    
1324 :     =item data
1325 :    
1326 :     A hash specifying the title, style, and download flag for the extra
1327 :     column. The download flag (key C<download>) should specify the type
1328 :     of data in the column. The title (key C<title>) should be the name
1329 :     displayed for the column in the result display table. The style
1330 :     (key C<style>) should be the style class used for displaying the cells
1331 :     in the column.
1332 :    
1333 :     =back
1334 :    
1335 :     =cut
1336 :    
1337 :     sub AddExtraColumn {
1338 :     # Get the parameters.
1339 :     my ($self, $name, $loc, %data) = @_;
1340 :     # Add the name to the column hash.
1341 :     $data{name} = $name;
1342 :     # Store the result in the column list.
1343 :     $self->_StoreColumnSpec(\%data, $loc);
1344 :     }
1345 :    
1346 :     =head3 AddOptionalColumn
1347 :    
1348 : parrello 1.5 $rhelp->AddOptionalColumn($name => $loc);
1349 : parrello 1.1
1350 :     Store the specified column name in the column list at the
1351 :     specified location. The column name must be one that
1352 :     is known to the result helper subclass. This method
1353 :     allows ordinary columns (as opposed to extra columns)
1354 :     to be added after the initial L</SetColumns> call.
1355 :    
1356 :     =over 4
1357 :    
1358 :     =item name
1359 :    
1360 :     Name of the desired column.
1361 :    
1362 :     =item location
1363 :    
1364 :     Location at which the desired column should be stored.
1365 :    
1366 :     =back
1367 :    
1368 :     =cut
1369 :    
1370 :     sub AddOptionalColumn {
1371 :     # Get the parameters.
1372 :     my ($self, $name => $loc) = @_;
1373 :     # Currently, there is no extra work required here, but that
1374 :     # may change.
1375 :     $self->_StoreColumnSpec($name, $loc);
1376 :     }
1377 :    
1378 :     =head3 PutExtraColumns
1379 :    
1380 : parrello 1.5 $rhelp->PutExtraColumns(name1 => value1, name2 => value2, ...);
1381 : parrello 1.1
1382 :     Store the values of one or more extra columns. If a search produces extra columns (that is,
1383 :     columns whose data is determined by the search instead of queries against the database), then
1384 :     for each row of output, the search must call this method to specify the values of the various
1385 :     extra columns. Multiple calls to this method are allowed, in which case each call either
1386 :     overrides or adds to the values specified by the prior call.
1387 :    
1388 :     =over 4
1389 :    
1390 :     =item extraColumnMap
1391 :    
1392 :     A hash keyed on extra column name that maps the column names to the column's values for the current
1393 :     row of table data.
1394 :    
1395 :     =back
1396 :    
1397 :     =cut
1398 :    
1399 :     sub PutExtraColumns {
1400 :     # Get the parameters.
1401 :     my ($self, %extraColumnMap) = @_;
1402 :     # Copy the hash values into the extra column hash.
1403 :     my $counter = 0;
1404 :     for my $name (keys %extraColumnMap) {
1405 :     $self->{extras}->{$name} = $extraColumnMap{$name};
1406 :     Trace("Extra column $name has value $extraColumnMap{$name}.") if T(4);
1407 :     }
1408 :     }
1409 :    
1410 :     =head2 Internal Utilities
1411 :    
1412 :     =head3 StoreColumnSpec
1413 :    
1414 : parrello 1.5 $rhelp->_StoreColumnSpec($column, $location);
1415 : parrello 1.1
1416 :     Store the specified column information at the specified location in the column name list.
1417 :     The information is a string for an ordinary column and a hash for an extra column. The
1418 :     actual location at which the column is stored will be adjusted so that there are no
1419 :     gaps in the list. If the location is undefined, it defaults to the end. Thus, C<0>
1420 : parrello 1.7 will always store at the beginning and C<undef> will always store at the end. If the
1421 :     column is already in the list this method will have no effect.
1422 : parrello 1.1
1423 :     =over 4
1424 :    
1425 :     =item column
1426 :    
1427 :     A column name or extra-column hash to be stored in the column list.
1428 :    
1429 :     =item location
1430 :    
1431 :     The index at which the column name should be stored, or C<undef> to store it
1432 :     at the end.
1433 :    
1434 :     =back
1435 :    
1436 :     =cut
1437 :    
1438 :     sub _StoreColumnSpec {
1439 :     # Get the parameters.
1440 :     my ($self, $column, $location) = @_;
1441 : parrello 1.7 # Get the current column list.
1442 :     my $columnList = $self->{columns};
1443 : parrello 1.1 # Compute the current column count.
1444 : parrello 1.7 my $columnCount = scalar @$columnList;
1445 :     # See if the column is already present.
1446 :     my $alreadyPresent;
1447 :     if (ref $column eq 'HASH') {
1448 :     Trace("Checking extra column $column->{name}.") if T(3);
1449 :     my @extras = grep { ref $_ eq 'HASH' } @$columnList;
1450 :     $alreadyPresent = grep { $_->{name} eq $column->{name} } @extras;
1451 :     } else {
1452 :     Trace("Checking optional column $column.") if T(3);
1453 :     $alreadyPresent = grep { $_ eq $column } @$columnList;
1454 :     }
1455 :     # Only proceed if the column is NOT already present.
1456 :     if ($alreadyPresent) {
1457 :     Trace("Column is already present.") if T(3);
1458 :     } else {
1459 :     # Adjust the location.
1460 :     if (! defined($location) || $location > $columnCount) {
1461 :     $location = $columnCount;
1462 :     }
1463 :     # Insert the column into the list.
1464 :     splice @{$self->{columns}}, $location, 0, $column;
1465 :     Trace("Column inserted at position $location.") if T(3);
1466 : parrello 1.1 }
1467 :     }
1468 :    
1469 :    
1470 :     =head2 Virtual Methods
1471 :    
1472 :     The following methods can be overridden by the subclass. In some cases, they
1473 :     must be overridden.
1474 :    
1475 : parrello 1.7 =head3 VirtualCompute
1476 :    
1477 :     my $dataValue = $rhelp->VirtualCompute($colName, $type, $runTimeKey);
1478 :    
1479 :     Retrieve the column data of the specified type for the specified column
1480 :     using the optional run-time key.
1481 :    
1482 :     This method is called after extra columns have been handled but before
1483 :     built-in columns are processed. The subclass can use this method to
1484 :     handle columns that are object-based or otherwise too complex or varied
1485 :     for the standard built-in column protocol. If the column name isn't
1486 :     recognized, this method should return an undefined value. This will
1487 :     happen automatically if the base class method is not overridden.
1488 :    
1489 :     =over 4
1490 :    
1491 :     =item colName
1492 :    
1493 :     Name of the relevant column.
1494 :    
1495 :     =item type
1496 :    
1497 :     The type of column data requested: C<title> for the column title, C<style> for the
1498 :     column's display style, C<value> for the value to be put in the result cache,
1499 :     C<download> for the indicator of how the column should be included in
1500 :     downloads, and C<runTimeValue> for the value to be used when the result is
1501 :     displayed. Note that if a run-time value is required, then the normal value
1502 :     must be formatted in a special way (see L<Column Processing>).
1503 :    
1504 :     =item runTimeKey (optional)
1505 :    
1506 :     If a run-time value is desired, this should be the key taken from the value stored
1507 :     in the result cache.
1508 :    
1509 :     =item RETURN
1510 :    
1511 :     Returns the requested value for the named column, or C<undef> if the column
1512 :     is built in to the subclass using the old protocol.
1513 :    
1514 :     =back
1515 :    
1516 :     =cut
1517 :    
1518 :     sub VirtualCompute {
1519 :     # Get the parameters.
1520 :     my ($self, $colName, $type, $runTimeKey) = @_;
1521 :     # Declare the return variable.
1522 :     my $retVal;
1523 :     # Return the result.
1524 :     return $retVal;
1525 :     }
1526 :    
1527 : parrello 1.1 =head3 DefaultResultColumns
1528 :    
1529 : parrello 1.5 my @colNames = $rhelp->DefaultResultColumns();
1530 : parrello 1.1
1531 :     Return a list of the default columns to be used by searches with this
1532 :     type of result. Note that the actual default columns are computed by
1533 :     the search helper. This method is only needed if the search helper doesn't
1534 :     care.
1535 :    
1536 :     The columns returned should be in the form of column names, all of which
1537 :     must be defined by the result helper class.
1538 :    
1539 :     =cut
1540 :    
1541 :     sub DefaultResultColumns {
1542 :     # This method must be overridden.
1543 :     Confess("Pure virtual call to DefaultResultColumns.");
1544 :     }
1545 :    
1546 :     =head3 MoreDownloadFormats
1547 :    
1548 : parrello 1.5 $rhelp->MoreDownloadFormats(\%dlTypes);
1549 : parrello 1.1
1550 :     Add additional supported download formats to the type table. The table is a
1551 :     hash keyed on the download type code for which the values are the download
1552 :     descriptions. There is a special syntax that allows the placement of text
1553 :     fields inside the description. Use square brackets containing the name
1554 :     for the text field. The field will come in to the download request as
1555 :     a GET-type field.
1556 :    
1557 :     =over 4
1558 :    
1559 :     =item dlTypes
1560 :    
1561 :     Reference to a download-type hash. The purpose of this method is to add more
1562 :     download types relevant to the particular result type. Each type is described
1563 :     by a key (the download type itself) and a description. The description can
1564 :     contain a single text field that may be used to pass a parameter to the
1565 :     download. The text field is of the format C<[>I<fieldName>C<]>,
1566 :     where I<fieldName> is the name to give the text field's parameter in the
1567 :     generated download URL.
1568 :    
1569 :     =back
1570 :    
1571 :     =cut
1572 :    
1573 :     sub MoreDownloadFormats {
1574 :     Trace("Pure virtual call to MoreDownloadFormats.") if T(3);
1575 :     # Take no action.
1576 :     }
1577 :    
1578 :     =head3 MoreDownloadDataMethods
1579 :    
1580 : parrello 1.5 my @lines = $rhelp->MoreDownloadDataMethods($objectID, $dlType, \@cols, \@colHdrs);
1581 : parrello 1.1
1582 :     Create one or more lines of download data for a download of the specified type. Override
1583 :     this method if you need to process more download types than the default C<tbl> method.
1584 :    
1585 :     =over 4
1586 :    
1587 :     =item objectID
1588 :    
1589 :     ID of the object for this data row.
1590 :    
1591 :     =item dlType
1592 :    
1593 :     Download type (e.g. C<fasta>, etc.)
1594 :    
1595 :     =item cols
1596 :    
1597 :     Reference to a list of the data columns from the result cache, or alternatively
1598 :     the string C<header> (indicating that header lines are desired) or C<footer>
1599 :     (indicating that footer lines are desired).
1600 :    
1601 :     =item colHdrs
1602 :    
1603 :     The list of column headers from the result cache.
1604 :    
1605 :     =item RETURN
1606 :    
1607 :     Returns an array of data lines to output to the download file.
1608 :    
1609 :     =back
1610 :    
1611 :     =cut
1612 :    
1613 :     sub MoreDownloadDataMethods {
1614 :     # Get the parameters.
1615 :     my ($self, $objectID, $dlType, $cols, $colHdrs) = @_;
1616 :     # If we need to call this method, then the subclass should have overridden it.
1617 :     Confess("Invalid download type \"$dlType\" specified for result class $self->{type}.");
1618 :     }
1619 :    
1620 : parrello 1.7 =head3 GetColumnNameList
1621 :    
1622 :     my @names = $rhelp->GetColumnNameList();
1623 :    
1624 :     Return a complete list of the names of columns available for this result
1625 :     helper. The base class method simply regurgitates the default columns.
1626 :    
1627 :     =cut
1628 :    
1629 :     sub GetColumnNameList {
1630 :     # Get the parameters.
1631 :     my ($self) = @_;
1632 :     # Return the result.
1633 :     return $self->DefaultResultColumns();
1634 :     }
1635 :    
1636 :     =head3 Permanent
1637 :    
1638 :     my $flag = $rhelp->Permanent($colName);
1639 :    
1640 :     Return TRUE if the specified column should be permanent when used in a
1641 :     Seed Viewer table, else FALSE.
1642 :    
1643 :     =over 4
1644 :    
1645 :     =item colName
1646 :    
1647 :     Name of the column to check.
1648 :    
1649 :     =item RETURN
1650 :    
1651 :     Returns TRUE if the column should be permanent, else FALSE.
1652 :    
1653 :     =back
1654 :    
1655 :     =cut
1656 :    
1657 :     sub Permanent {
1658 :     # Get the parameters.
1659 :     my ($self, $colName) = @_;
1660 :     # Declare the return variable.
1661 :     my $retVal;
1662 :     Confess("Pure virtual method Permanent called.");
1663 :     # Return the result.
1664 :     return $retVal;
1665 :     }
1666 :    
1667 :     =head3 Initialize
1668 :    
1669 :     $rhelp->Initialize();
1670 :    
1671 :     Perform any initialization required after construction of the helper.
1672 :    
1673 :     =cut
1674 :    
1675 :     sub Initialize {
1676 :     # The default is to do nothing.
1677 :     }
1678 :    
1679 :    
1680 :    
1681 :    
1682 : parrello 1.5 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3