[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.19, Mon Nov 20 05:54:09 2006 UTC revision 1.43, Mon Jan 19 21:56:19 2009 UTC
# Line 10  Line 10 
10      use File::Path;      use File::Path;
11      use File::stat;      use File::stat;
12      use LWP::UserAgent;      use LWP::UserAgent;
13      use Time::HiRes 'gettimeofday';      use FIGRules;
14      use Sprout;      use Sprout;
15      use SFXlate;      use SFXlate;
16      use FIGRules;      use FIGRules;
17      use HTML;      use HTML;
18      use BasicLocation;      use BasicLocation;
     use FeatureQuery;  
19      use URI::Escape;      use URI::Escape;
20      use PageBuilder;      use PageBuilder;
21        use AliasAnalysis;
22        use CGI::Cookie;
23        use FreezeThaw qw(freeze thaw);
24    
25  =head1 Search Helper Base Class  =head1 Search Helper Base Class
26    
# Line 65  Line 67 
67    
68  =item orgs  =item orgs
69    
70  Reference to a hash mapping genome IDs to organism names.  Reference to a hash mapping genome IDs to organism data. (Used to
71    improve performance.)
72    
73  =item name  =item name
74    
# Line 83  Line 86 
86    
87  List of the parameters that are used to select multiple genomes.  List of the parameters that are used to select multiple genomes.
88    
89  =item filtered  =item notices
90    
91  TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this  A list of messages to be put in the notice file.
 field is updated by the B<FeatureQuery> object.  
92    
93  =back  =back
94    
# Line 103  Line 105 
105  =item 2  =item 2
106    
107  Create a new subclass of this object and implement each of the virtual methods. The  Create a new subclass of this object and implement each of the virtual methods. The
108  name of the subclass must be C<SH>I<className>.  name of the subclass must be C<SH>I<className>, where I<className> is the
109    type of search.
110    
111  =item 3  =item 3
112    
# Line 113  Line 116 
116    
117  =item 4  =item 4
118    
119  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.  If your search produces a result for which a helper does not exist, you
120    must create a new subclass of B<ResultHelper>. Its name must be
121    C<RH>I<className>, where I<className> is the type of result.
122    
123  =back  =back
124    
# Line 149  Line 154 
154    
155  Several helper methods are provided for particular purposes.  Several helper methods are provided for particular purposes.
156    
 =over 4  
   
 =item 1  
   
157  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
158  L</GetGenomes> to retrieve all the genomes passed in for a specified parameter  L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
159  name. Note that as an assist to people working with GET-style links, if no  name. Note that as an assist to people working with GET-style links, if no
160  genomes are specified and the incoming request style is GET, all genomes will  genomes are specified and the incoming request style is GET, all genomes will
161  be returned.  be returned.
162    
 =item 2  
   
 L</FeatureFilterRow> formats several rows of controls for filtering features.  
 When you start building the code for the L</Find> method, you can use a  
 B<FeatureQuery> object to automatically filter each genome's features using  
 the values from the filter controls.  
   
 =item 3  
   
163  L</QueueFormScript> allows you to queue JavaScript statements for execution  L</QueueFormScript> allows you to queue JavaScript statements for execution
164  after the form is fully generated. If you are using very complicated  after the form is fully generated. If you are using very complicated
165  form controls, the L</QueueFormScript> method allows you to perform  form controls, the L</QueueFormScript> method allows you to perform
166  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this
167  facility to display a list of the pre-selected genomes.  facility to display a list of the pre-selected genomes.
168    
 =back  
   
 If you are doing a feature search, you can also change the list of feature  
 columns displayed and their display order by overriding  
 L</DefaultFeatureColumns>.  
   
169  Finally, when generating the code for your controls, be sure to use any incoming  Finally, when generating the code for your controls, be sure to use any incoming
170  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
171    
172  =head3 Finding Search Results  =head3 Finding Search Results
173    
174  The L</Find> method is used to create the search results. For a search that  The L</Find> method is used to create the search results. The basic code
175  wants to return features (which is most of them), the basic code structure  structure would work as follows.
 would work as follows. It is assumed that the L</FeatureFilterRows> method  
 has been used to create feature filtering parameters.  
176    
177      sub Find {      sub Find {
178          my ($self) = @_;          my ($self) = @_;
# Line 201  Line 185 
185          ... validate the parameters ...          ... validate the parameters ...
186          if (... invalid parameters...) {          if (... invalid parameters...) {
187              $self->SetMessage(...appropriate message...);              $self->SetMessage(...appropriate message...);
188          } elsif (FeatureQuery::Valid($self)) {          } else {
189                # Determine the result type.
190                my $rhelp = SearchHelper::GetHelper($self, RH => $resultType);
191                # Specify the columns.
192                $self->DefaultColumns($rhelp);
193                # You may want to add extra columns. $name is the column name and
194                # $loc is its location. The other parameters take their names from the
195                # corresponding column methods.
196                $rhelp->AddExtraColumn($name => $loc, style => $style, download => $flag,
197                    title => $title);
198                # Some searches require optional columns that are configured by the
199                # user or by the search query itself. There are some special methods
200                # for this in the result helpers, but there's also the direct approach
201                # shown below.
202                $rhelp->AddOptionalColumn($name => $loc);
203              # Initialize the session file.              # Initialize the session file.
204              $self->OpenSession();              $self->OpenSession($rhelp);
205              # Initialize the result counter.              # Initialize the result counter.
206              $retVal = 0;              $retVal = 0;
207              ... get a list of genomes ...              ... set up to loop through the results ...
208              for my $genomeID (... each genome ...) {              while (...more results...) {
209                  my $fq = FeatureQuery->new($self, $genomeID);                  ...compute extra columns and call PutExtraColumns...
210                  while (my $feature = $fq->Fetch()) {                  $rhelp->PutData($sortKey, $objectID, $record);
                     ... examine the feature ...  
                     if (... we want to keep it ...) {  
                         $self->PutFeature($fq);  
211                          $retVal++;                          $retVal++;
212                      }                      }
                 }  
             }  
213              # Close the session file.              # Close the session file.
214              $self->CloseSession();              $self->CloseSession();
215          }          }
# Line 225  Line 218 
218      }      }
219    
220  A Find method is of course much more complicated than generating a form, and there  A Find method is of course much more complicated than generating a form, and there
221  are variations on the above theme. For example, you could eschew feature filtering  are variations on the above theme.
 entirely in favor of your own custom filtering, you could include extra columns  
 in the output, or you could search for something that's not a feature at all. The  
 above code is just a loose framework.  
222    
223  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>  In addition to the finding and filtering, it is necessary to send status messages
224  method of the feature query object.  to the output so that the user does not get bored waiting for results. The L</PrintLine>
225    method performs this function. The single parameter should be text to be
226    output to the browser. In general, you'll invoke it as follows.
227    
228      $fq->AddExtraColumns(score => $sc);      $self->PrintLine("...my message text...<br />");
229    
230    The break tag is optional. When the Find method gets control, a paragraph will
231    have been started so that everything is XHTML-compliant.
232    
233  The L</Find> method must return C<undef> if the search parameters are invalid. If this  The L</Find> method must return C<undef> if the search parameters are invalid. If this
234  is the case, then a message describing the problem should be passed to the framework  is the case, then a message describing the problem should be passed to the framework
# Line 251  Line 246 
246    
247  =head3 new  =head3 new
248    
249  C<< my $shelp = SearchHelper->new($query); >>      my $shelp = SearchHelper->new($cgi);
250    
251  Construct a new SearchHelper object.  Construct a new SearchHelper object.
252    
# Line 268  Line 263 
263  sub new {  sub new {
264      # Get the parameters.      # Get the parameters.
265      my ($class, $cgi) = @_;      my ($class, $cgi) = @_;
266      # Check for a session ID.      # Check for a session ID. First we look in the CGI parameters.
267      my $session_id = $cgi->param("SessionID");      my $session_id = $cgi->param("SessionID");
268      my $type = "old";      my $type = "old";
269      if (! $session_id) {      if (! $session_id) {
270            # We need a session ID. Try to get it from the cookies.
271            my %cookies = fetch CGI::Cookie;
272            my $session_cookie = $cookies{$class};
273            if (! $session_cookie) {
274                Trace("No session ID found.") if T(3);
275          # 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
276          # store it in the query object.              # store it in a cookie.
277          $session_id = NewSessionID();              $session_id = FIGRules::NewSessionID();
278                Trace("New session ID is $session_id.") if T(3);
279                $session_cookie = new CGI::Cookie(-name => $class,
280                                                  -value => $session_id,
281                                                  -expires => '+7d');
282                $session_cookie->bake();
283            } else {
284                # Here we're recovering an old session. The session ID is
285                # used to find any old search options lying around, but we're
286                # still considered a new session.
287                $session_id = $session_cookie->value();
288                Trace("Session $session_id recovered from cookie.") if T(3);
289            }
290            # Denote this is a new session.
291          $type = "new";          $type = "new";
292            # Put the session IS in the parameters.
293          $cgi->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
294        } else {
295            Trace("Session ID is $session_id.") if T(3);
296      }      }
297        Trace("Computing subclass.") if T(3);
298      # Compute the subclass name.      # Compute the subclass name.
299      my $subClass;      my $subClass;
300      if ($class =~ /SH(.+)$/) {      if ($class =~ /SH(.+)$/) {
# Line 288  Line 305 
305          # process search results.          # process search results.
306          $subClass = 'SearchHelper';          $subClass = 'SearchHelper';
307      }      }
308        Trace("Subclass name is $subClass.") if T(3);
309      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
310      $cgi->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++;
314        Trace("Creating helper.") if T(3);
315      # Create the shelp object. It contains the query object (with the session ID)      # Create the shelp object. It contains the query object (with the session ID)
316      # 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
317      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
# Line 306  Line 325 
325                    scriptQueue => [],                    scriptQueue => [],
326                    genomeList => undef,                    genomeList => undef,
327                    genomeParms => [],                    genomeParms => [],
328                    filtered => 0,                    notices => [],
329                   };                   };
330      # Bless and return it.      # Bless and return it.
331      bless $retVal, $class;      bless $retVal, $class;
# Line 315  Line 334 
334    
335  =head3 Q  =head3 Q
336    
337  C<< my $query = $shelp->Q(); >>      my $query = $shelp->Q();
338    
339  Return the CGI query object.  Return the CGI query object.
340    
# Line 329  Line 348 
348  }  }
349    
350    
   
351  =head3 DB  =head3 DB
352    
353  C<< my $sprout = $shelp->DB(); >>      my $sprout = $shelp->DB();
354    
355  Return the Sprout database object.  Return the Sprout database object.
356    
# Line 353  Line 371 
371    
372  =head3 IsNew  =head3 IsNew
373    
374  C<< my $flag = $shelp->IsNew(); >>      my $flag = $shelp->IsNew();
375    
376  Return TRUE if this is a new session, FALSE if this is an old session. An old  Return TRUE if this is a new session, FALSE if this is an old session. An old
377  session already has search results ready to process.  session already has search results ready to process.
# Line 369  Line 387 
387    
388  =head3 ID  =head3 ID
389    
390  C<< my $sessionID = $shelp->ID(); >>      my $sessionID = $shelp->ID();
391    
392  Return the current session ID.  Return the current session ID.
393    
# Line 384  Line 402 
402    
403  =head3 FormName  =head3 FormName
404    
405  C<< my $name = $shelp->FormName(); >>      my $name = $shelp->FormName();
406    
407  Return the name of the form this helper object will generate.  Return the name of the form this helper object will generate.
408    
# Line 399  Line 417 
417    
418  =head3 QueueFormScript  =head3 QueueFormScript
419    
420  C<< $shelp->QueueFormScript($statement); >>      $shelp->QueueFormScript($statement);
421    
422  Add the specified statement to the queue of JavaScript statements that are to be  Add the specified statement to the queue of JavaScript statements that are to be
423  executed when the form has been fully defined. This is necessary because until  executed when the form has been fully defined. This is necessary because until
# Line 434  Line 452 
452    
453  =head3 FormStart  =head3 FormStart
454    
455  C<< my $html = $shelp->FormStart($title); >>      my $html = $shelp->FormStart($title);
456    
457  Return the initial section of a form designed to perform another search of the  Return the initial section of a form designed to perform another search of the
458  same type. The form header is included along with hidden fields to persist the  same type. The form header is included along with hidden fields to persist the
# Line 464  Line 482 
482      # Start the form. Note we use the override option on the Class value, in      # Start the form. Note we use the override option on the Class value, in
483      # case the Advanced button was used.      # case the Advanced button was used.
484      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
485                   $cgi->start_form(-method => 'POST',                   CGI::start_form(-method => 'POST',
486                                    -action => $cgi->url(-relative => 1),                                    -action => "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/search",
487                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
488                   $cgi->hidden(-name => 'Class',                   CGI::hidden(-name => 'Class',
489                                -value => $self->{class},                                -value => $self->{class}) .
490                                -override => 1) .                   CGI::hidden(-name => 'SPROUT',
                  $cgi->hidden(-name => 'SPROUT',  
491                                -value => 1) .                                -value => 1) .
492                   $cgi->h3($title);                   CGI::h3("$title" . Hint($self->{class}, "Click here for more information."));
     # If tracing is on, add it to the form.  
     if ($cgi->param('Trace')) {  
         $retVal .= $cgi->hidden(-name => 'Trace',  
                                 -value => $cgi->param('Trace')) .  
                    $cgi->hidden(-name => 'TF',  
                                 -value => ($cgi->param('TF') ? 1 : 0));  
     }  
493      # Put in an anchor tag in case there's a table of contents.      # Put in an anchor tag in case there's a table of contents.
494      my $anchorName = $self->FormName();      my $anchorName = $self->FormName();
495      $retVal .= "<a name=\"$anchorName\"></a>\n";      $retVal .= "<a name=\"$anchorName\"></a>\n";
# Line 489  Line 499 
499    
500  =head3 FormEnd  =head3 FormEnd
501    
502  C<< my $htmlText = $shelp->FormEnd(); >>      my $htmlText = $shelp->FormEnd();
503    
504  Return the HTML text for closing a search form. This closes both the C<form> and  Return the HTML text for closing a search form. This closes both the C<form> and
505  C<div> tags.  C<div> tags.
# Line 521  Line 531 
531    
532  =head3 SetMessage  =head3 SetMessage
533    
534  C<< $shelp->SetMessage($msg); >>      $shelp->SetMessage($msg);
535    
536  Store the specified text as the result message. The result message is displayed  Store the specified text as the result message. The result message is displayed
537  if an invalid parameter value is specified.  if an invalid parameter value is specified.
# Line 545  Line 555 
555    
556  =head3 Message  =head3 Message
557    
558  C<< my $text = $shelp->Message(); >>      my $text = $shelp->Message();
559    
560  Return the result message. The result message is displayed if an invalid parameter  Return the result message. The result message is displayed if an invalid parameter
561  value is specified.  value is specified.
# Line 561  Line 571 
571    
572  =head3 OpenSession  =head3 OpenSession
573    
574  C<< $shelp->OpenSession(); >>      $shelp->OpenSession($rhelp);
575    
576    Set up the session cache file and write out the column headers.
577    This method should not be called until all the columns have
578    been configured, including the extra columns.
579    
580    =over 4
581    
582    =item rhelp
583    
584    Result helper for formatting the output. This has the column
585    headers stored in it.
586    
587  Set up to open the session cache file for writing. Note we don't actually  =back
 open the file until after we know the column headers.  
588    
589  =cut  =cut
590    
591  sub OpenSession {  sub OpenSession {
592      # Get the parameters.      # Get the parameters.
593      my ($self) = @_;      my ($self, $rhelp) = @_;
594      # Denote we have not yet written out the column headers.      # Insure the result helper is valid.
595      $self->{cols} = undef;      if (! defined($rhelp)) {
596            Confess("No result type specified for $self->{class}.");
597        } elsif(! $rhelp->isa('ResultHelper')) {
598            Confess("Invalid result type specified for $self->{class}.");
599        } else {
600            # Get the column headers and write them out.
601            my $colHdrs = $rhelp->GetColumnHeaders();
602            Trace(scalar(@{$colHdrs}) . " column headers written to output.") if T(3);
603            $self->WriteColumnHeaders(@{$colHdrs});
604        }
605  }  }
606    
607  =head3 GetCacheFileName  =head3 GetCacheFileName
608    
609  C<< my $fileName = $shelp->GetCacheFileName(); >>      my $fileName = $shelp->GetCacheFileName();
610    
611  Return the name to be used for this session's cache file.  Return the name to be used for this session's cache file.
612    
# Line 592  Line 621 
621    
622  =head3 GetTempFileName  =head3 GetTempFileName
623    
624  C<< my $fileName = $shelp->GetTempFileName($type); >>      my $fileName = $shelp->GetTempFileName($type);
625    
626  Return the name to be used for a temporary file of the specified type. The  Return the name to be used for a temporary file of the specified type. The
627  name is computed from the session name with the type as a suffix.  name is computed from the session name with the type as a suffix.
# Line 616  Line 645 
645      my ($self, $type) = @_;      my ($self, $type) = @_;
646      # Compute the file name. Note it gets stuffed in the FIG temporary      # Compute the file name. Note it gets stuffed in the FIG temporary
647      # directory.      # directory.
648      my $retVal = "$FIG_Config::temp/tmp_" . $self->ID() . ".$type";      my $retVal = FIGRules::GetTempFileName(sessionID => $self->ID(), extension => $type);
649      # Return the result.      # Return the result.
650      return $retVal;      return $retVal;
651  }  }
652    
653  =head3 PutFeature  =head3 WriteColumnHeaders
654    
655  C<< $shelp->PutFeature($fdata); >>      $shelp->WriteColumnHeaders(@colNames);
656    
657  Store a feature in the result cache. This is the workhorse method for most  Write out the column headers for the current search session. The column headers
658  searches, since the primary data item in the database is features.  are sent to the cache file, and then the cache is re-opened as a sort pipe and
659    the handle saved.
660    
661  For each feature, there are certain columns that are standard: the feature name, the  =over 4
 GBrowse and protein page links, the functional assignment, and so forth. If additional  
 columns are required by a particular search subclass, they should be stored in  
 the feature query object using the B<AddExtraColumns> method. For example, the following  
 code adds columns for essentiality and virulence.  
662    
663      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  =item colNames
     $shelp->PutFeature($fd);  
664    
665  For correct results, all values should be specified for all extra columns in all calls to  A list of column names in the desired presentation order. For extra columns,
666  B<PutFeature>. (In particular, the column header names are computed on the first  the column name is the hash supplied as the column definition.
 call.) If a column is to be blank for the current feature, its value can be given  
 as C<undef>.  
667    
668      if (! $essentialFlag) {  =back
669          $essentialFlag = undef;  
670    =cut
671    
672    sub WriteColumnHeaders {
673        # Get the parameters.
674        my ($self, @colNames) = @_;
675        # Get the cache file name and open it for output.
676        my $fileName = $self->GetCacheFileName();
677        my $handle1 = Open(undef, ">$fileName");
678        # Freeze the column headers.
679        my @colHdrs = map { freeze($_) } @colNames;
680        # Write the column headers and close the file.
681        Tracer::PutLine($handle1, \@colHdrs);
682        close $handle1;
683        # Now open the sort pipe and save the file handle. Note how we append the
684        # sorted data to the column header row already in place. The output will
685        # contain a sort key followed by the real columns. The sort key is
686        # hacked off before going to the output file.
687        $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
688      }      }
689      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
690      $shelp->PutFeature($fd);  =head3 SetNotice
691    
692        $shelp->SetNotice($message);
693    
694    This method creates a notice that will be displayed on the search results
695    page. After the search is complete, notices are placed in a small temporary
696    file that is checked by the results display engine.
697    
698  =over 4  =over 4
699    
700  =item fdata  =item message
701    
702  B<FeatureData> object containing the current feature data.  Message to write to the notice file.
703    
704  =back  =back
705    
706  =cut  =cut
707    
708  sub PutFeature {  sub SetNotice {
709      # Get the parameters.      # Get the parameters.
710      my ($self, $fd) = @_;      my ($self, $message) = @_;
711      # Get the CGI query object.      # Save the message.
712      my $cgi = $self->Q();      push @{$self->{notices}}, $message;
     # Get the feature data.  
     my $record = $fd->Feature();  
     my $extraCols = $fd->ExtraCols();  
     # Check for a first-call situation.  
     if (! defined $self->{cols}) {  
         Trace("Setting up the columns.") if T(3);  
         # Here we need to set up the column information. Start with the extras,  
         # sorted by column name.  
         my @colNames = ();  
         for my $col (sort keys %{$extraCols}) {  
             push @colNames, "X=$col";  
         }  
         # Add the default columns.  
         push @colNames, $self->DefaultFeatureColumns();  
         # Add any additional columns requested by the feature filter.  
         push @colNames, FeatureQuery::AdditionalColumns($self);  
         # Save the full list.  
         $self->{cols} = \@colNames;  
         # Write out the column headers. This also prepares the cache file to receive  
         # output.  
         $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});  
     }  
     # Get the feature ID.  
     my $fid = $fd->FID();  
     # Loop through the column headers, producing the desired data.  
     my @output = ();  
     for my $colName (@{$self->{cols}}) {  
         push @output, $self->FeatureColumnValue($colName, $record, $extraCols);  
     }  
     # Compute the sort key. The sort key usually floats NMPDR organism features to the  
     # top of the return list.  
     my $key = $self->SortKey($fd);  
     # Write the feature data.  
     $self->WriteColumnData($key, @output);  
713  }  }
714    
 =head3 WriteColumnHeaders  
715    
716  C<< $shelp->WriteColumnHeaders(@colNames); >>  =head3 ReadColumnHeaders
717    
718  Write out the column headers for the current search session. The column headers      my @colHdrs = $shelp->ReadColumnHeaders($fh);
719  are sent to the cache file, and then the cache is re-opened as a sort pipe and  
720  the handle saved.  Read the column headers from the specified file handle. The column headers are
721    frozen strings intermixed with frozen hash references. The strings represent
722    column names defined in the result helper. The hash references represent the
723    definitions of the extra columns.
724    
725  =over 4  =over 4
726    
727  =item colNames  =item fh
728    
729    File handle from which the column headers are to be read.
730    
731    =item RETURN
732    
733  A list of column names in the desired presentation order.  Returns a list of the column headers pulled from the specified file's first line.
734    
735  =back  =back
736    
737  =cut  =cut
738    
739  sub WriteColumnHeaders {  sub ReadColumnHeaders {
740      # Get the parameters.      # Get the parameters.
741      my ($self, @colNames) = @_;      my ($self, $fh) = @_;
742      # Get the cache file name and open it for output.      # Read and thaw the columns.
743      my $fileName = $self->GetCacheFileName();      my @retVal = map { thaw($_) } Tracer::GetLine($fh);
744      my $handle1 = Open(undef, ">$fileName");      # Return them to the caller.
745      # Write the column headers and close the file.      return @retVal;
     Tracer::PutLine($handle1, \@colNames);  
     close $handle1;  
     # Now open the sort pipe and save the file handle. Note how we append the  
     # sorted data to the column header row already in place. The output will  
     # contain a sort key followed by the real columns. The sort key is  
     # hacked off before going to the output file.  
     $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");  
746  }  }
747    
748  =head3 WriteColumnData  =head3 WriteColumnData
749    
750  C<< $shelp->WriteColumnData($key, @colValues); >>      $shelp->WriteColumnData($key, @colValues);
751    
752  Write a row of column values to the current search session. It is assumed that  Write a row of column values to the current search session. It is assumed that
753  the session file is already open for output.  the session file is already open for output.
# Line 759  Line 771 
771      my ($self, $key, @colValues) = @_;      my ($self, $key, @colValues) = @_;
772      # Write them to the cache file.      # Write them to the cache file.
773      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);
774        Trace("Column data is " . join("; ", $key, @colValues) . ".") if T(4);
775  }  }
776    
777  =head3 CloseSession  =head3 CloseSession
778    
779  C<< $shelp->CloseSession(); >>      $shelp->CloseSession();
780    
781  Close the session file.  Close the session file.
782    
# Line 777  Line 790 
790          # We found one, so close it.          # We found one, so close it.
791          Trace("Closing session file.") if T(2);          Trace("Closing session file.") if T(2);
792          close $self->{fileHandle};          close $self->{fileHandle};
793            # Tell the user.
794            my $cgi = $self->Q();
795            $self->PrintLine("Output formatting complete.<br />");
796      }      }
797        # Check for notices.
798        my @notices = @{$self->{notices}};
799        if (scalar @notices) {
800            # We have some, so put then in a notice file.
801            my $noticeFile = $self->GetTempFileName('notices');
802            my $nh = Open(undef, ">$noticeFile");
803            print $nh join("\n", @notices, "");
804            close $nh;
805            $self->PrintLine(scalar(@notices) . " notices saved.<br />");
806  }  }
   
 =head3 NewSessionID  
   
 C<< my $id = SearchHelpers::NewSessionID(); >>  
   
 Generate a new session ID for the current user.  
   
 =cut  
   
 sub NewSessionID {  
     # Declare the return variable.  
     my $retVal;  
     # Get a digest encoder.  
     my $md5 = Digest::MD5->new();  
     # Add the PID, the IP, and the time stamp. Note that the time stamp is  
     # actually two numbers, and we get them both because we're in list  
     # context.  
     $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());  
     # Hash up all this identifying data.  
     $retVal = $md5->hexdigest();  
     # Return the result.  
     return $retVal;  
807  }  }
808    
809  =head3 OrganismData  =head3 OrganismData
810    
811  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>      my ($orgName, $group) = $shelp->Organism($genomeID);
812    
813  Return the name and status of the organism corresponding to the specified genome ID.  Return the name and status of the organism corresponding to the specified genome ID.
814  For performance reasons, this information is cached in a special hash table, so we  For performance reasons, this information is cached in a special hash table, so we
# Line 819  Line 822 
822    
823  =item RETURN  =item RETURN
824    
825  Returns a list of two items. The first item in the list is the organism name,  Returns a list of three items. The first item in the list is the organism name,
826  and the second is the name of the NMPDR group, or an empty string if the  and the second is the name of the NMPDR group, or an empty string if the
827  organism is not in an NMPDR group.  organism is not in an NMPDR group. The third item is the organism's domain.
828    
829  =back  =back
830    
# Line 831  Line 834 
834      # Get the parameters.      # Get the parameters.
835      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
836      # Declare the return variables.      # Declare the return variables.
837      my ($orgName, $group);      my ($orgName, $group, $domain);
838      # Check the cache.      # Check the cache.
839      my $cache = $self->{orgs};      my $cache = $self->{orgs};
840      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
841          ($orgName, $group) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
842            Trace("Cached organism $genomeID has group \"$group\".") if T(4);
843      } else {      } else {
844          # Here we have to use the database.          # Here we have to use the database.
845          my $sprout = $self->DB();          my $sprout = $self->DB();
846          my ($genus, $species, $strain, $group) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $newGroup, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,
847                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
848                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
849                                                       'Genome(primary-group)']);                                                                   'Genome(primary-group)',
850                                                                     'Genome(taxonomy)']);
851          # Format and cache the name and display group.          # Format and cache the name and display group.
852          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          Trace("Caching organism $genomeID with group \"$newGroup\".") if T(4);
853                                                              $strain);          ($orgName, $group, $domain) = $self->SaveOrganismData($newGroup, $genomeID, $genus, $species,
854                                                                  $strain, $taxonomy);
855            Trace("Returning group $group.") if T(4);
856      }      }
857      # Return the result.      # Return the result.
858      return ($orgName, $group);      return ($orgName, $group, $domain);
859  }  }
860    
861  =head3 Organism  =head3 Organism
862    
863  C<< my $orgName = $shelp->Organism($genomeID); >>      my $orgName = $shelp->Organism($genomeID);
864    
865  Return the name of the relevant organism. The name is computed from the genus,  Return the name of the relevant organism. The name is computed from the genus,
866  species, and unique characterization. A cache is used to improve performance.  species, and unique characterization. A cache is used to improve performance.
# Line 876  Line 883 
883      # Get the parameters.      # Get the parameters.
884      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
885      # Get the organism data.      # Get the organism data.
886      my ($retVal, $group) = $self->OrganismData($genomeID);      my ($retVal) = $self->OrganismData($genomeID);
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 FeatureGroup  
   
 C<< my $groupName = $shelp->FeatureGroup($fid); >>  
   
 Return the group name for the specified feature.  
   
 =over 4  
   
 =item fid  
   
 ID of the relevant feature.  
   
 =item RETURN  
   
 Returns the name of the NMPDR group to which the feature belongs, or an empty  
 string if it is not part of an NMPDR group.  
   
 =back  
   
 =cut  
   
 sub FeatureGroup {  
     # Get the parameters.  
     my ($self, $fid) = @_;  
     # Parse the feature ID to get the genome ID.  
     my ($genomeID) = FIGRules::ParseFeatureID($fid);  
     # Get the organism data.  
     my (undef, $retVal) = $self->OrganismData($genomeID);  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 FeatureName  
   
 C<< my $fidName = $shelp->FeatureName($fid); >>  
   
 Return the display name of the specified feature.  
   
 =over 4  
   
 =item fid  
   
 ID of the feature whose name is desired.  
   
 =item RETURN  
   
 A displayable feature name, consisting of the organism name plus some feature  
 type and location information.  
   
 =back  
   
 =cut  
   
 sub FeatureName {  
     # Get the parameters.  
     my ($self, $fid) = @_;  
     # Declare the return variable  
     my $retVal;  
     # Parse the feature ID.  
     my ($genomeID, $type, $num) = FIGRules::ParseFeatureID($fid);  
     if (! defined $genomeID) {  
         # Here the feature ID has an invalid format.  
         $retVal = "External: $fid";  
     } else {  
         # Here we can get its genome data.  
         $retVal = $self->Organism($genomeID);  
         # Append the FIG ID.  
         $retVal .= " [$fid]";  
     }  
887      # Return the result.      # Return the result.
888      return $retVal;      return $retVal;
889  }  }
890    
891  =head3 ComputeFASTA  =head3 ComputeFASTA
892    
893  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>      my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth, $comments);
894    
895  Parse a sequence input and convert it into a FASTA string of the desired type.  Parse a sequence input and convert it into a FASTA string of the desired type with
896    the desired flanking width.
897    
898  =over 4  =over 4
899    
900  =item desiredType  =item desiredType
901    
902  C<dna> to return a DNA sequence, C<prot> to return a protein sequence.  C<dna> to return a DNA sequence, C<prot> to return a protein sequence, C<dnaPattern>
903    to return a DNA search pattern, C<protPattern> to return a protein search pattern.
904    
905  =item sequence  =item sequence
906    
# Line 974  Line 910 
910  if the input does not begin with a greater-than sign (FASTA label line), a default label  if the input does not begin with a greater-than sign (FASTA label line), a default label
911  line will be provided.  line will be provided.
912    
913    =item flankingWidth
914    
915    If the DNA FASTA of a feature is desired, the number of base pairs to either side of the
916    feature that should be included. Currently we can't do this for Proteins because the
917    protein translation of a feature doesn't always match the DNA and is taken directly
918    from the database.
919    
920    =item comments
921    
922    Comment string to be added to the FASTA header.
923    
924  =item RETURN  =item RETURN
925    
926  Returns a string in FASTA format representing the content of the desired sequence with  Returns a string in FASTA format representing the content of the desired sequence with
# Line 986  Line 933 
933    
934  sub ComputeFASTA {  sub ComputeFASTA {
935      # Get the parameters.      # Get the parameters.
936      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence, $flankingWidth, $comment) = @_;
937      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
938      my $retVal;      my $retVal;
939      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 994  Line 941 
941      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
942      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
943      Trace("FASTA desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
944      # Check for a feature specification.      # Check for a feature specification. The smoking gun for that is a vertical bar.
945      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
946          # Here we have a feature ID in $1. We'll need the Sprout object to process          # Here we have a feature ID in $1. We'll need the Sprout object to process
947          # it.          # it.
# Line 1009  Line 956 
956              $self->SetMessage("No gene found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
957              $okFlag = 0;              $okFlag = 0;
958          } else {          } else {
959              # Set the FASTA label.              # Set the FASTA label. The ID is the first favored alias.
960              my $fastaLabel = $fid;              my $favored = $self->Q()->param('FavoredAlias') || 'fig';
961                my $favorLen = length $favored;
962                ($fastaLabel) = grep { substr($_, 0, $favorLen) eq $favored } $sprout->FeatureAliases($fid);
963                if (! $fastaLabel) {
964                    # In an emergency, fall back to the original ID.
965                    $fastaLabel = $fid;
966                }
967                # Add any specified comments.
968                if ($comment) {
969                    $fastaLabel .= " $comment";
970                }
971              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
972              if ($desiredType eq 'prot') {              if ($desiredType =~ /prot/) {
973                  # We want protein, so get the translation.                  # We want protein, so get the translation.
974                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
975                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
976              } else {              } elsif ($desiredType =~ /dna/) {
977                  # We want DNA, so get the DNA sequence. This is a two-step process.                  # We want DNA, so get the DNA sequence. This is a two-step process. First, we get the
978                    # locations.
979                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
980                    if ($flankingWidth > 0) {
981                        # Here we need to add flanking data. Convert the locations to a list
982                        # of location objects.
983                        my @locObjects = map { BasicLocation->new($_) } @locList;
984                        # Initialize the return variable. We will put the DNA in here segment by segment.
985                        $fastaData = "";
986                        # Now we widen each location by the flanking width and stash the results. This
987                        # requires getting the contig length for each contig so we don't fall off the end.
988                        for my $locObject (@locObjects) {
989                            Trace("Current location is " . $locObject->String . ".") if T(4);
990                            # Remember the current start and length.
991                            my ($start, $len) = ($locObject->Left, $locObject->Length);
992                            # Get the contig length.
993                            my $contigLen = $sprout->ContigLength($locObject->Contig);
994                            # Widen the location and get its DNA.
995                            $locObject->Widen($flankingWidth, $contigLen);
996                            my $fastaSegment = $sprout->DNASeq([$locObject->String()]);
997                            # Now we need to do some case changing. The main DNA is upper case and
998                            # the flanking DNA is lower case.
999                            my $leftFlank = $start - $locObject->Left;
1000                            my $rightFlank = $leftFlank + $len;
1001                            Trace("Wide location is " . $locObject->String . ". Flanks are $leftFlank and $rightFlank. Contig len is $contigLen.") if T(4);
1002                            my $fancyFastaSegment = lc(substr($fastaSegment, 0, $leftFlank)) .
1003                                                    uc(substr($fastaSegment, $leftFlank, $rightFlank - $leftFlank)) .
1004                                                    lc(substr($fastaSegment, $rightFlank));
1005                            $fastaData .= $fancyFastaSegment;
1006                        }
1007                    } else {
1008                        # Here we have just the raw sequence.
1009                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
1010                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  }
1011                    Trace((length $fastaData) . " characters returned for DNA of $fastaLabel.") if T(3);
1012              }              }
1013          }          }
1014      } else {      } else {
# Line 1035  Line 1023 
1023              Trace("No label found in match to sequence:\n$sequence") if T(4);              Trace("No label found in match to sequence:\n$sequence") if T(4);
1024              # Here we have no label, so we create one and use the entire sequence              # Here we have no label, so we create one and use the entire sequence
1025              # as data.              # as data.
1026              $fastaLabel = "User-specified $desiredType sequence";              $fastaLabel = "$desiredType sequence specified by user";
1027              $fastaData = $sequence;              $fastaData = $sequence;
1028          }          }
1029          # The next step is to clean the junk out of the sequence.          # If we are not doing a pattern search, we need to clean the junk out of the sequence.
1030            if ($desiredType !~ /pattern/i) {
1031          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1032          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1033            }
1034          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
1035          if ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {
1036              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
1037              $okFlag = 0;              $okFlag = 0;
1038          }          }
1039      }      }
1040      Trace("FASTA data sequence: $fastaData") if T(4);      Trace("FASTA data sequence: $fastaData") if T(4);
1041      # Only proceed if no error was detected.      # Only proceed if no error was detected.
1042      if ($okFlag) {      if ($okFlag) {
1043            if ($desiredType =~ /pattern/i) {
1044                # For a scan, there is no label and no breakup.
1045                $retVal = $fastaData;
1046            } else {
1047          # We need to format the sequence into 60-byte chunks. We use the infamous          # We need to format the sequence into 60-byte chunks. We use the infamous
1048          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
1049          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
# Line 1058  Line 1052 
1052          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
1053          $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
1054      }      }
1055        }
1056      # Return the result.      # Return the result.
1057      return $retVal;      return $retVal;
1058  }  }
1059    
1060  =head3 SubsystemTree  =head3 SubsystemTree
1061    
1062  C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>      my $tree = SearchHelper::SubsystemTree($sprout, %options);
1063    
1064  This method creates a subsystem selection tree suitable for passing to  This method creates a subsystem selection tree suitable for passing to
1065  L</SelectionTree>. Each leaf node in the tree will have a link to the  L</SelectionTree>. Each leaf node in the tree will have a link to the
# Line 1114  Line 1109 
1109      # Read in the subsystems.      # Read in the subsystems.
1110      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1111                                 ['Subsystem(classification)', 'Subsystem(id)']);                                 ['Subsystem(classification)', 'Subsystem(id)']);
1112        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1113        # is at the end, ALL subsystems are unclassified and we don't bother.
1114        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1115            while ($subs[0]->[0] eq '') {
1116                my $classLess = shift @subs;
1117                push @subs, $classLess;
1118            }
1119        }
1120        # Get the seedviewer URL.
1121        my $svURL = $FIG_Config::linkinSV || "$FIG_Config::cgi_url/seedviewer.cgi";
1122        Trace("Seed Viewer URL is $svURL.") if T(3);
1123      # Declare the return variable.      # Declare the return variable.
1124      my @retVal = ();      my @retVal = ();
1125      # 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 1188  Line 1194 
1194              if ($optionThing->{links}) {              if ($optionThing->{links}) {
1195                  # Compute the link value.                  # Compute the link value.
1196                  my $linkable = uri_escape($id);                  my $linkable = uri_escape($id);
1197                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";                  $nodeContent->{link} = "$svURL?page=Subsystems;subsystem=$linkable";
1198              }              }
1199              if ($optionThing->{radio}) {              if ($optionThing->{radio}) {
1200                  # Compute the radio value.                  # Compute the radio value.
# Line 1206  Line 1212 
1212    
1213  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1214    
1215  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>      my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows);
1216    
1217  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The
1218  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it
# Line 1235  Line 1241 
1241    
1242  =item crossMenu (optional)  =item crossMenu (optional)
1243    
1244  If specified, is presumed to be the name of another genome menu whose contents  This is currently not supported.
 are to be mutually exclusive with the contents of this menu. As a result, instead  
 of the standard onChange event, the onChange event will deselect any entries in  
 the other menu.  
1245    
1246  =item RETURN  =item RETURN
1247    
# Line 1258  Line 1261 
1261      if (! defined $rows) {      if (! defined $rows) {
1262          $rows = ($multiple ? 10 : 1);          $rows = ($multiple ? 10 : 1);
1263      }      }
1264      # Create the multiple tag.      # Get a comma-delimited list of the preselected genomes.
1265      my $multipleTag = ($multiple ? " multiple" : "");      my $preselected = "";
1266      # Get the form name.      if ($selected) {
1267      my $formName = $self->FormName();          $preselected = join(", ", @$selected);
1268      # Check to see if we already have a genome list in memory.      }
1269      my $genomes = $self->{genomeList};      # Ask Sprout for a genome menu.
1270      my $groupHash;      my $retVal = $sprout->GenomeMenu(name => $menuName,
1271      if (defined $genomes) {                                       multiSelect => $multiple,
1272          # We have a list ready to use.                                       selected => $preselected,
1273          $groupHash = $genomes;                                       size => $rows);
     } else {  
         # Get a list of all the genomes in group order. In fact, we only need them ordered  
         # by name (genus,species,strain), but putting primary-group in front enables us to  
         # take advantage of an existing index.  
         my @genomeList = $sprout->GetAll(['Genome'],  
                                          "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",  
                                          [], ['Genome(primary-group)', 'Genome(id)',  
                                               'Genome(genus)', 'Genome(species)',  
                                               'Genome(unique-characterization)']);  
         # Create a hash to organize the genomes by group. Each group will contain a list of  
         # 2-tuples, the first element being the genome ID and the second being the genome  
         # name.  
         my %gHash = ();  
         for my $genome (@genomeList) {  
             # Get the genome data.  
             my ($group, $genomeID, $genus, $species, $strain) = @{$genome};  
             # Compute and cache its name and display group.  
             my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,  
                                                                 $strain);  
             # Push the genome into the group's list. Note that we use the real group  
             # name here, not the display group name.  
             push @{$gHash{$group}}, [$genomeID, $name];  
         }  
         # Save the genome list for future use.  
         $self->{genomeList} = \%gHash;  
         $groupHash = \%gHash;  
     }  
     # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting  
     # the supporting-genome group last.  
     my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};  
     push @groups, $FIG_Config::otherGroup;  
     # Next, create a hash that specifies the pre-selected entries. Note that we need to deal  
     # with the possibility of undefined values in the incoming list.  
     my %selectedHash = ();  
     if (defined $selected) {  
         %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};  
     }  
     # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage  
     # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes  
     # and use that to make the selections.  
     my $nmpdrCount = 0;  
     # Create the type counters.  
     my $groupCount = 1;  
     # Compute the ID for the status display.  
     my $divID = "${formName}_${menuName}_status";  
     # Compute the JavaScript call for updating the status.  
     my $showSelect = "showSelected($menuName, '$divID', 1000);";  
     # If multiple selection is supported, create an onChange event.  
     my $onChange = "";  
     if ($cross) {  
         # Here we have a paired menu. Selecting something in our menu unselects it in the  
         # other and redisplays the status of both.  
         $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";  
     } elsif ($multiple) {  
         # This is an unpaired menu, so all we do is redisplay our status.  
         $onChange = " onChange=\"$showSelect\"";  
     }  
     # Create the SELECT tag and stuff it into the output array.  
     my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");  
     # Loop through the groups.  
     for my $group (@groups) {  
         # Create the option group tag.  
         my $tag = "<OPTGROUP label=\"$group\">";  
         push @lines, "  $tag";  
         # Get the genomes in the group.  
         for my $genome (@{$groupHash->{$group}}) {  
             # Count this organism if it's NMPDR.  
             if ($group ne $FIG_Config::otherGroup) {  
                 $nmpdrCount++;  
             }  
             # Get the organism ID and name.  
             my ($genomeID, $name) = @{$genome};  
             # See if it's selected.  
             my $select = ($selectedHash{$genomeID} ? " selected" : "");  
             # Generate the option tag.  
             my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";  
             push @lines, "    $optionTag";  
         }  
         # Close the option group.  
         push @lines, "  </OPTGROUP>";  
     }  
     # Close the SELECT tag.  
     push @lines, "</SELECT>";  
     # Check for multiple selection.  
     if ($multiple) {  
         # Multi-select is on, so we need to add some selection helpers. First is  
         # the search box. This allows the user to type text and have all genomes containing  
         # the text selected automatically.  
         my $searchThingName = "${menuName}_SearchThing";  
         push @lines, "<br />" .  
                      "<INPUT type=\"button\" name=\"Search\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .  
                      "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";  
         # Next are the buttons to set and clear selections.  
         push @lines, "<br />";  
         push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";  
         # Add the status display, too.  
         push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";  
         # Queue to update the status display when the form loads. We need to modify the show statement  
         # slightly because the queued statements are executed outside the form. This may seem like a lot of  
         # trouble, but we want all of the show statement calls to be generated from a single line of code,  
         # in case we decide to twiddle the parameters.  
         $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;  
         $self->QueueFormScript($showSelect);  
         # Finally, add this parameter to the list of genome parameters. This enables us to  
         # easily find all the parameters used to select one or more genomes.  
         push @{$self->{genomeParms}}, $menuName;  
     }  
     # Assemble all the lines into a string.  
     my $retVal = join("\n", @lines, "");  
1274      # Return the result.      # Return the result.
1275      return $retVal;      return $retVal;
1276  }  }
1277    
1278  =head3 PropertyMenu  =head3 PropertyMenu
1279    
1280  C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>      my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force);
1281    
1282  Generate a property name dropdown menu.  Generate a property name dropdown menu.
1283    
# Line 1428  Line 1319 
1319      # Get all the property names, putting them after the null choice if one exists.      # Get all the property names, putting them after the null choice if one exists.
1320      push @propNames, $sprout->GetChoices('Property', 'property-name');      push @propNames, $sprout->GetChoices('Property', 'property-name');
1321      # Create a menu from them.      # Create a menu from them.
1322      my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,      my $retVal = CGI::popup_menu(-name=> $menuName, -values => \@propNames,
1323                                    -default => $selected);                                    -default => $selected);
1324      # Return the result.      # Return the result.
1325      return $retVal;      return $retVal;
# Line 1436  Line 1327 
1327    
1328  =head3 MakeTable  =head3 MakeTable
1329    
1330  C<< my $htmlText = $shelp->MakeTable(\@rows); >>      my $htmlText = $shelp->MakeTable(\@rows);
1331    
1332  Create a table from a group of table rows. The table rows must be fully pre-formatted: in  Create a table from a group of table rows. The table rows must be fully pre-formatted: in
1333  other words, each must have the TR and TD tags included.  other words, each must have the TR and TD tags included.
# Line 1452  Line 1343 
1343  =item rows  =item rows
1344    
1345  Reference to a list of table rows. Each table row must be in HTML form with all  Reference to a list of table rows. Each table row must be in HTML form with all
1346  the TR and TD tags set up. The first TD or TH tag in each row will be modified to  the TR and TD tags set up. The first TD or TH tag in the first non-colspanned row
1347  set the width. Everything else will be left as is.  will be modified to set the width. Everything else will be left as is.
1348    
1349  =item RETURN  =item RETURN
1350    
# Line 1468  Line 1359 
1359      my ($self, $rows) = @_;      my ($self, $rows) = @_;
1360      # Get the CGI object.      # Get the CGI object.
1361      my $cgi = $self->Q();      my $cgi = $self->Q();
1362      # Fix the widths on the first column. Note that we eschew the use of the "g"      # The first column of the first row must have its width fixed.
1363        # This flag will be set to FALSE when that happens.
1364        my $needWidth = 1;
1365      # modifier becase we only want to change the first tag. Also, if a width      # modifier becase we only want to change the first tag. Also, if a width
1366      # is already specified on the first column bad things will happen.      # is already specified on the first column bad things will happen.
1367      for my $row (@{$rows}) {      for my $row (@{$rows}) {
1368          $row =~ s/(<td|th)/$1 width="150"/i;          # See if this row needs a width.
1369            if ($needWidth && $row =~ /<(td|th) ([^>]+)>/i) {
1370                # Here we have a first cell and its tag parameters are in $2.
1371                my $elements = $2;
1372                if ($elements !~ /colspan/i) {
1373                    Trace("No colspan tag found in element \'$elements\'.") if T(3);
1374                    # Here there's no colspan, so we plug in the width. We
1375                    # eschew the "g" modifier on the substitution because we
1376                    # only want to update the first cell.
1377                    $row =~ s/(<(td|th))/$1 width="150"/i;
1378                    # Denote we don't need this any more.
1379                    $needWidth = 0;
1380                }
1381            }
1382      }      }
1383      # Create the table.      # Create the table.
1384      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = CGI::table({border => 2, cellspacing => 2,
1385                                width => 700, class => 'search'},                                width => 700, class => 'search'},
1386                               @{$rows});                               @{$rows});
1387      # Return the result.      # Return the result.
# Line 1484  Line 1390 
1390    
1391  =head3 SubmitRow  =head3 SubmitRow
1392    
1393  C<< my $htmlText = $shelp->SubmitRow($caption); >>      my $htmlText = $shelp->SubmitRow($caption);
1394    
1395  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1396  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
# Line 1513  Line 1419 
1419      my $realCaption = (defined $caption ? $caption : 'Go');      my $realCaption = (defined $caption ? $caption : 'Go');
1420      # Get the current page size.      # Get the current page size.
1421      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1422      # Get the incoming external-link flag.      # Get the current feature ID type.
1423      my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);      my $aliasType = $self->GetPreferredAliasType();
1424      # Create the row.      # Create the rows.
1425      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = CGI::Tr(CGI::td("Identifier Type "),
1426                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            CGI::td({ colspan => 2 },
1427                                       CGI::popup_menu(-name => 'AliasType',
1428                                                        -values => ['FIG', AliasAnalysis::AliasTypes() ],
1429                                                        -default => $aliasType) .
1430                                       Hint("Identifier Type", "Specify how you want gene names to be displayed."))) .
1431                     "\n" .
1432                     CGI::Tr(CGI::td("Results/Page"),
1433                              CGI::td(CGI::popup_menu(-name => 'PageSize',
1434                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1435                                                      -default => $pageSize) . " " .                                                      -default => $pageSize)),
1436                                     $cgi->checkbox(-name => 'ShowURL',                            CGI::td(CGI::submit(-class => 'goButton',
                                                   -value => 1,  
                                                   -label => 'Show URL')),  
                           $cgi->td($cgi->submit(-class => 'goButton',  
1437                                                  -name => 'Search',                                                  -name => 'Search',
1438                                                  -value => $realCaption)));                                                  -value => $realCaption)));
1439      # Return the result.      # Return the result.
1440      return $retVal;      return $retVal;
1441  }  }
1442    
 =head3 FeatureFilterRows  
   
 C<< my $htmlText = $shelp->FeatureFilterRows(); >>  
   
 This method creates table rows that can be used to filter features. The form  
 values can be used to select features by genome using the B<FeatureQuery>  
 object.  
   
 =cut  
   
 sub FeatureFilterRows {  
     # Get the parameters.  
     my ($self) = @_;  
     # Return the result.  
     return FeatureQuery::FilterRows($self);  
 }  
   
 =head3 GBrowseFeatureURL  
   
 C<< my $url = SearchHelper::GBrowseFeatureURL($sprout, $feat); >>  
   
 Compute the URL required to pull up a Gbrowse page for the the specified feature.  
 In order to do this, we need to pull out the ID of the feature's Genome, its  
 contig ID, and some rough starting and stopping offsets.  
   
 =over 4  
   
 =item sprout  
   
 Sprout object for accessing the database.  
   
 =item feat  
   
 ID of the feature whose Gbrowse URL is desired.  
   
 =item RETURN  
   
 Returns a GET-style URL for the Gbrowse CGI, with parameters specifying the genome  
 ID, contig ID, starting offset, and stopping offset.  
   
 =back  
   
 =cut  
   
 sub GBrowseFeatureURL {  
     # Get the parameters.  
     my ($sprout, $feat) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Compute the genome ID.  
     my ($genomeID) = FIGRules::ParseFeatureID($feat);  
     # Only proceed if the feature ID produces a valid genome.  
     if ($genomeID) {  
         # Get the feature location string.  
         my $loc = $sprout->FeatureLocation($feat);  
         # Compute the contig, start, and stop points.  
         my($contig, $start, $stop) = BasicLocation::Parse($loc);  
         Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);  
         # Now we need to do some goofiness to insure that the location is not too  
         # big and that we get some surrounding stuff.  
         my $mid = int(($start + $stop) / 2);  
         my $chunk_len = 20000;  
         my $max_feature = 40000;  
         my $feat_len = abs($stop - $start);  
         if ($feat_len > $chunk_len) {  
             if ($feat_len > $max_feature) {  
                 $chunk_len = $max_feature;  
             } else {  
                 $chunk_len = $feat_len + 100;  
             }  
         }  
         my($show_start, $show_stop);  
         if ($chunk_len == $max_feature) {  
             $show_start = $start - 300;  
         } else {  
             $show_start = $mid - int($chunk_len / 2);  
         }  
         if ($show_start < 1) {  
             $show_start = 1;  
         }  
         $show_stop = $show_start + $chunk_len - 1;  
         my $clen = $sprout->ContigLength($contig);  
         if ($show_stop > $clen) {  
             $show_stop = $clen;  
         }  
         my $seg_id = $contig;  
         $seg_id =~ s/:/--/g;  
         Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);  
         # Assemble all the pieces.  
         $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id;start=$show_start;stop=$show_stop";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
1443  =head3 GetGenomes  =head3 GetGenomes
1444    
1445  C<< my @genomeList = $shelp->GetGenomes($parmName); >>      my @genomeList = $shelp->GetGenomes($parmName);
1446    
1447  Return the list of genomes specified by the specified CGI query parameter.  Return the list of genomes specified by the specified CGI query parameter.
1448  If the request method is POST, then the list of genome IDs is returned  If the request method is POST, then the list of genome IDs is returned
# Line 1669  Line 1484 
1484      return @retVal;      return @retVal;
1485  }  }
1486    
 =head3 GetHelpText  
   
 C<< my $htmlText = $shelp->GetHelpText(); >>  
   
 Get the help text for this search. The help text is stored in files on the template  
 server. The help text for a specific search is taken from a file named  
 C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.  
 There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the  
 feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>  
 describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>  
 describes the standard controls for a search, such as page size, URL display, and  
 external alias display.  
   
 =cut  
   
 sub GetHelpText {  
     # Get the parameters.  
     my ($self) = @_;  
     # Create a list to hold the pieces of the help.  
     my @helps = ();  
     # Get the template directory URL.  
     my $urlBase = $FIG_Config::template_url;  
     # Start with the specific help.  
     my $class = $self->{class};  
     push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");  
     # Add the genome control help if needed.  
     if (scalar @{$self->{genomeParms}}) {  
         push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");  
     }  
     # Next the filter help.  
     if ($self->{filtered}) {  
         push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");  
     }  
     # Finally, the standard help.  
     push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");  
     # Assemble the pieces.  
     my $retVal = join("\n<p>&nbsp;</p>\n", @helps);  
     # Return the result.  
     return $retVal;  
 }  
   
1487  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1488    
1489  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>      my $url = $shelp->ComputeSearchURL(%overrides);
1490    
1491  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
1492  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 1745  Line 1519 
1519      my $cgi = $self->Q();      my $cgi = $self->Q();
1520      my $sprout = $self->DB();      my $sprout = $self->DB();
1521      # Start with the full URL.      # Start with the full URL.
1522      my $retVal = $cgi->url(-full => 1);      my $retVal = "$FIG_Config::cgi_url/SearchSkeleton.cgi";
1523      # Get all the query parameters in a hash.      # Get all the query parameters in a hash.
1524      my %parms = $cgi->Vars();      my %parms = $cgi->Vars();
1525      # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null      # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
# Line 1767  Line 1541 
1541          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1542          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1543          # Check for special cases.          # Check for special cases.
1544          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1545              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1546              @values = ();              @values = ();
1547          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1803  Line 1577 
1577      return $retVal;      return $retVal;
1578  }  }
1579    
 =head3 GetRunTimeValue  
   
 C<< my $htmlText = $shelp->GetRunTimeValue($text); >>  
   
 Compute a run-time column value.  
   
 =over 4  
   
 =item text  
   
 The run-time column text. It consists of 2 percent signs, a column type, an equal  
 sign, and the data for the current row.  
   
 =item RETURN  
   
 Returns the fully-formatted HTML text to go into the current column of the current row.  
   
 =back  
   
 =cut  
   
 sub GetRunTimeValue {  
     # Get the parameters.  
     my ($self, $text) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Parse the incoming text.  
     if ($text =~ /^%%([^=]+)=(.*)$/) {  
         $retVal = $self->RunTimeColumns($1, $2);  
     } else {  
         Confess("Invalid run-time column string \"$text\" encountered in session file.");  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
1580  =head3 AdvancedClassList  =head3 AdvancedClassList
1581    
1582  C<< my @classes = SearchHelper::AdvancedClassList(); >>      my @classes = SearchHelper::AdvancedClassList();
1583    
1584  Return a list of advanced class names. This list is used to generate the directory  Return a list of advanced class names. This list is used to generate the directory
1585  of available searches on the search page.  of available searches on the search page.
1586    
1587  We use the %INC variable to accomplish this.  We do a file search to accomplish this, but to pull it off we need to look at %INC.
1588    
1589  =cut  =cut
1590    
1591  sub AdvancedClassList {  sub AdvancedClassList {
1592      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;      # Determine the search helper module directory.
1593      return @retVal;      my $libDirectory = $INC{'SearchHelper.pm'};
1594        $libDirectory =~ s/SearchHelper\.pm//;
1595        # Read it, keeping only the helper modules.
1596        my @modules = grep { /^SH\w+\.pm/ } Tracer::OpenDir($libDirectory, 0);
1597        # Convert the file names to search types.
1598        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } @modules;
1599        # Return the result in alphabetical order.
1600        return sort @retVal;
1601  }  }
1602    
1603  =head3 SelectionTree  =head3 SelectionTree
1604    
1605  C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>      my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options);
1606    
1607  Display a selection tree.  Display a selection tree.
1608    
# Line 1966  Line 1711 
1711  =item nodeImageClosed  =item nodeImageClosed
1712    
1713  URL of the image to display next to the tree nodes when they are collapsed. Clicking  URL of the image to display next to the tree nodes when they are collapsed. Clicking
1714  on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.  on the image will expand a section of the tree. The default is C<plus.gif>.
1715    
1716  =item nodeImageOpen  =item nodeImageOpen
1717    
1718  URL of the image to display next to the tree nodes when they are expanded. Clicking  URL of the image to display next to the tree nodes when they are expanded. Clicking
1719  on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.  on the image will collapse a section of the tree. The default is C<minus.gif>.
1720    
1721  =item style  =item style
1722    
# Line 2011  Line 1756 
1756      my ($cgi, $tree, %options) = @_;      my ($cgi, $tree, %options) = @_;
1757      # Get the options.      # Get the options.
1758      my $optionThing = Tracer::GetOptions({ name => 'selection',      my $optionThing = Tracer::GetOptions({ name => 'selection',
1759                                             nodeImageClosed => '../FIG/Html/plus.gif',                                             nodeImageClosed => "$FIG_Config::cgi_url/Html/plus.gif",
1760                                             nodeImageOpen => '../FIG/Html/minus.gif',                                             nodeImageOpen => "$FIG_Config::cgi_url/Html/minus.gif",
1761                                             style => 'tree',                                             style => 'tree',
1762                                             target => '_self',                                             target => '_self',
1763                                             selected => undef},                                             selected => undef},
# Line 2031  Line 1776 
1776              Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");              Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
1777          } else {          } else {
1778              # Here we have a real tree. Apply the tree style.              # Here we have a real tree. Apply the tree style.
1779              push @retVal, $cgi->start_div({ class => $optionThing->{style} });              push @retVal, CGI::start_div({ class => $optionThing->{style} });
1780              # Give us a DIV ID.              # Give us a DIV ID.
1781              my $divID = GetDivID($optionThing->{name});              my $divID = GetDivID($optionThing->{name});
1782              # Show the tree.              # Show the tree.
1783              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
1784              # Close the DIV block.              # Close the DIV block.
1785              push @retVal, $cgi->end_div();              push @retVal, CGI::end_div();
1786          }          }
1787      }      }
1788      # Return the result.      # Return the result.
# Line 2046  Line 1791 
1791    
1792  =head3 ShowBranch  =head3 ShowBranch
1793    
1794  C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>      my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType);
1795    
1796  This is a recursive method that displays a branch of the tree.  This is a recursive method that displays a branch of the tree.
1797    
# Line 2095  Line 1840 
1840      # Declare the return variable.      # Declare the return variable.
1841      my @retVal = ();      my @retVal = ();
1842      # Start the branch.      # Start the branch.
1843      push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });      push @retVal, CGI::start_ul({ id => $id, style => "display:$displayType" });
1844      # Check for the hash and choose the start location accordingly.      # Check for the hash and choose the start location accordingly.
1845      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
1846      # Get the list length.      # Get the list length.
# Line 2141  Line 1886 
1886                      # If we have children, create the child list with a recursive call.                      # If we have children, create the child list with a recursive call.
1887                      if ($hasChildren) {                      if ($hasChildren) {
1888                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
1889                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'block');
1890                            Trace("Children of $myLabel finished.") if T(4);
1891                      }                      }
1892                  }                  }
1893              }              }
# Line 2152  Line 1898 
1898              # closed images.              # closed images.
1899              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
1900              my $image = $images[$hasChildren];              my $image = $images[$hasChildren];
1901              my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});              my $prefixHtml = CGI::img({src => $image, id => "${myID}img"});
1902              if ($hasChildren) {              if ($hasChildren) {
1903                  # If there are children, we wrap the image in a toggle hyperlink.                  # If there are children, we wrap the image in a toggle hyperlink.
1904                  $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },                  $prefixHtml = CGI::a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
1905                                        $prefixHtml);                                        $prefixHtml);
1906              }              }
1907              # Now the radio button, if any. Note we use "defined" in case the user wants the              # Now the radio button, if any. Note we use "defined" in case the user wants the
# Line 2172  Line 1918 
1918                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
1919                      $radioParms->{checked} = undef;                      $radioParms->{checked} = undef;
1920                  }                  }
1921                  $prefixHtml .= $cgi->input($radioParms);                  $prefixHtml .= CGI::input($radioParms);
1922              }              }
1923              # Next, we format the label.              # Next, we format the label.
1924              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
1925              Trace("Formatting tree node for $myLabel.") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
1926              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
1927              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
1928                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = CGI::a({ href => $attrHash->{link}, target => $options->{target} },
1929                                       $labelHtml);                                       $labelHtml);
1930              }              }
1931              # Finally, roll up the child HTML. If there are no children, we'll get a null string              # Finally, roll up the child HTML. If there are no children, we'll get a null string
1932              # here.              # here.
1933              my $childHtml = join("\n", @childHtml);              my $childHtml = join("\n", @childHtml);
1934              # Now we have all the pieces, so we can put them together.              # Now we have all the pieces, so we can put them together.
1935              push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");              push @retVal, CGI::li("$prefixHtml$labelHtml$childHtml");
1936          }          }
1937      }      }
1938      # Close the tree branch.      # Close the tree branch.
1939      push @retVal, $cgi->end_ul();      push @retVal, CGI::end_ul();
1940      # Return the result.      # Return the result.
1941      return @retVal;      return @retVal;
1942  }  }
1943    
1944  =head3 GetDivID  =head3 GetDivID
1945    
1946  C<< my $idString = SearchHelper::GetDivID($name); >>      my $idString = SearchHelper::GetDivID($name);
1947    
1948  Return a new HTML ID string.  Return a new HTML ID string.
1949    
# Line 2226  Line 1972 
1972      return $retVal;      return $retVal;
1973  }  }
1974    
1975  =head2 Feature Column Methods  =head3 PrintLine
   
 The methods in this section manage feature column data. If you want to provide the  
 capability to include new types of data in feature columns, then all the changes  
 are made to this section of the source file. Technically, this should be implemented  
 using object-oriented methods, but this is simpler for non-programmers to maintain.  
 To add a new column of feature data, you must first give it a name. For example,  
 the name for the protein page link column is C<protlink>. If the column is to appear  
 in the default list of feature columns, add it to the list returned by  
 L</DefaultFeatureColumns>. Then add code to produce the column title to  
 L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>, and  
 everything else will happen automatically.  
   
 There is one special column name syntax for extra columns (that is, nonstandard  
 feature columns). If the column name begins with C<X=>, then it is presumed to be  
 an extra column. The column title is the text after the C<X=>, and its value is  
 pulled from the extra column hash.  
1976    
1977  =head3 DefaultFeatureColumns      $shelp->PrintLine($message);
1978    
1979  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>  Print a line of CGI output. This is used during the operation of the B<Find> method while
1980    searching, so the user sees progress in real-time.
 Return a list of the default feature column identifiers. These identifiers can  
 be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to  
 produce the column titles and row values.  
   
 =cut  
   
 sub DefaultFeatureColumns {  
     # Get the parameters.  
     my ($self) = @_;  
     # Return the result.  
     return qw(orgName function gblink protlink);  
 }  
   
 =head3 FeatureColumnTitle  
   
 C<< my $title = $shelp->FeatureColumnTitle($colName); >>  
   
 Return the column heading title to be used for the specified feature column.  
1981    
1982  =over 4  =over 4
1983    
1984  =item name  =item message
   
 Name of the desired feature column.  
   
 =item RETURN  
1985    
1986  Returns the title to be used as the column header for the named feature column.  HTML text to display.
1987    
1988  =back  =back
1989    
1990  =cut  =cut
1991    
1992  sub FeatureColumnTitle {  sub PrintLine {
1993      # Get the parameters.      # Get the parameters.
1994      my ($self, $colName) = @_;      my ($self, $message) = @_;
1995      # Declare the return variable. We default to a blank column name.      # Send the message to the output.
1996      my $retVal = "&nbsp;";      print "$message\n";
     # Process the column name.  
     if ($colName =~ /^X=(.+)$/) {  
         # Here we have an extra column.  
         $retVal = $1;  
     } elsif ($colName eq 'alias') {  
         $retVal = "External Aliases";  
     } elsif ($colName eq 'fid') {  
         $retVal = "FIG ID";  
     } elsif ($colName eq 'function') {  
         $retVal = "Functional Assignment";  
     } elsif ($colName eq 'gblink') {  
         $retVal = "GBrowse";  
     } elsif ($colName eq 'group') {  
         $retVal = "NMDPR Group";  
     } elsif ($colName =~ /^keyword:(.+)$/) {  
         $retVal = ucfirst $1;  
     } elsif ($colName eq 'orgName') {  
         $retVal = "Gene Name";  
     } elsif ($colName eq 'protlink') {  
         $retVal = "NMPDR Protein Page";  
     } elsif ($colName eq 'subsystem') {  
         $retVal = "Subsystems";  
     }  
     # Return the result.  
     return $retVal;  
1997  }  }
1998    
1999    =head3 GetHelper
2000    
2001  =head3 FeatureColumnValue      my $shelp = SearchHelper::GetHelper($parm, $type => $className);
2002    
2003  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  Return a helper object with the given class name. If no such class exists, an
2004    error will be thrown.
 Return the value to be displayed in the specified feature column.  
2005    
2006  =over 4  =over 4
2007    
2008  =item colName  =item parm
   
 Name of the column to be displayed.  
   
 =item record  
   
 DBObject record for the feature being displayed in the current row.  
   
 =item extraCols  
   
 Reference to a hash of extra column names to values. If the incoming column name  
 begins with C<X=>, its value will be taken from this hash.  
   
 =item RETURN  
   
 Returns the HTML to be displayed in the named column for the specified feature.  
   
 =back  
   
 =cut  
   
 sub FeatureColumnValue {  
     # Get the parameters.  
     my ($self, $colName, $record, $extraCols) = @_;  
     # Get the sprout and CGI objects.  
     my $cgi = $self->Q();  
     my $sprout = $self->DB();  
     # Get the feature ID.  
     my ($fid) = $record->Value('Feature(id)');  
     # Declare the return variable. Denote that we default to a non-breaking space,  
     # which will translate to an empty table cell (rather than a table cell with no  
     # interior, which is what you get for a null string).  
     my $retVal = "&nbsp;";  
     # Process according to the column name.  
     if ($colName =~ /^X=(.+)$/) {  
         # Here we have an extra column. Only update if the value exists. Note that  
         # a value of C<undef> is treated as a non-existent value, because the  
         # caller may have put "colName => undef" in the "PutFeature" call in order  
         # to insure we know the extra column exists.  
         if (defined $extraCols->{$1}) {  
             $retVal = $extraCols->{$1};  
         }  
     } elsif ($colName eq 'alias') {  
         # In this case, the user wants a list of external aliases for the feature.  
         # These are very expensive, so we compute them when the row is displayed.  
         $retVal = "%%alias=$fid";  
     } elsif ($colName eq 'fid') {  
         # Here we have the raw feature ID. We hyperlink it to the protein page.  
         $retVal = HTML::set_prot_links($fid);  
     } elsif ($colName eq 'function') {  
         # The functional assignment is just a matter of getting some text.  
         ($retVal) = $record->Value('Feature(assignment)');  
     } elsif ($colName eq 'gblink') {  
         # Here we want a link to the GBrowse page using the official GBrowse button.  
         $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef,  
                           fid => $fid);  
     } elsif ($colName eq 'group') {  
         # Get the NMPDR group name.  
         my (undef, $group) = $self->OrganismData($fid);  
         # Dress it with a URL to the group's main page.  
         my $nurl = $sprout->GroupPageName($group);  
         $retVal = $cgi->a({ href => $nurl, title => "$group summary" },  
                           $group);  
     } elsif ($colName =~ /^keyword:(.+)$/) {  
         # Here we want keyword-related values. This is also expensive, so  
         # we compute them when the row is displayed.  
         $retVal = "%%$colName=$fid";  
     } elsif ($colName eq 'orgName') {  
         # Here we want the formatted organism name and feature number.  
         $retVal = $self->FeatureName($fid);  
     } elsif ($colName eq 'protlink') {  
         # Here we want a link to the protein page using the official NMPDR button.  
         $retVal = Formlet('NMPDR', "protein.cgi", undef,  
                           prot => $fid, SPROUT => 1, new_framework => 0,  
                           user => '');  
     }elsif ($colName eq 'subsystem') {  
         # Another run-time column: subsystem list.  
         $retVal = "%%subsystem=$fid";  
     }  
     # Return the result.  
     return $retVal;  
 }  
2009    
2010  =head3 RunTimeColumns  Parameter to pass to the constructor. This is a CGI object for a search helper
2011    and a search helper object for the result helper.
 C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>  
   
 Return the HTML text for a run-time column. Run-time columns are evaluated when the  
 list is displayed, rather than when it is generated.  
   
 =over 4  
2012    
2013  =item type  =item type
2014    
2015  Type of column.  Type of helper: C<RH> for a result helper and C<SH> for a search helper.
2016    
2017  =item text  =item className
2018    
2019  Data relevant to this row of the column.  Class name for the helper object, without the preceding C<SH> or C<RH>. This is
2020    identical to what the script expects for the C<Class> or C<ResultType> parameter.
2021    
2022  =item RETURN  =item RETURN
2023    
2024  Returns the fully-formatted HTML text to go in the specified column.  Returns a helper object for the specified class.
2025    
2026  =back  =back
2027    
2028  =cut  =cut
2029    
2030  sub RunTimeColumns {  sub GetHelper {
2031      # Get the parameters.      # Get the parameters.
2032      my ($self, $type, $text) = @_;      my ($parm, $type, $className) = @_;
2033      # Declare the return variable.      # Declare the return variable.
2034      my $retVal = "";      my $retVal;
2035      # Get the Sprout and CGI objects.      # Try to create the helper.
2036      my $sprout = $self->DB();      eval {
2037      my $cgi = $self->Q();          # Load it into memory. If it's already there nothing will happen here.
2038      Trace("Runtime column $type with text \"$text\" found.") if T(4);          my $realName = "$type$className";
2039      # Separate the text into a type and data.          Trace("Requiring helper $realName.") if T(3);
2040      if ($type eq 'alias') {          require "$realName.pm";
2041          # Here the caller wants external alias links for a feature. The text          Trace("Constructing helper object.") if T(3);
2042          # is the feature ID.          # Construct the object.
2043          my $fid = $text;          $retVal = eval("$realName->new(\$parm)");
2044          # The complicated part is we have to hyperlink them. First, get the          # Commit suicide if it didn't work.
2045          # aliases.          if (! defined $retVal) {
2046          Trace("Generating aliases for feature $fid.") if T(4);              die "Could not find a $type handler of type $className.";
2047          my @aliases = $sprout->FeatureAliases($fid);          } else {
2048          # Only proceed if we found some.              # Perform any necessary subclass initialization.
2049          if (@aliases) {              $retVal->Initialize();
2050              # Join the aliases into a comma-delimited list.          }
2051              my $aliasList = join(", ", @aliases);      };
2052              # Ask the HTML processor to hyperlink them.      # Check for errors.
2053              $retVal = HTML::set_prot_links($cgi, $aliasList);      if ($@) {
2054          }          Confess("Error retrieving $type$className: $@");
     } elsif ($type eq 'subsystem') {  
         # Here the caller wants the subsystems in which this feature participates.  
         # The text is the feature ID. We will list the subsystem names with links  
         # to the subsystem's summary page.  
         my $fid = $text;  
         # Get the subsystems.  
         Trace("Generating subsystems for feature $fid.") if T(4);  
         my %subs = $sprout->SubsystemsOf($fid);  
         # Extract the subsystem names.  
         my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;  
         # String them into a list.  
         $retVal = join(", ", @names);  
     } elsif ($type =~ /^keyword:(.+)$/) {  
         # Here the caller wants the value of the named keyword. The text is the  
         # feature ID.  
         my $keywordName = $1;  
         my $fid = $text;  
         # Get the attribute values.  
         Trace("Getting $keywordName values for feature $fid.") if T(4);  
         my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],  
                                       "Feature($keywordName)");  
         # String them into a list.  
         $retVal = join(", ", @values);  
2055      }      }
2056      # Return the result.      # Return the result.
2057      return $retVal;      return $retVal;
# Line 2485  Line 2059 
2059    
2060  =head3 SaveOrganismData  =head3 SaveOrganismData
2061    
2062  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>      my ($name, $displayGroup, $domain) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy);
2063    
2064  Format the name of an organism and the display version of its group name. The incoming  Format the name of an organism and the display version of its group name. The incoming
2065  data should be the relevant fields from the B<Genome> record in the database. The  data should be the relevant fields from the B<Genome> record in the database. The
# Line 2515  Line 2089 
2089    
2090  Strain of the species represented by the genome.  Strain of the species represented by the genome.
2091    
2092    =item taxonomy
2093    
2094    Taxonomy of the species represented by the genome.
2095    
2096  =item RETURN  =item RETURN
2097    
2098  Returns a two-element list. The first element is the formatted genome name. The second  Returns a three-element list. The first element is the formatted genome name. The second
2099  element is the display name of the genome's group.  element is the display name of the genome's group. The third is the genome's domain.
2100    
2101  =back  =back
2102    
# Line 2526  Line 2104 
2104    
2105  sub SaveOrganismData {  sub SaveOrganismData {
2106      # Get the parameters.      # Get the parameters.
2107      my ($self, $group, $genomeID, $genus, $species, $strain) = @_;      my ($self, $group, $genomeID, $genus, $species, $strain, $taxonomy) = @_;
2108      # Declare the return values.      # Declare the return values.
2109      my ($name, $displayGroup);      my ($name, $displayGroup);
2110      # If the organism does not exist, format an unknown name and a blank group.      # If the organism does not exist, format an unknown name and a blank group.
# Line 2542  Line 2120 
2120          # Compute the display group. This is currently the same as the incoming group          # Compute the display group. This is currently the same as the incoming group
2121          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2122          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2123            Trace("Group = $displayGroup, translated from \"$group\".") if T(4);
2124      }      }
2125        # Compute the domain from the taxonomy.
2126        my ($domain) = split /\s*;\s*/, $taxonomy, 2;
2127      # Cache the group and organism data.      # Cache the group and organism data.
2128      my $cache = $self->{orgs};      my $cache = $self->{orgs};
2129      $cache->{$genomeID} = [$name, $displayGroup];      $cache->{$genomeID} = [$name, $displayGroup, $domain];
2130      # Return the result.      # Return the result.
2131      return ($name, $displayGroup);      return ($name, $displayGroup, $domain);
2132  }  }
2133    
2134  =head3 ValidateKeywords  =head3 ValidateKeywords
2135    
2136  C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>      my $okFlag = $shelp->ValidateKeywords($keywordString, $required);
2137    
2138  Insure that a keyword string is reasonably valid. If it is invalid, a message will be  Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2139  set.  set.
# Line 2588  Line 2169 
2169      if (! @wordList) {      if (! @wordList) {
2170          if ($required) {          if ($required) {
2171              $self->SetMessage("No search words specified.");              $self->SetMessage("No search words specified.");
2172            } else {
2173                $retVal = 1;
2174          }          }
2175      } elsif (! @plusWords) {      } elsif (! @plusWords) {
2176          $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 2598  Line 2181 
2181      return $retVal;      return $retVal;
2182  }  }
2183    
2184  =head3 Formlet  =head3 TuningParameters
   
 C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>  
2185    
2186  Create a mini-form that posts to the specified URL with the specified parameters. The      my $options = $shelp->TuningParameters(%parmHash);
 parameters will be stored in hidden fields, and the form's only visible control will  
 be a submit button with the specified caption.  
2187    
2188  Note that we don't use B<CGI.pm> services here because they generate forms with extra characters  Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names
2189  and tags that we don't want to deal with.  to their default values. The parameters and their values will be returned as a hash reference.
2190    
2191  =over 4  =over 4
2192    
2193  =item caption  =item parmHash
2194    
2195  Caption to be put on the form button.  Hash mapping parameter names to their default values.
2196    
2197  =item url  =item RETURN
2198    
2199  URL to be put in the form's action parameter.  Returns a reference to a hash containing the parameter names mapped to their actual values.
2200    
2201  =item target  =back
2202    
2203  Frame or target in which the form results should appear. If C<undef> is specified,  =cut
 the default target will be used.  
2204    
2205  =item parms  sub TuningParameters {
2206        # Get the parameters.
2207        my ($self, %parmHash) = @_;
2208        # Declare the return variable.
2209        my $retVal = {};
2210        # Get the CGI Query Object.
2211        my $cgi = $self->Q();
2212        # Loop through the parameter names.
2213        for my $parm (keys %parmHash) {
2214            # Get the incoming value for this parameter.
2215            my $value = $cgi->param($parm);
2216            # Zero might be a valid value, so we do an is-defined check rather than an OR.
2217            if (defined($value)) {
2218                $retVal->{$parm} = $value;
2219            } else {
2220                $retVal->{$parm} = $parmHash{$parm};
2221            }
2222        }
2223        # Return the result.
2224        return $retVal;
2225    }
2226    
2227  Hash containing the parameter names as keys and the parameter values as values.  =head3 GetPreferredAliasType
2228    
2229  =back      my $type = $shelp->GetPreferredAliasType();
2230    
2231    Return the preferred alias type for the current session. This information is stored
2232    in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>
2233    (which indicates the FIG ID).
2234    
2235  =cut  =cut
2236    
2237  sub Formlet {  sub GetPreferredAliasType {
2238      # Get the parameters.      # Get the parameters.
2239      my ($caption, $url, $target, %parms) = @_;      my ($self) = @_;
2240      # Compute the target HTML.      # Determine the preferred type.
2241      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $cgi = $self->Q();
2242      # Start the form.      my $retVal = $cgi->param('AliasType') || 'FIG';
2243      my $retVal = "<form method=\"POST\" action=\"$url\"$target>";      # Return it.
     # Add the parameters.  
     for my $parm (keys %parms) {  
         $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";  
     }  
     # Put in the button.  
     $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";  
     # Close the form.  
     $retVal .= "</form>";  
     # Return the result.  
2244      return $retVal;      return $retVal;
2245  }  }
2246    
2247    =head3 Hint
2248    
2249        my $htmlText = SearchHelper::Hint($wikiPage, $hintText);
2250    
2251    Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2252    This HTML can be put in forms to provide a useful hinting mechanism.
2253    
2254    =over 4
2255    
2256    =item wikiPage
2257    
2258    Name of the wiki page to be popped up when the hint mark is clicked.
2259    
2260    =item hintText
2261    
2262    Text to display for the hint. It is raw html, but may not contain any double quotes.
2263    
2264    =item RETURN
2265    
2266    Returns the html for the hint facility. The resulting html shows a small button-like thing that
2267    uses the standard FIG popup technology.
2268    
2269    =back
2270    
2271    =cut
2272    
2273    sub Hint {
2274        # Get the parameters.
2275        my ($wikiPage, $hintText) = @_;
2276        # Ask Sprout to draw the hint button for us.
2277        return Sprout::Hint($wikiPage, $hintText);
2278    }
2279    
2280    
2281    
2282  =head2 Virtual Methods  =head2 Virtual Methods
2283    
2284    =head3 HeaderHtml
2285    
2286        my $html = $shelp->HeaderHtml();
2287    
2288    Generate HTML for the HTML header. If extra styles or javascript are required,
2289    they should go in here.
2290    
2291    =cut
2292    
2293    sub HeaderHtml {
2294        return "";
2295    }
2296    
2297  =head3 Form  =head3 Form
2298    
2299  C<< my $html = $shelp->Form(); >>      my $html = $shelp->Form($mode);
2300    
2301  Generate the HTML for a form to request a new search.  Generate the HTML for a form to request a new search. If the subclass does not
2302    override this method, then the search is formless, and must be started from an
2303    external page.
2304    
2305    =cut
2306    
2307    sub Form {
2308        # Get the parameters.
2309        my ($self) = @_;
2310        return "";
2311    }
2312    
2313  =head3 Find  =head3 Find
2314    
2315  C<< my $resultCount = $shelp->Find(); >>      my $resultCount = $shelp->Find();
2316    
2317  Conduct a search based on the current CGI query parameters. The search results will  Conduct a search based on the current CGI query parameters. The search results will
2318  be written to the session cache file and the number of results will be  be written to the session cache file and the number of results will be
2319  returned. If the search parameters are invalid, a result count of C<undef> will be  returned. If the search parameters are invalid, a result count of C<undef> will be
2320  returned and a result message will be stored in this object describing the problem.  returned and a result message will be stored in this object describing the problem.
2321    
2322    =cut
2323    
2324    sub Find {
2325        # Get the parameters.
2326        my ($self) = @_;
2327        $self->Message("Call to pure virtual Find method in helper of type " . ref($self) . ".");
2328        return undef;
2329    }
2330    
2331  =head3 Description  =head3 Description
2332    
2333  C<< my $htmlText = $shelp->Description(); >>      my $htmlText = $shelp->Description();
2334    
2335  Return a description of this search. The description is used for the table of contents  Return a description of this search. The description is used for the table of contents
2336  on the main search tools page. It may contain HTML, but it should be character-level,  on the main search tools page. It may contain HTML, but it should be character-level,
2337  not block-level, since the description is going to appear in a list.  not block-level, since the description is going to appear in a list.
2338    
2339  =head3 SortKey  =cut
2340    
2341    sub Description {
2342        # Get the parameters.
2343        my ($self) = @_;
2344        $self->Message("Call to pure virtual Description method in helper of type " . ref($self) . ".");
2345        return "Unknown search type";
2346    }
2347    
2348    =head3 SearchTitle
2349    
2350        my $titleHtml = $shelp->SearchTitle();
2351    
2352    Return the display title for this search. The display title appears above the search results.
2353    If no result is returned, no title will be displayed. The result should be an html string
2354    that can be legally put inside a block tag such as C<h3> or C<p>.
2355    
2356    =cut
2357    
2358    sub SearchTitle {
2359        # Get the parameters.
2360        my ($self) = @_;
2361        # Declare the return variable.
2362        my $retVal = "";
2363        # Return it.
2364        return $retVal;
2365    }
2366    
2367  C<< my $key = $shelp->SortKey($fdata); >>  =head3 DefaultColumns
2368    
2369  Return the sort key for the specified feature data. The default is to sort by feature name,      $shelp->DefaultColumns($rhelp);
2370  floating NMPDR organisms to the top. If a full-text search is used, then the default  
2371  sort is by relevance followed by feature name. This sort may be overridden by the  Store the default columns in the result helper. The default action is just to ask
2372  search class to provide fancier functionality. This method is called by  the result helper for its default columns, but this may be changed by overriding
2373  B<PutFeature>, so it is only used for feature searches. A non-feature search  this method.
2374  would presumably have its own sort logic.  
2375    =over 4
2376    
2377    =item rhelp
2378    
2379    Result helper object in which the column list should be stored.
2380    
2381    =back
2382    
2383    =cut
2384    
2385    sub DefaultColumns {
2386        # Get the parameters.
2387        my ($self, $rhelp) = @_;
2388        # Get the default columns from the result helper.
2389        my @cols = $rhelp->DefaultResultColumns();
2390        # Store them back.
2391        $rhelp->SetColumns(@cols);
2392    }
2393    
2394    
2395    =head3 Initialize
2396    
2397        $shelp->Initialize();
2398    
2399    Perform any initialization required after construction of the helper.
2400    
2401    =cut
2402    
2403    sub Initialize {
2404        # The default is to do nothing.
2405    }
2406    
2407    =head3 GetResultHelper
2408    
2409        my $rhelp = $shelp->GetResultHelper($className);
2410    
2411    Return a result helper for this search helper. The default action is to create
2412    a result helper from scratch; however, if the subclass has an internal result
2413    helper it can override this method to return it without having to create a new
2414    one.
2415    
2416  =over 4  =over 4
2417    
2418  =item record  =item className
2419    
2420  The C<FeatureData> containing the current feature.  Result helper class name.
2421    
2422  =item RETURN  =item RETURN
2423    
2424  Returns a key field that can be used to sort this row in among the results.  Returns a result helper of the specified class connected to this search helper.
2425    
2426  =back  =back
2427    
2428  =cut  =cut
2429    
2430  sub SortKey {  sub GetResultHelper {
2431      # Get the parameters.      # Get the parameters.
2432      my ($self, $fdata) = @_;      my ($self, $className) = @_;
2433      # Get the feature ID from the record.      # Create the helper.
2434      my $fid = $fdata->FID();      my $retVal = GetHelper($self, RH => $className);
2435      # Get the group from the feature ID.      # return it.
     my $group = $self->FeatureGroup($fid);  
     # Ask the feature query object to form the sort key.  
     my $retVal = $fdata->SortKey($self, $group);  
     # Return the result.  
2436      return $retVal;      return $retVal;
2437  }  }
2438    

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.43

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3