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

Diff of /Sprout/SearchHelper.pm

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

revision 1.18, Sat Nov 18 20:36:49 2006 UTC revision 1.28, Tue Apr 10 06:05:40 2007 UTC
# Line 88  Line 88 
88  TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this  TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this
89  field is updated by the B<FeatureQuery> object.  field is updated by the B<FeatureQuery> object.
90    
91    =item extraPos
92    
93    C<0> if the extra columns are to be at the beginning, else C<1>. The
94    default is zero; use the L</SetExtraPos> method to change this option.
95    
96  =back  =back
97    
98  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 230  Line 235 
235  in the output, or you could search for something that's not a feature at all. The  in the output, or you could search for something that's not a feature at all. The
236  above code is just a loose framework.  above code is just a loose framework.
237    
238    In addition to the finding and filtering, it is necessary to send status messages
239    to the output so that the user does not get bored waiting for results. The L</PrintLine>
240    method performs this function. The single parameter should be text to be
241    output to the browser. In general, you'll invoke it as follows.
242    
243        $self->PrintLine("...my message text...<br />");
244    
245    The break tag is optional. When the Find method gets control, a paragraph will
246    have been started so that everything is XHTML-compliant.
247    
248  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>
249  method of the feature query object.  method of the feature query object.
250    
# Line 251  Line 266 
266    
267  =head3 new  =head3 new
268    
269  C<< my $shelp = SearchHelper->new($query); >>  C<< my $shelp = SearchHelper->new($cgi); >>
270    
271  Construct a new SearchHelper object.  Construct a new SearchHelper object.
272    
273  =over 4  =over 4
274    
275  =item query  =item cgi
276    
277  The CGI query object for the current script.  The CGI query object for the current script.
278    
# Line 267  Line 282 
282    
283  sub new {  sub new {
284      # Get the parameters.      # Get the parameters.
285      my ($class, $query) = @_;      my ($class, $cgi) = @_;
286      # Check for a session ID.      # Check for a session ID.
287      my $session_id = $query->param("SessionID");      my $session_id = $cgi->param("SessionID");
288      my $type = "old";      my $type = "old";
289      if (! $session_id) {      if (! $session_id) {
290            Trace("No session ID found.") if T(3);
291          # Here we're starting a new session. We create the session ID and          # Here we're starting a new session. We create the session ID and
292          # store it in the query object.          # store it in the query object.
293          $session_id = NewSessionID();          $session_id = NewSessionID();
294          $type = "new";          $type = "new";
295          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
296        } else {
297            Trace("Session ID is $session_id.") if T(3);
298      }      }
299      # Compute the subclass name.      # Compute the subclass name.
300      $class =~ /SH(.+)$/;      my $subClass;
301      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
302            # Here we have a real search class.
303            $subClass = $1;
304        } else {
305            # Here we have a bare class. The bare class cannot search, but it can
306            # process search results.
307            $subClass = 'SearchHelper';
308        }
309      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
310      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
311      # Generate the form name.      # Generate the form name.
312      my $formName = "$class$formCount";      my $formName = "$class$formCount";
313      $formCount++;      $formCount++;
# Line 290  Line 315 
315      # as well as an indicator as to whether or not the session is new, plus the      # as well as an indicator as to whether or not the session is new, plus the
316      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
317      my $retVal = {      my $retVal = {
318                    query => $query,                    query => $cgi,
319                    type => $type,                    type => $type,
320                    class => $subClass,                    class => $subClass,
321                    sprout => undef,                    sprout => undef,
# Line 300  Line 325 
325                    genomeList => undef,                    genomeList => undef,
326                    genomeParms => [],                    genomeParms => [],
327                    filtered => 0,                    filtered => 0,
328                      extraPos => 0,
329                   };                   };
330      # Bless and return it.      # Bless and return it.
331      bless $retVal, $class;      bless $retVal, $class;
# Line 360  Line 386 
386      return ($self->{type} eq 'new');      return ($self->{type} eq 'new');
387  }  }
388    
389    =head3 SetExtraPos
390    
391    C<< $shelp->SetExtraPos($newValue); >>
392    
393    Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.
394    
395    =over 4
396    
397    =item newValue
398    
399    C<1> if the extra columns should be displayed at the end, else C<0>.
400    
401    =back
402    
403    =cut
404    
405    sub SetExtraPos {
406        my ($self, $newValue) = @_;
407        $self->{extraPos} = $newValue;
408    }
409    
410  =head3 ID  =head3 ID
411    
412  C<< my $sessionID = $shelp->ID(); >>  C<< my $sessionID = $shelp->ID(); >>
# Line 662  Line 709 
709      # Check for a first-call situation.      # Check for a first-call situation.
710      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
711          Trace("Setting up the columns.") if T(3);          Trace("Setting up the columns.") if T(3);
712          # Here we need to set up the column information. Start with the extras,          # Tell the user what's happening.
713            $self->PrintLine("Creating output columns.<br />");
714            # Here we need to set up the column information. First we accumulate the extras,
715          # sorted by column name.          # sorted by column name.
716          my @colNames = ();          my @xtraNames = ();
717          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
718              push @colNames, "X=$col";              push @xtraNames, "X=$col";
719            }
720            # Set up the column name array.
721            my @colNames = ();
722            # If extras go at the beginning, put them in first.
723            if (! $self->{extraPos}) {
724                push @colNames, @xtraNames;
725          }          }
726          # Add the default columns.          # Add the default columns.
727          push @colNames, $self->DefaultFeatureColumns();          push @colNames, $self->DefaultFeatureColumns();
728          # Add any additional columns requested by the feature filter.          # Add any additional columns requested by the feature filter.
729          push @colNames, FeatureQuery::AdditionalColumns($self);          push @colNames, FeatureQuery::AdditionalColumns($self);
730            # If extras go at the end, put them in here.
731            if ($self->{extraPos}) {
732                push @colNames, @xtraNames;
733            }
734            Trace("Full column list determined.") if T(3);
735          # Save the full list.          # Save the full list.
736          $self->{cols} = \@colNames;          $self->{cols} = \@colNames;
737          # Write out the column headers. This also prepares the cache file to receive          # Write out the column names. This also prepares the cache file to receive
738          # output.          # output.
739          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          Trace("Writing column headers.") if T(3);
740            $self->WriteColumnHeaders(@{$self->{cols}});
741            Trace("Column headers written.") if T(3);
742      }      }
743      # Get the feature ID.      # Get the feature ID.
744      my $fid = $fd->FID();      my $fid = $fd->FID();
# Line 770  Line 832 
832          # We found one, so close it.          # We found one, so close it.
833          Trace("Closing session file.") if T(2);          Trace("Closing session file.") if T(2);
834          close $self->{fileHandle};          close $self->{fileHandle};
835            # Tell the user.
836            my $cgi = $self->Q();
837            $self->PrintLine("Output formatting complete.<br />");
838      }      }
839  }  }
840    
# Line 979  Line 1044 
1044    
1045  sub ComputeFASTA {  sub ComputeFASTA {
1046      # Get the parameters.      # Get the parameters.
1047      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence) = @_;
1048      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
1049      my $retVal;      my $retVal;
1050      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 1035  Line 1100 
1100          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1101          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1102          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
1103          if ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {
1104              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
1105              $okFlag = 0;              $okFlag = 0;
1106          }          }
1107      }      }
# Line 1107  Line 1172 
1172      # Read in the subsystems.      # Read in the subsystems.
1173      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1174                                 ['Subsystem(classification)', 'Subsystem(id)']);                                 ['Subsystem(classification)', 'Subsystem(id)']);
1175        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1176        # is at the end, ALL subsystems are unclassified and we don't bother.
1177        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1178            while ($subs[0]->[0] eq '') {
1179                my $classLess = shift @subs;
1180                push @subs, $classLess;
1181            }
1182        }
1183      # Declare the return variable.      # Declare the return variable.
1184      my @retVal = ();      my @retVal = ();
1185      # Each element in @subs represents a leaf node, so as we loop through it we will be      # Each element in @subs represents a leaf node, so as we loop through it we will be
# Line 1181  Line 1254 
1254              if ($optionThing->{links}) {              if ($optionThing->{links}) {
1255                  # Compute the link value.                  # Compute the link value.
1256                  my $linkable = uri_escape($id);                  my $linkable = uri_escape($id);
1257                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;show_clusters=1;SPROUT=1";
1258              }              }
1259              if ($optionThing->{radio}) {              if ($optionThing->{radio}) {
1260                  # Compute the radio value.                  # Compute the radio value.
# Line 1512  Line 1585 
1585      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1586                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1587                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1588                                                      -default => $pageSize) . " " .                                                      -default => $pageSize)),
                                    $cgi->checkbox(-name => 'ShowURL',  
                                                   -value => 1,  
                                                   -label => 'Show URL')),  
1589                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1590                                                  -name => 'Search',                                                  -name => 'Search',
1591                                                  -value => $realCaption)));                                                  -value => $realCaption)));
# Line 1525  Line 1595 
1595    
1596  =head3 FeatureFilterRows  =head3 FeatureFilterRows
1597    
1598  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(@subset); >>
1599    
1600  This method creates table rows that can be used to filter features. The form  This method creates table rows that can be used to filter features. The form
1601  values can be used to select features by genome using the B<FeatureQuery>  values can be used to select features by genome using the B<FeatureQuery>
1602  object.  object.
1603    
1604    =over 4
1605    
1606    =item subset
1607    
1608    List of rows to display. The default (C<all>) is to display all rows.
1609    C<words> displays the word search box, C<subsys> displays the subsystem
1610    selector, and C<options> displays the options row.
1611    
1612    =item RETURN
1613    
1614    Returns the html text for table rows containing the desired feature filtering controls.
1615    
1616    =back
1617    
1618  =cut  =cut
1619    
1620  sub FeatureFilterRows {  sub FeatureFilterRows {
1621      # Get the parameters.      # Get the parameters.
1622      my ($self) = @_;      my ($self, @subset) = @_;
1623        if (@subset == 0 || $subset[0] eq 'all') {
1624            @subset = qw(words subsys options);
1625        }
1626      # Return the result.      # Return the result.
1627      return FeatureQuery::FilterRows($self);      return FeatureQuery::FilterRows($self, @subset);
1628  }  }
1629    
1630  =head3 GBrowseFeatureURL  =head3 GBrowseFeatureURL
# Line 1705  Line 1792 
1792    
1793  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1794    
1795  C<< my $url = $shelp->ComputeSearchURL(); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1796    
1797  Compute the GET-style URL for the current search. In order for this to work, there  Compute the GET-style URL for the current search. In order for this to work, there
1798  must be a copy of the search form on the current page. This will always be the  must be a copy of the search form on the current page. This will always be the
# Line 1715  Line 1802 
1802  main complication is that if the user specified all genomes, we'll want to  main complication is that if the user specified all genomes, we'll want to
1803  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1804    
1805    =over 4
1806    
1807    =item overrides
1808    
1809    Hash containing override values for the parameters, where the parameter name is
1810    the key and the parameter value is the override value. If the override value is
1811    C<undef>, the parameter will be deleted from the result.
1812    
1813    =item RETURN
1814    
1815    Returns a GET-style URL for invoking the search with the specified overrides.
1816    
1817    =back
1818    
1819  =cut  =cut
1820    
1821  sub ComputeSearchURL {  sub ComputeSearchURL {
1822      # Get the parameters.      # Get the parameters.
1823      my ($self) = @_;      my ($self, %overrides) = @_;
1824      # Get the database and CGI query object.      # Get the database and CGI query object.
1825      my $cgi = $self->Q();      my $cgi = $self->Q();
1826      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1746  Line 1847 
1847          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1848          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1849          # Check for special cases.          # Check for special cases.
1850          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1851              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1852              @values = ();              @values = ();
1853          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1760  Line 1861 
1861              if ($allFlag) {              if ($allFlag) {
1862                  @values = ();                  @values = ();
1863              }              }
1864            } elsif (exists $overrides{$parmKey}) {
1865                # Here the value is being overridden, so we skip it for now.
1866                @values = ();
1867          }          }
1868          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1869          if (@values) {          if (@values) {
1870              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1871          }          }
1872      }      }
1873        # Now do the overrides.
1874        for my $overKey (keys %overrides) {
1875            # Only use this override if it's not a delete marker.
1876            if (defined $overrides{$overKey}) {
1877                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1878            }
1879        }
1880      # Add the parameters to the URL.      # Add the parameters to the URL.
1881      $retVal .= "?" . join(";", @urlList);      $retVal .= "?" . join(";", @urlList);
1882      # Return the result.      # Return the result.
# Line 2111  Line 2222 
2222                      if ($hasChildren) {                      if ($hasChildren) {
2223                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
2224                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2225                            Trace("Children of $myLabel finished.") if T(4);
2226                      }                      }
2227                  }                  }
2228              }              }
# Line 2145  Line 2257 
2257              }              }
2258              # Next, we format the label.              # Next, we format the label.
2259              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
2260              Trace("Formatting tree node for $myLabel.") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
2261              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
2262              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
2263                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
# Line 2197  Line 2309 
2309    
2310  =head2 Feature Column Methods  =head2 Feature Column Methods
2311    
2312  The methods in this column manage feature column data. If you want to provide the  The methods in this section manage feature column data. If you want to provide the
2313  capability to include new types of data in feature columns, then all the changes  capability to include new types of data in feature columns, then all the changes
2314  are made to this section of the source file. Technically, this should be implemented  are made to this section of the source file. Technically, this should be implemented
2315  using object-oriented methods, but this is simpler for non-programmers to maintain.  using object-oriented methods, but this is simpler for non-programmers to maintain.
# Line 2205  Line 2317 
2317  the name for the protein page link column is C<protlink>. If the column is to appear  the name for the protein page link column is C<protlink>. If the column is to appear
2318  in the default list of feature columns, add it to the list returned by  in the default list of feature columns, add it to the list returned by
2319  L</DefaultFeatureColumns>. Then add code to produce the column title to  L</DefaultFeatureColumns>. Then add code to produce the column title to
2320  L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>, and  L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>. If the
2321  everything else will happen automatically.  feature column should be excluded from downloads, add it to the C<FeatureColumnSkip>
2322    hash. Everything else will happen automatically.
2323    
2324  There is one special column name syntax for extra columns (that is, nonstandard  There is a special column name syntax for extra columns (that is, nonstandard
2325  feature columns). If the column name begins with C<X=>, then it is presumed to be  feature columns). If the column name begins with C<X=>, then it is presumed to be
2326  an extra column. The column title is the text after the C<X=>, and its value is  an extra column. The column title is the text after the C<X=>, and its value is
2327  pulled from the extra column hash.  pulled from the extra column hash.
2328    
2329    =cut
2330    
2331    # This hash is used to determine which columns should not be included in downloads.
2332    my %FeatureColumnSkip = map { $_ => 1 } qw(gblink viewerlink protlink);
2333    
2334  =head3 DefaultFeatureColumns  =head3 DefaultFeatureColumns
2335    
2336  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>
# Line 2272  Line 2390 
2390      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2391          $retVal = ucfirst $1;          $retVal = ucfirst $1;
2392      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2393          $retVal = "Gene Name";          $retVal = "Organism and Gene ID";
2394      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2395          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2396        } elsif ($colName eq 'viewerlink') {
2397            $retVal = "Annotation Page";
2398      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
2399          $retVal = "Subsystems";          $retVal = "Subsystems";
2400      }      }
# Line 2282  Line 2402 
2402      return $retVal;      return $retVal;
2403  }  }
2404    
2405    =head3 FeatureColumnDownload
2406    
2407    C<< my $keep = $shelp->FeatureColumnDownload($colName); >>
2408    
2409    Return TRUE if the named feature column is to be kept when downloading, else FALSE.
2410    
2411    =over 4
2412    
2413    =item colName
2414    
2415    Name of the relevant feature column.
2416    
2417    =item RETURN
2418    
2419    Return TRUE if the named column should be kept while downloading, else FALSE. In general,
2420    FALSE is returned if the column generates a button, image, or other purely-HTML value.
2421    
2422    =back
2423    
2424    =cut
2425    
2426    sub FeatureColumnDownload {
2427        # Get the parameters.
2428        my ($self, $colName) = @_;
2429        # Return the determination. We download the column if it's not in the skip-hash.
2430        # Note we return 0 and 1 instead of 1 and undef because it simplifies some tracing.
2431        return (exists $FeatureColumnSkip{$colName} ? 0 : 1);
2432    }
2433    
2434    
2435  =head3 FeatureColumnValue  =head3 FeatureColumnValue
2436    
# Line 2297  Line 2446 
2446    
2447  =item record  =item record
2448    
2449  DBObject record for the feature being displayed in the current row.  ERDBObject record for the feature being displayed in the current row.
2450    
2451  =item extraCols  =item extraCols
2452    
# Line 2345  Line 2494 
2494          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2495      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2496          # Here we want a link to the GBrowse page using the official GBrowse button.          # Here we want a link to the GBrowse page using the official GBrowse button.
2497          $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef,          $retVal = FakeButton('GBrowse', "GetGBrowse.cgi", undef,
2498                            fid => $fid);                            fid => $fid);
2499      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2500          # Get the NMPDR group name.          # Get the NMPDR group name.
# Line 2363  Line 2512 
2512          $retVal = $self->FeatureName($fid);          $retVal = $self->FeatureName($fid);
2513      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2514          # Here we want a link to the protein page using the official NMPDR button.          # Here we want a link to the protein page using the official NMPDR button.
2515          $retVal = Formlet('NMPDR', "protein.cgi", undef,          $retVal = FakeButton('NMPDR', "protein.cgi", undef,
2516                            prot => $fid, SPROUT => 1, new_framework => 0,                            prot => $fid, SPROUT => 1, new_framework => 0,
2517                            user => '');                            user => '');
2518        } elsif ($colName eq 'viewerlink') {
2519            # Here we want a link to the SEED viewer page using the official viewer button.
2520            $retVal = FakeButton('Annotation', "index.cgi", undef,
2521                                 action => 'ShowAnnotation', prot => $fid);
2522      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
2523          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2524          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
# Line 2432  Line 2585 
2585          # Get the subsystems.          # Get the subsystems.
2586          Trace("Generating subsystems for feature $fid.") if T(4);          Trace("Generating subsystems for feature $fid.") if T(4);
2587          my %subs = $sprout->SubsystemsOf($fid);          my %subs = $sprout->SubsystemsOf($fid);
2588          # Convert them to links.          # Extract the subsystem names.
2589          my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;          my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2590          # String them into a list.          # String them into a list.
2591          $retVal = join(", ", @links);          $retVal = join(", ", @names);
2592      } elsif ($type =~ /^keyword:(.+)$/) {      } elsif ($type =~ /^keyword:(.+)$/) {
2593          # Here the caller wants the value of the named keyword. The text is the          # Here the caller wants the value of the named keyword. The text is the
2594          # feature ID.          # feature ID.
# Line 2557  Line 2710 
2710      if (! @wordList) {      if (! @wordList) {
2711          if ($required) {          if ($required) {
2712              $self->SetMessage("No search words specified.");              $self->SetMessage("No search words specified.");
2713            } else {
2714                $retVal = 1;
2715          }          }
2716      } elsif (! @plusWords) {      } elsif (! @plusWords) {
2717          $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");          $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
# Line 2567  Line 2722 
2722      return $retVal;      return $retVal;
2723  }  }
2724    
2725    =head3 FakeButton
2726    
2727    C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>
2728    
2729    Create a fake button that hyperlinks to the specified URL with the specified parameters.
2730    Unlike a real button, this one won't visibly click, but it will take the user to the
2731    correct place.
2732    
2733    The parameters of this method are deliberately identical to L</Formlet> so that we
2734    can switch easily from real buttons to fake ones in the code.
2735    
2736    =over 4
2737    
2738    =item caption
2739    
2740    Caption to be put on the button.
2741    
2742    =item url
2743    
2744    URL for the target page or script.
2745    
2746    =item target
2747    
2748    Frame or target in which the new page should appear. If C<undef> is specified,
2749    the default target will be used.
2750    
2751    =item parms
2752    
2753    Hash containing the parameter names as keys and the parameter values as values.
2754    These will be appended to the URL.
2755    
2756    =back
2757    
2758    =cut
2759    
2760    sub FakeButton {
2761        # Get the parameters.
2762        my ($caption, $url, $target, %parms) = @_;
2763        # Declare the return variable.
2764        my $retVal;
2765        # Compute the target URL.
2766        my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
2767        # Compute the target-frame HTML.
2768        my $targetHtml = ($target ? " target=\"$target\"" : "");
2769        # Assemble the result.
2770        return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";
2771    }
2772    
2773  =head3 Formlet  =head3 Formlet
2774    
2775  C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>  C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>
# Line 2683  Line 2886 
2886      return $retVal;      return $retVal;
2887  }  }
2888    
2889    =head3 PrintLine
2890    
2891    C<< $shelp->PrintLine($message); >>
2892    
2893    Print a line of CGI output. This is used during the operation of the B<Find> method while
2894    searching, so the user sees progress in real-time.
2895    
2896    =over 4
2897    
2898    =item message
2899    
2900    HTML text to display.
2901    
2902    =back
2903    
2904    =cut
2905    
2906    sub PrintLine {
2907        # Get the parameters.
2908        my ($self, $message) = @_;
2909        # Send them to the output.
2910        print "$message\n";
2911    }
2912    
2913    
2914  1;  1;

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.28

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3