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

Diff of /Sprout/ResultHelper.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Wed Jul 25 16:20:20 2007 UTC revision 1.7, Mon Jan 19 21:56:19 2009 UTC
# Line 73  Line 73 
73              $rhelp->FeatureName();              $rhelp->FeatureName();
74          } elsif ($type eq 'runTimeValue') {          } elsif ($type eq 'runTimeValue') {
75              # This field does not require a runtime value.              # This field does not require a runtime value.
76            } elsif ($type eq 'valueFromKey') {
77                # Get the feature name from the feature ID.
78                $rhelp->FeatureNameFromID($key);
79          };          };
80          return $retVal;          return $retVal;
81      }      }
# Line 117  Line 120 
120  Return the value to be displayed. This method is only used when the information  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.  is not easily available at the time the result cache is built.
122    
123    =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  =back  =back
129    
130  The idea behind this somewhat cumbersome design is that new columns can be added  The idea behind this somewhat cumbersome design is that new columns can be added
# Line 132  Line 140 
140  cache is displayed. Because a search can return thousands of results, but only 50 or  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.  so are displayed at a time, this makes a big difference.
142    
143  =head2 Extra Columns  =head3 Extra Columns
144    
145  It is necessary for individual searches to be able to create output columns specific  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.  to the type of search. These are called extra columns.
# Line 152  Line 160 
160  is thawed into the hash so that the various options are identical to what they were  is thawed into the hash so that the various options are identical to what they were
161  when the result cache was created.  when the result cache was created.
162    
163  Extra columns are the most volatile requirement in the whole search system. I will  =head3 Object-Based Columns
164  count myself happy if this implementation of them lasts more than a week.  
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    
172  =cut  =cut
173    
# Line 164  Line 178 
178    
179  =head3 new  =head3 new
180    
181  C<< my $rhelp = ResultHelper->new($shelp); >>      my $rhelp = ResultHelper->new($shelp);
182    
183  Construct a new ResultHelper object to serve the specified search helper.  Construct a new ResultHelper object to serve the specified search helper.
184    
# Line 232  Line 246 
246    
247  =head3 DB  =head3 DB
248    
249  C<< my $sprout = $rhelp->DB(); >>      my $sprout = $rhelp->DB();
250    
251  Return the Sprout object for accessing the database.  Return the Sprout object for accessing the database.
252    
# Line 247  Line 261 
261    
262  =head3 PutData  =head3 PutData
263    
264  C<< $rhelp->PutData($sortKey, $id, $record); >>      $rhelp->PutData($sortKey, $id, $record);
265    
266  Store a line of data in the result file.  Store a line of data in the result file.
267    
# Line 289  Line 303 
303    
304  =head3 GetColumnHeaders  =head3 GetColumnHeaders
305    
306  C<< my $colHdrs = $rhelp->GetColumnHeaders(); >>      my $colHdrs = $rhelp->GetColumnHeaders();
307    
308  Return the list of column headers for this session. The return value is a  Return the list of column headers for this session. The return value is a
309  reference to the live column header list.  reference to the live column header list.
# Line 305  Line 319 
319    
320  =head3 DownloadFormatsAvailable  =head3 DownloadFormatsAvailable
321    
322  C<< my %dlTypes = $rhelp->DownloadFormatsAvailable(); >>      my %dlTypes = $rhelp->DownloadFormatsAvailable();
323    
324  Return a hash mapping each download type to a download description. The default is  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,  the C<tbl> format, which is a tab-delimited download, and the C<xml> format,
# Line 329  Line 343 
343    
344  =head3 DownloadDataLine  =head3 DownloadDataLine
345    
346  C<< $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs); >>      $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs);
347    
348  Return one or more lines of download data. The exact data returned depends on the  Return one or more lines of download data. The exact data returned depends on the
349  download type.  download type.
# Line 396  Line 410 
410              # will contain the name of each column, its value, and its download format.              # will contain the name of each column, its value, and its download format.
411              my @actualCols = ();              my @actualCols = ();
412              for (my $i = 0; $i <= $#keepCols; $i++) {              for (my $i = 0; $i <= $#keepCols; $i++) {
413                    Trace("Keep flag for $i is $keepCols[$i].") if T(4);
414                  if ($keepCols[$i]) {                  if ($keepCols[$i]) {
415                      push @actualCols, [$colHdrs->[$i], $self->GetRunTimeValues($cols->[$i]), $keepCols[$i]];                      push @actualCols, [$colHdrs->[$i], $self->GetRunTimeValues($cols->[$i]), $keepCols[$i]];
416                  }                  }
417              }              }
418                Trace(scalar(@actualCols) . " columns kept.") if T(4);
419              # Now it's time to do the actual writing, so we need to know if this              # Now it's time to do the actual writing, so we need to know if this
420              # is XML or tab-delimited.              # is XML or tab-delimited.
421              if ($dlType eq 'tbl') {              if ($dlType eq 'tbl') {
# Line 407  Line 423 
423                  my @actual = map { HtmlCleanup($_->[1], $_->[2]) } @actualCols;                  my @actual = map { HtmlCleanup($_->[1], $_->[2]) } @actualCols;
424                  # Return the line of data.                  # Return the line of data.
425                  push @retVal, join("\t", @actual);                  push @retVal, join("\t", @actual);
426                    Trace("Output line is\n" . join("\n", @actual)) if T(4);
427              } elsif ($dlType eq 'xml') {              } elsif ($dlType eq 'xml') {
428                  # Convert to XML. Since a single XML tag can contain multiple lines, we re-split them.                  # Convert to XML.
429                  # This is important, because when the lines are output we need to insure the correct                  my @actual = ();
430                  # EOL character is used.                  for my $actualCol (@actualCols) {
431                  my @actual = map { split /\n/, "<$_->[0]>" . XmlCleanup($_->[1], $_->[2]) . "</$_->[0]>" } @actualCols;                      # 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                  # Return the XML object.                  # Return the XML object.
449                  push @retVal, XML_INDENT x 1 . "<Item id=\"$objectID\">";                  push @retVal, XML_INDENT x 1 . "<Item id=\"$objectID\">";
450                  push @retVal, map { XML_INDENT x 2 . $_ } @actual;                  push @retVal, map { XML_INDENT x 2 . $_ } @actual;
# Line 429  Line 462 
462    
463  =head3 Formlet  =head3 Formlet
464    
465  C<< my $html = $rhelp->Formlet($caption, $url, $target, %parms); >>      my $html = $rhelp->Formlet($caption, $url, $target, %parms);
466    
467  Create a mini-form that posts to the specified URL with the specified parameters. The  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  parameters will be stored in hidden fields, and the form's only visible control will
# Line 470  Line 503 
503      # Compute the target HTML.      # Compute the target HTML.
504      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $targetHtml = ($target ? " target=\"$target\"" : "");
505      # Start the form.      # Start the form.
506      my $retVal = "<form method=\"POST\" action=\"$url\"$target>";      my $retVal = "<form method=\"POST\" action=\"$FIG_Config::cgi_url/$url\"$target>";
507      # Add the parameters.      # Add the parameters.
508      for my $parm (keys %parms) {      for my $parm (keys %parms) {
509          $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";          $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
# Line 485  Line 518 
518    
519  =head3 HtmlCleanup  =head3 HtmlCleanup
520    
521  C<< my $text = ResultHelper::HtmlCleanup($htmlText, $type); >>      my $text = ResultHelper::HtmlCleanup($htmlText, $type);
522    
523  Take a string of Html text and clean it up so it appears as real text.  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  Note that this method is not yet sophisticated enough to detect right-angle brackets
# Line 523  Line 556 
556          $retVal = ButtonToLink($htmlText);          $retVal = ButtonToLink($htmlText);
557      } elsif ($type eq 'align') {      } elsif ($type eq 'align') {
558          # Here we have multiple lines. Convert the new-lines to serial commas.          # Here we have multiple lines. Convert the new-lines to serial commas.
559            $retVal = $htmlText;
560          $retVal =~ s/<br\s*\/?>/, /g;          $retVal =~ s/<br\s*\/?>/, /g;
561            # Convert &nbsp; marks to real spaces.
562            $retVal =~ s/&nbsp;/ /g;
563      } else {      } else {
564          # Here we have normal HTML. Start by taking the raw text.          # Here we have normal HTML. Start by taking the raw text.
565          $retVal = $htmlText;          $retVal = $htmlText;
566          # Delete any tags. This is a very simplistic algorithm that will fail if there          # Delete any tags. This is a very simplistic algorithm that will fail if there
567          # is a right angle bracket inside a parameter string.          # is a right angle bracket inside a parameter string.
568          $retVal =~ s/<[^>]+>//g;          $retVal =~ s/<[^>]+>//g;
569            # Convert &nbsp; marks to real spaces.
570            $retVal =~ s/&nbsp;/ /g;
571          # Unescape the & tags.          # Unescape the & tags.
572          $retVal = CGI::unescapeHTML($retVal);          $retVal = CGI::unescapeHTML($retVal);
573      }      }
# Line 539  Line 577 
577    
578  =head3 XmlCleanup  =head3 XmlCleanup
579    
580  C<< my $text = ResultHelper::XmlCleanup($htmlText, $type); >>      my $text = ResultHelper::XmlCleanup($htmlText, $type);
581    
582  Take a string of Html text and clean it up so it appears as html.  Take a string of Html text and clean it up so it appears as html.
583    
# Line 577  Line 615 
615      } elsif ($type eq 'align') {      } elsif ($type eq 'align') {
616          # Here we have aligned text. This is converted into an XML array of lines.          # Here we have aligned text. This is converted into an XML array of lines.
617          # First, we find the break tags.          # First, we find the break tags.
618            Trace("Alignment cleanup of: $htmlText") if T(4);
619          my @lines = split /<br[^>]+>/, $htmlText;          my @lines = split /<br[^>]+>/, $htmlText;
620            Trace(scalar(@lines) . " lines found.") if T(4);
621          # Format the lines as an XML array. The extra new-line causes the first array          # 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.          # element to be on a separate line from the first item tag.
623          $retVal = "\n" . map { XML_INDENT . "<line>$_</line>\n" } @lines;          $retVal = "\n" . join("", map { XML_INDENT . "<line>$_</line>\n" } @lines);
624      } elsif ($type eq 'list') {      } elsif ($type eq 'list') {
625          # Here we have a comma-delimited list of possibly-linked strings. We will convert it to          # 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.          # an XML array. First, we get the pieces.
# Line 606  Line 646 
646    
647  =head3 ButtonToLink  =head3 ButtonToLink
648    
649  C<< my $url = ResultHelper::ButtonToLink($htmlText); >>      my $url = ResultHelper::ButtonToLink($htmlText);
650    
651  Convert a formlet or fake button to a link. This process is bound very tightly with  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  the way L</Formlet> and L</FakeButton> generate Html. A change there requires a
# Line 655  Line 695 
695      }      }
696      # Now a final cleanup. If we have a URL and it's relative, we need to add our path to it.      # 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://#) {      if ($retVal && $retVal !~ m#http://#) {
698          # The link doesn't begin with http, so we must fix it. Get our URL.          # The link doesn't begin with http, so we must fix it.
699          my $cgi = CGI->new();          $retVal = "$FIG_Config::cgi_url/$retVal";
         my $selfURL = $cgi->url(-full => 1);  
         # Strip off the page name.  
         $selfURL =~ m#^(.+)/[^/]+$#;  
         my $path = $1;  
         # Combine it with the relative URL.  
         $retVal = "$1/$retVal";  
700      }      }
701      # Return the result.      # Return the result.
702      return $retVal;      return $retVal;
# Line 670  Line 704 
704    
705  =head3 FakeButton  =head3 FakeButton
706    
707  C<< my $html = $rhelp->FakeButton($caption, $url, $target, %parms); >>      my $html = $rhelp->FakeButton($caption, $url, $target, %parms);
708    
709  Create a fake button that hyperlinks to the specified URL with the specified parameters.  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  Unlike a real button, this one won't visibly click, but it will take the user to the
# Line 709  Line 743 
743      # Declare the return variable.      # Declare the return variable.
744      my $retVal;      my $retVal;
745      # Compute the target URL.      # Compute the target URL.
746      my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);      my $targetUrl = "$FIG_Config::cgi_url/$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
747      # Compute the target-frame HTML.      # Compute the target-frame HTML.
748      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $targetHtml = ($target ? " target=\"$target\"" : "");
749      # Assemble the result.      # Assemble the result.
# Line 718  Line 752 
752    
753  =head3 Parent  =head3 Parent
754    
755  C<< my $shelp = $rhelp->Parent(); >>      my $shelp = $rhelp->Parent();
756    
757  Return this helper's parent search helper.  Return this helper's parent search helper.
758    
# Line 733  Line 767 
767    
768  =head3 Record  =head3 Record
769    
770  C<< my $erdbObject = $rhelp->Record(); >>      my $erdbObject = $rhelp->Record();
771    
772  Return the record currently stored in this object. The record contains the data for  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>.  the result output line being built, and is in the form of a B<ERDBObject>.
# Line 753  Line 787 
787    
788  =head3 ID  =head3 ID
789    
790  C<< my $id = $rhelp->ID(); >>      my $id = $rhelp->ID();
791    
792  Return the ID for the record currently stored in this object (if any).  Return the ID for the record currently stored in this object (if any).
793    
# Line 776  Line 810 
810    
811  =head3 Cache  =head3 Cache
812    
813  C<< my $cacheHash = $rhelp->Cache(); >>      my $cacheHash = $rhelp->Cache();
814    
815  Return a reference to the internal cache. The internal cache is used by the  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  run-time value methods to keep stuff in memory between calls for the same
# Line 793  Line 827 
827    
828  =head3 PreferredID  =head3 PreferredID
829    
830  C<< my $featureID = $rhelp->PreferredID($featureObject); >>      my $featureID = $rhelp->PreferredID($featureObject);
831    
832  Return the preferred ID for the specified feature. The feature passed in must be in the  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  form of an ERDB feature object. The preferred alias type will be determined using the
# Line 856  Line 890 
890    
891  =head3 Compute  =head3 Compute
892    
893  C<< my $retVal = $rhelp->Compute($type, $colName, $runTimeKey); >>      my $retVal = $rhelp->Compute($type, $colName, $runTimeKey);
894    
895  Call a column method to return a result. This involves some fancy C<eval> stuff.  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.  The column method is called as a static method of the relevant subclass.
# Line 868  Line 902 
902  The type of column data requested: C<title> for the column title, C<style> for the  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,  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  C<download> for the indicator of how the column should be included in
905  downloads, and C<runTimeValue> for the value to be used when the result is  downloads, C<runTimeValue> for the value to be used when the result is
906  displayed. Note that if a run-time value is required, then the normal value  displayed, and C<valueFromKey> for the value when all we have is the object ID. Note
907  must be formatted in a special way (see L<Column Processing>).  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    
910  A little fancy dancing is required for extra columns. For extra columns, only  A little fancy dancing is required for extra columns. For extra columns, only
911  the title, style, and download status are ever requested.  the title, style, and download status are ever requested.
# Line 879  Line 914 
914    
915  Name of the column of interest. The name may contain a colon, in which case  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  the column name is the part before the colon and the value after it is
917  passed to the column method as the run-time key.  passed to the column method as the run-time key. For an extra column, this is
918    the extra-column hash.
919    
920  =item runTimeKey (optional)  =item runTimeKey (optional)
921    
# Line 907  Line 943 
943              # member keyed by column name.              # member keyed by column name.
944              my $realName = $colName->{name};              my $realName = $colName->{name};
945              $retVal = $self->{extras}->{$realName};              $retVal = $self->{extras}->{$realName};
946              Trace("Extra column $realName retrieved value is $retVal.") if T(4);              Trace("Extra column $realName retrieved value is $retVal.") if T(ResultCache => 3);
947          } else {          } else {
948              # The other data items are stored in the column name itself.              # The other data items are stored in the column name itself.
949              $retVal = $colName->{$type};              $retVal = $colName->{$type};
950          }          }
951      } else {      } else {
952          # Here we have a real built-in column. The search helper chooses which of          # Here we have a built-in column or an object-based column. The search
953          # these to use (usually by adding to a default list), and we use static          # helper chooses which of these to use (usually by adding to a default
954          # methods in our subclass to process them. An eval call is used to          # list), and we use static methods in our subclass to process them. An
955          # accomplish the result. First, we do some goofiness so we can deal          # eval call is used to accomplish the result. First, we do some
956          # with the possible absence of a run-time key.          # goofiness so we can deal with the possible absence of a run-time key.
957          my $realRunTimeKey = (defined $runTimeKey ? ", '$runTimeKey'" : "");          my $realRunTimeKey = (defined $runTimeKey ? $runTimeKey : undef);
958          # Check for a complex column name. Note that during run-time expansion, the          # Check for a complex column name. The column name fragment is made
959          # column names will have been simplified (that is, the colon will have been          # part of the run-time key.
         # removed and the parameter attached to the incoming run-time key.  
960          if ($colName =~ /(\S+):(.+)/) {          if ($colName =~ /(\S+):(.+)/) {
961              $colName = $1;              $colName = $1;
962              $realRunTimeKey = $2;              $realRunTimeKey = $2;
963                if (defined $runTimeKey) {
964                    $realRunTimeKey .= "/$runTimeKey";
965          }          }
966            }
967            # 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.          # Get the result helper type.
979          my $rhType = $self->{type};          my $rhType = $self->{type};
980          # Create the string for returning the desired results.          # Create the string for returning the desired results.
981          my $expression = "${rhType}::$colName($type => \$self$realRunTimeKey)";              my $expression = "${rhType}::$colName($type => $parms)";
982          # Evaluate to get the result. Note we automatically translate undefined results to              Trace("Evaluating: $expression") if T(ResultCache => 3);
983          # an empty string.              # Evaluate to get the result. Note we automatically translate
984          Trace("Evaluating: $expression") if T(4);              # undefined results to an empty string.
985          $retVal = eval($expression) || "";          $retVal = eval($expression) || "";
986          # Check for an error.          # Check for an error.
987          if ($@) {          if ($@) {
988              Trace("Evaluation failed in Compute of $expression") if T(1);              Trace("Evaluation failed in Compute of $expression") if T(1);
989              Confess("$self->{type} column request failed: $@");              Confess("$self->{type} column request failed: $@");
990          }          }
991                Trace("Found \"$retVal\" for $colName type $type.") if T(ResultCache => 3);
992            }
993      }      }
994      # Return the computed result.      # Return the computed result.
995      return $retVal;      return $retVal;
996  }  }
997    
998    =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  =head3 ColumnDownload  =head3 ColumnDownload
1103    
1104  C<< my $flag = $rhelp->ColumnDownload($colName); >>      my $flag = $rhelp->ColumnDownload($colName);
1105    
1106  Return the type of data in the column, or an empty string if it should  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  not be downloaded. In general, all columns are downloaded except those
# Line 977  Line 1132 
1132    
1133  =head3 ColumnTitle  =head3 ColumnTitle
1134    
1135  C<< my $titleHtml = $rhelp->ColumnTitle($colName); >>      my $titleHtml = $rhelp->ColumnTitle($colName);
1136    
1137  Return the title to be used in the result table for the specified column.  Return the title to be used in the result table for the specified column.
1138    
# Line 1006  Line 1161 
1161    
1162  =head3 ColumnValue  =head3 ColumnValue
1163    
1164  C<< my $htmlValue = $rhelp->ColumnValue($colName); >>      my $htmlValue = $rhelp->ColumnValue($colName);
1165    
1166  Return the display value for a column. This could be HTML text or it  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  could be a run-time value specification. The column value is computed
# Line 1037  Line 1192 
1192    
1193  =head3 ColumnStyle  =head3 ColumnStyle
1194    
1195  C<< my $className = $rhelp->ColumnStyle($colName); >>      my $className = $rhelp->ColumnStyle($colName);
1196    
1197  Return the display style for the specified column. This must be a classname  Return the display style for the specified column. This must be a classname
1198  defined for C<TD> tags in the active style sheet.  defined for C<TD> tags in the active style sheet.
# Line 1067  Line 1222 
1222    
1223  =head3 GetRunTimeValues  =head3 GetRunTimeValues
1224    
1225  C<< my @valueHtml = $rhelp->GetRunTimeValues(@cols); >>      my @valueHtml = $rhelp->GetRunTimeValues(@cols);
1226    
1227  Return the run-time values of a row of columns. The incoming values contain  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  the actual column contents. Run-time columns will be identified by the
# Line 1102  Line 1257 
1257      for my $col (@cols) {      for my $col (@cols) {
1258          # Declare a holding variable.          # Declare a holding variable.
1259          my $retVal;          my $retVal;
1260            Trace("Value \"$retVal\" found in column.") if T(ResultCache => 3);
1261          # Parse the column data.          # Parse the column data.
1262          if ($col =~ /^%%(\w+)=(.+)/) {          if ($col =~ /^%%(\w+)=(.+)/) {
1263              # It parsed as a run-time value, so call the Compute method.              # It parsed as a run-time value, so call the Compute method.
# Line 1119  Line 1275 
1275    
1276  =head3 SetColumns  =head3 SetColumns
1277    
1278  C<< $rhelp->SetColumns(@cols); >>      $rhelp->SetColumns(@cols);
1279    
1280  Store the specified object columns. These are the columns computed by the search  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  framework, and should generally be specified first. If the search itself is
# Line 1147  Line 1303 
1303    
1304  =head3 AddExtraColumn  =head3 AddExtraColumn
1305    
1306  C<< $rhelp->AddExtraColumn($name => $loc, %data); >>      $rhelp->AddExtraColumn($name => $loc, %data);
1307    
1308  Add an extra column to the column list at a specified location.  Add an extra column to the column list at a specified location.
1309    
# Line 1189  Line 1345 
1345    
1346  =head3 AddOptionalColumn  =head3 AddOptionalColumn
1347    
1348  C<< $rhelp->AddOptionalColumn($name => $loc); >>      $rhelp->AddOptionalColumn($name => $loc);
1349    
1350  Store the specified column name in the column list at the  Store the specified column name in the column list at the
1351  specified location. The column name must be one that  specified location. The column name must be one that
# Line 1221  Line 1377 
1377    
1378  =head3 PutExtraColumns  =head3 PutExtraColumns
1379    
1380  C<< $rhelp->PutExtraColumns(name1 => value1, name2 => value2, ...); >>      $rhelp->PutExtraColumns(name1 => value1, name2 => value2, ...);
1381    
1382  Store the values of one or more extra columns. If a search produces extra columns (that is,  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  columns whose data is determined by the search instead of queries against the database), then
# Line 1255  Line 1411 
1411    
1412  =head3 StoreColumnSpec  =head3 StoreColumnSpec
1413    
1414  C<< $rhelp->_StoreColumnSpec($column, $location); >>      $rhelp->_StoreColumnSpec($column, $location);
1415    
1416  Store the specified column information at the specified location in the column name list.  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  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  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>  gaps in the list. If the location is undefined, it defaults to the end. Thus, C<0>
1420  will always store at the beginning and C<undef> will always store at the end.  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    
1423  =over 4  =over 4
1424    
# Line 1281  Line 1438 
1438  sub _StoreColumnSpec {  sub _StoreColumnSpec {
1439      # Get the parameters.      # Get the parameters.
1440      my ($self, $column, $location) = @_;      my ($self, $column, $location) = @_;
1441        # Get the current column list.
1442        my $columnList = $self->{columns};
1443      # Compute the current column count.      # Compute the current column count.
1444      my $columnCount = scalar @{$self->{columns}};      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.      # Adjust the location.
1460      if (! defined($location) || $location > $columnCount) {      if (! defined($location) || $location > $columnCount) {
1461          $location = $columnCount;          $location = $columnCount;
1462      }      }
1463      # Insert the column into the list.      # Insert the column into the list.
1464      splice @{$self->{columns}}, $location, 0, $column;      splice @{$self->{columns}}, $location, 0, $column;
1465            Trace("Column inserted at position $location.") if T(3);
1466        }
1467  }  }
1468    
1469    
# Line 1297  Line 1472 
1472  The following methods can be overridden by the subclass. In some cases, they  The following methods can be overridden by the subclass. In some cases, they
1473  must be overridden.  must be overridden.
1474    
1475    =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  =head3 DefaultResultColumns  =head3 DefaultResultColumns
1528    
1529  C<< my @colNames = $rhelp->DefaultResultColumns(); >>      my @colNames = $rhelp->DefaultResultColumns();
1530    
1531  Return a list of the default columns to be used by searches with this  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  type of result. Note that the actual default columns are computed by
# Line 1318  Line 1545 
1545    
1546  =head3 MoreDownloadFormats  =head3 MoreDownloadFormats
1547    
1548  C<< $rhelp->MoreDownloadFormats(\%dlTypes); >>      $rhelp->MoreDownloadFormats(\%dlTypes);
1549    
1550  Add additional supported download formats to the type table. The table is a  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  hash keyed on the download type code for which the values are the download
# Line 1350  Line 1577 
1577    
1578  =head3 MoreDownloadDataMethods  =head3 MoreDownloadDataMethods
1579    
1580  C<< my @lines = $rhelp->MoreDownloadDataMethods($objectID, $dlType, \@cols, \@colHdrs); >>      my @lines = $rhelp->MoreDownloadDataMethods($objectID, $dlType, \@cols, \@colHdrs);
1581    
1582  Create one or more lines of download data for a download of the specified type. Override  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.  this method if you need to process more download types than the default C<tbl> method.
# Line 1390  Line 1617 
1617      Confess("Invalid download type \"$dlType\" specified for result class $self->{type}.");      Confess("Invalid download type \"$dlType\" specified for result class $self->{type}.");
1618  }  }
1619    
1620    =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  1;  1;

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3