[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.6, Wed Sep 3 20:54:47 2008 UTC
# Line 164  Line 164 
164    
165  =head3 new  =head3 new
166    
167  C<< my $rhelp = ResultHelper->new($shelp); >>      my $rhelp = ResultHelper->new($shelp);
168    
169  Construct a new ResultHelper object to serve the specified search helper.  Construct a new ResultHelper object to serve the specified search helper.
170    
# Line 232  Line 232 
232    
233  =head3 DB  =head3 DB
234    
235  C<< my $sprout = $rhelp->DB(); >>      my $sprout = $rhelp->DB();
236    
237  Return the Sprout object for accessing the database.  Return the Sprout object for accessing the database.
238    
# Line 247  Line 247 
247    
248  =head3 PutData  =head3 PutData
249    
250  C<< $rhelp->PutData($sortKey, $id, $record); >>      $rhelp->PutData($sortKey, $id, $record);
251    
252  Store a line of data in the result file.  Store a line of data in the result file.
253    
# Line 289  Line 289 
289    
290  =head3 GetColumnHeaders  =head3 GetColumnHeaders
291    
292  C<< my $colHdrs = $rhelp->GetColumnHeaders(); >>      my $colHdrs = $rhelp->GetColumnHeaders();
293    
294  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
295  reference to the live column header list.  reference to the live column header list.
# Line 305  Line 305 
305    
306  =head3 DownloadFormatsAvailable  =head3 DownloadFormatsAvailable
307    
308  C<< my %dlTypes = $rhelp->DownloadFormatsAvailable(); >>      my %dlTypes = $rhelp->DownloadFormatsAvailable();
309    
310  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
311  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 329 
329    
330  =head3 DownloadDataLine  =head3 DownloadDataLine
331    
332  C<< $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs); >>      $rhelp->DownloadDataLine($objectID, $dlType, \@cols, \@colHdrs);
333    
334  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
335  download type.  download type.
# Line 396  Line 396 
396              # 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.
397              my @actualCols = ();              my @actualCols = ();
398              for (my $i = 0; $i <= $#keepCols; $i++) {              for (my $i = 0; $i <= $#keepCols; $i++) {
399                    Trace("Keep flag for $i is $keepCols[$i].") if T(4);
400                  if ($keepCols[$i]) {                  if ($keepCols[$i]) {
401                      push @actualCols, [$colHdrs->[$i], $self->GetRunTimeValues($cols->[$i]), $keepCols[$i]];                      push @actualCols, [$colHdrs->[$i], $self->GetRunTimeValues($cols->[$i]), $keepCols[$i]];
402                  }                  }
403              }              }
404                Trace(scalar(@actualCols) . " columns kept.") if T(4);
405              # 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
406              # is XML or tab-delimited.              # is XML or tab-delimited.
407              if ($dlType eq 'tbl') {              if ($dlType eq 'tbl') {
# Line 407  Line 409 
409                  my @actual = map { HtmlCleanup($_->[1], $_->[2]) } @actualCols;                  my @actual = map { HtmlCleanup($_->[1], $_->[2]) } @actualCols;
410                  # Return the line of data.                  # Return the line of data.
411                  push @retVal, join("\t", @actual);                  push @retVal, join("\t", @actual);
412                    Trace("Output line is\n" . join("\n", @actual)) if T(4);
413              } elsif ($dlType eq 'xml') {              } elsif ($dlType eq 'xml') {
414                  # Convert to XML. Since a single XML tag can contain multiple lines, we re-split them.                  # Convert to XML.
415                  # This is important, because when the lines are output we need to insure the correct                  my @actual = ();
416                  # EOL character is used.                  for my $actualCol (@actualCols) {
417                  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,
418                        # and the title for an extra column.
419                        my $colName;
420                        if (ref $actualCol->[0]) {
421                            # Here we have an extra column.
422                            $colName = $actualCol->[0]->{title};
423                            # Remove internal spaces to make it name-like.
424                            $colName =~ s/\s+//g;
425                        } else {
426                            # For a normal column, the value is the name.
427                            $colName = $actualCol->[0];
428                        }
429                        # Create the tag for this column.  Since a single XML tag can contain multiple
430                        # lines, we re-split them. This is important, because when the lines are output
431                        # we need to insure the correct EOL character is used.
432                        push @actual, split /\n/, "<$colName>" . XmlCleanup($actualCol->[1], $actualCol->[2]) . "</$colName>";
433                    }
434                  # Return the XML object.                  # Return the XML object.
435                  push @retVal, XML_INDENT x 1 . "<Item id=\"$objectID\">";                  push @retVal, XML_INDENT x 1 . "<Item id=\"$objectID\">";
436                  push @retVal, map { XML_INDENT x 2 . $_ } @actual;                  push @retVal, map { XML_INDENT x 2 . $_ } @actual;
# Line 429  Line 448 
448    
449  =head3 Formlet  =head3 Formlet
450    
451  C<< my $html = $rhelp->Formlet($caption, $url, $target, %parms); >>      my $html = $rhelp->Formlet($caption, $url, $target, %parms);
452    
453  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
454  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 489 
489      # Compute the target HTML.      # Compute the target HTML.
490      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $targetHtml = ($target ? " target=\"$target\"" : "");
491      # Start the form.      # Start the form.
492      my $retVal = "<form method=\"POST\" action=\"$url\"$target>";      my $retVal = "<form method=\"POST\" action=\"$FIG_Config::cgi_url/$url\"$target>";
493      # Add the parameters.      # Add the parameters.
494      for my $parm (keys %parms) {      for my $parm (keys %parms) {
495          $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";          $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
# Line 485  Line 504 
504    
505  =head3 HtmlCleanup  =head3 HtmlCleanup
506    
507  C<< my $text = ResultHelper::HtmlCleanup($htmlText, $type); >>      my $text = ResultHelper::HtmlCleanup($htmlText, $type);
508    
509  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.
510  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 542 
542          $retVal = ButtonToLink($htmlText);          $retVal = ButtonToLink($htmlText);
543      } elsif ($type eq 'align') {      } elsif ($type eq 'align') {
544          # Here we have multiple lines. Convert the new-lines to serial commas.          # Here we have multiple lines. Convert the new-lines to serial commas.
545            $retVal = $htmlText;
546          $retVal =~ s/<br\s*\/?>/, /g;          $retVal =~ s/<br\s*\/?>/, /g;
547            # Convert &nbsp; marks to real spaces.
548            $retVal =~ s/&nbsp;/ /g;
549      } else {      } else {
550          # Here we have normal HTML. Start by taking the raw text.          # Here we have normal HTML. Start by taking the raw text.
551          $retVal = $htmlText;          $retVal = $htmlText;
552          # 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
553          # is a right angle bracket inside a parameter string.          # is a right angle bracket inside a parameter string.
554          $retVal =~ s/<[^>]+>//g;          $retVal =~ s/<[^>]+>//g;
555            # Convert &nbsp; marks to real spaces.
556            $retVal =~ s/&nbsp;/ /g;
557          # Unescape the & tags.          # Unescape the & tags.
558          $retVal = CGI::unescapeHTML($retVal);          $retVal = CGI::unescapeHTML($retVal);
559      }      }
# Line 539  Line 563 
563    
564  =head3 XmlCleanup  =head3 XmlCleanup
565    
566  C<< my $text = ResultHelper::XmlCleanup($htmlText, $type); >>      my $text = ResultHelper::XmlCleanup($htmlText, $type);
567    
568  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.
569    
# Line 577  Line 601 
601      } elsif ($type eq 'align') {      } elsif ($type eq 'align') {
602          # 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.
603          # First, we find the break tags.          # First, we find the break tags.
604            Trace("Alignment cleanup of: $htmlText") if T(4);
605          my @lines = split /<br[^>]+>/, $htmlText;          my @lines = split /<br[^>]+>/, $htmlText;
606            Trace(scalar(@lines) . " lines found.") if T(4);
607          # 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
608          # element to be on a separate line from the first item tag.          # element to be on a separate line from the first item tag.
609          $retVal = "\n" . map { XML_INDENT . "<line>$_</line>\n" } @lines;          $retVal = "\n" . join("", map { XML_INDENT . "<line>$_</line>\n" } @lines);
610      } elsif ($type eq 'list') {      } elsif ($type eq 'list') {
611          # 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
612          # an XML array. First, we get the pieces.          # an XML array. First, we get the pieces.
# Line 606  Line 632 
632    
633  =head3 ButtonToLink  =head3 ButtonToLink
634    
635  C<< my $url = ResultHelper::ButtonToLink($htmlText); >>      my $url = ResultHelper::ButtonToLink($htmlText);
636    
637  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
638  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 681 
681      }      }
682      # 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.
683      if ($retVal && $retVal !~ m#http://#) {      if ($retVal && $retVal !~ m#http://#) {
684          # 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.
685          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";  
686      }      }
687      # Return the result.      # Return the result.
688      return $retVal;      return $retVal;
# Line 670  Line 690 
690    
691  =head3 FakeButton  =head3 FakeButton
692    
693  C<< my $html = $rhelp->FakeButton($caption, $url, $target, %parms); >>      my $html = $rhelp->FakeButton($caption, $url, $target, %parms);
694    
695  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.
696  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 729 
729      # Declare the return variable.      # Declare the return variable.
730      my $retVal;      my $retVal;
731      # Compute the target URL.      # Compute the target URL.
732      my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);      my $targetUrl = "$FIG_Config::cgi_url/$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
733      # Compute the target-frame HTML.      # Compute the target-frame HTML.
734      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $targetHtml = ($target ? " target=\"$target\"" : "");
735      # Assemble the result.      # Assemble the result.
# Line 718  Line 738 
738    
739  =head3 Parent  =head3 Parent
740    
741  C<< my $shelp = $rhelp->Parent(); >>      my $shelp = $rhelp->Parent();
742    
743  Return this helper's parent search helper.  Return this helper's parent search helper.
744    
# Line 733  Line 753 
753    
754  =head3 Record  =head3 Record
755    
756  C<< my $erdbObject = $rhelp->Record(); >>      my $erdbObject = $rhelp->Record();
757    
758  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
759  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 773 
773    
774  =head3 ID  =head3 ID
775    
776  C<< my $id = $rhelp->ID(); >>      my $id = $rhelp->ID();
777    
778  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).
779    
# Line 776  Line 796 
796    
797  =head3 Cache  =head3 Cache
798    
799  C<< my $cacheHash = $rhelp->Cache(); >>      my $cacheHash = $rhelp->Cache();
800    
801  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
802  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 813 
813    
814  =head3 PreferredID  =head3 PreferredID
815    
816  C<< my $featureID = $rhelp->PreferredID($featureObject); >>      my $featureID = $rhelp->PreferredID($featureObject);
817    
818  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
819  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 876 
876    
877  =head3 Compute  =head3 Compute
878    
879  C<< my $retVal = $rhelp->Compute($type, $colName, $runTimeKey); >>      my $retVal = $rhelp->Compute($type, $colName, $runTimeKey);
880    
881  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.
882  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 924  Line 944 
944          # removed and the parameter attached to the incoming run-time key.          # removed and the parameter attached to the incoming run-time key.
945          if ($colName =~ /(\S+):(.+)/) {          if ($colName =~ /(\S+):(.+)/) {
946              $colName = $1;              $colName = $1;
947              $realRunTimeKey = $2;              $realRunTimeKey = ", '$2'";
948          }          }
949          # Get the result helper type.          # Get the result helper type.
950          my $rhType = $self->{type};          my $rhType = $self->{type};
# Line 946  Line 966 
966    
967  =head3 ColumnDownload  =head3 ColumnDownload
968    
969  C<< my $flag = $rhelp->ColumnDownload($colName); >>      my $flag = $rhelp->ColumnDownload($colName);
970    
971  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
972  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 997 
997    
998  =head3 ColumnTitle  =head3 ColumnTitle
999    
1000  C<< my $titleHtml = $rhelp->ColumnTitle($colName); >>      my $titleHtml = $rhelp->ColumnTitle($colName);
1001    
1002  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.
1003    
# Line 1006  Line 1026 
1026    
1027  =head3 ColumnValue  =head3 ColumnValue
1028    
1029  C<< my $htmlValue = $rhelp->ColumnValue($colName); >>      my $htmlValue = $rhelp->ColumnValue($colName);
1030    
1031  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
1032  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 1057 
1057    
1058  =head3 ColumnStyle  =head3 ColumnStyle
1059    
1060  C<< my $className = $rhelp->ColumnStyle($colName); >>      my $className = $rhelp->ColumnStyle($colName);
1061    
1062  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
1063  defined for C<TD> tags in the active style sheet.  defined for C<TD> tags in the active style sheet.
# Line 1067  Line 1087 
1087    
1088  =head3 GetRunTimeValues  =head3 GetRunTimeValues
1089    
1090  C<< my @valueHtml = $rhelp->GetRunTimeValues(@cols); >>      my @valueHtml = $rhelp->GetRunTimeValues(@cols);
1091    
1092  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
1093  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 1119  Line 1139 
1139    
1140  =head3 SetColumns  =head3 SetColumns
1141    
1142  C<< $rhelp->SetColumns(@cols); >>      $rhelp->SetColumns(@cols);
1143    
1144  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
1145  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 1167 
1167    
1168  =head3 AddExtraColumn  =head3 AddExtraColumn
1169    
1170  C<< $rhelp->AddExtraColumn($name => $loc, %data); >>      $rhelp->AddExtraColumn($name => $loc, %data);
1171    
1172  Add an extra column to the column list at a specified location.  Add an extra column to the column list at a specified location.
1173    
# Line 1189  Line 1209 
1209    
1210  =head3 AddOptionalColumn  =head3 AddOptionalColumn
1211    
1212  C<< $rhelp->AddOptionalColumn($name => $loc); >>      $rhelp->AddOptionalColumn($name => $loc);
1213    
1214  Store the specified column name in the column list at the  Store the specified column name in the column list at the
1215  specified location. The column name must be one that  specified location. The column name must be one that
# Line 1221  Line 1241 
1241    
1242  =head3 PutExtraColumns  =head3 PutExtraColumns
1243    
1244  C<< $rhelp->PutExtraColumns(name1 => value1, name2 => value2, ...); >>      $rhelp->PutExtraColumns(name1 => value1, name2 => value2, ...);
1245    
1246  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,
1247  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 1275 
1275    
1276  =head3 StoreColumnSpec  =head3 StoreColumnSpec
1277    
1278  C<< $rhelp->_StoreColumnSpec($column, $location); >>      $rhelp->_StoreColumnSpec($column, $location);
1279    
1280  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.
1281  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
# Line 1299  Line 1319 
1319    
1320  =head3 DefaultResultColumns  =head3 DefaultResultColumns
1321    
1322  C<< my @colNames = $rhelp->DefaultResultColumns(); >>      my @colNames = $rhelp->DefaultResultColumns();
1323    
1324  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
1325  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 1338 
1338    
1339  =head3 MoreDownloadFormats  =head3 MoreDownloadFormats
1340    
1341  C<< $rhelp->MoreDownloadFormats(\%dlTypes); >>      $rhelp->MoreDownloadFormats(\%dlTypes);
1342    
1343  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
1344  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 1370 
1370    
1371  =head3 MoreDownloadDataMethods  =head3 MoreDownloadDataMethods
1372    
1373  C<< my @lines = $rhelp->MoreDownloadDataMethods($objectID, $dlType, \@cols, \@colHdrs); >>      my @lines = $rhelp->MoreDownloadDataMethods($objectID, $dlType, \@cols, \@colHdrs);
1374    
1375  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
1376  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.

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3