[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.17, Wed Nov 15 22:34:50 2006 UTC revision 1.40, Tue Apr 29 20:52:05 2008 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 FreezeThaw qw(freeze thaw);
23    
24  =head1 Search Helper Base Class  =head1 Search Helper Base Class
25    
# Line 65  Line 66 
66    
67  =item orgs  =item orgs
68    
69  Reference to a hash mapping genome IDs to organism names.  Reference to a hash mapping genome IDs to organism data. (Used to
70    improve performance.)
71    
72  =item name  =item name
73    
# Line 83  Line 85 
85    
86  List of the parameters that are used to select multiple genomes.  List of the parameters that are used to select multiple genomes.
87    
 =item filtered  
   
 TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this  
 field is updated by the B<FeatureQuery> object.  
   
88  =back  =back
89    
90  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 103  Line 100 
100  =item 2  =item 2
101    
102  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
103  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
104    type of search.
105    
106  =item 3  =item 3
107    
# Line 113  Line 111 
111    
112  =item 4  =item 4
113    
114  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
115    must create a new subclass of B<ResultHelper>. Its name must be
116    C<RH>I<className>, where I<className> is the type of result.
117    
118  =back  =back
119    
# Line 149  Line 149 
149    
150  Several helper methods are provided for particular purposes.  Several helper methods are provided for particular purposes.
151    
 =over 4  
   
 =item 1  
   
152  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
153  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
154  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
155  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
156  be returned.  be returned.
157    
 =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  
   
158  L</QueueFormScript> allows you to queue JavaScript statements for execution  L</QueueFormScript> allows you to queue JavaScript statements for execution
159  after the form is fully generated. If you are using very complicated  after the form is fully generated. If you are using very complicated
160  form controls, the L</QueueFormScript> method allows you to perform  form controls, the L</QueueFormScript> method allows you to perform
161  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this
162  facility to display a list of the pre-selected genomes.  facility to display a list of the pre-selected genomes.
163    
 =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>.  
   
164  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
165  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
166    
167  =head3 Finding Search Results  =head3 Finding Search Results
168    
169  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
170  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.  
171    
172      sub Find {      sub Find {
173          my ($self) = @_;          my ($self) = @_;
# Line 201  Line 180 
180          ... validate the parameters ...          ... validate the parameters ...
181          if (... invalid parameters...) {          if (... invalid parameters...) {
182              $self->SetMessage(...appropriate message...);              $self->SetMessage(...appropriate message...);
183          } elsif (FeatureQuery::Valid($self)) {          } else {
184                # Determine the result type.
185                my $rhelp = SearchHelper::GetHelper($self, RH => $resultType);
186                # Specify the columns.
187                $self->DefaultColumns($rhelp);
188                # You may want to add extra columns. $name is the column name and
189                # $loc is its location. The other parameters take their names from the
190                # corresponding column methods.
191                $rhelp->AddExtraColumn($name => $loc, style => $style, download => $flag,
192                    title => $title);
193                # Some searches require optional columns that are configured by the
194                # user or by the search query itself. There are some special methods
195                # for this in the result helpers, but there's also the direct approach
196                # shown below.
197                $rhelp->AddOptionalColumn($name => $loc);
198              # Initialize the session file.              # Initialize the session file.
199              $self->OpenSession();              $self->OpenSession($rhelp);
200              # Initialize the result counter.              # Initialize the result counter.
201              $retVal = 0;              $retVal = 0;
202              ... get a list of genomes ...              ... set up to loop through the results ...
203              for my $genomeID (... each genome ...) {              while (...more results...) {
204                  my $fq = FeatureQuery->new($self, $genomeID);                  ...compute extra columns and call PutExtraColumns...
205                  while (my $feature = $fq->Fetch()) {                  $rhelp->PutData($sortKey, $objectID, $record);
                     ... examine the feature ...  
                     if (... we want to keep it ...) {  
                         $self->PutFeature($fq);  
206                          $retVal++;                          $retVal++;
207                      }                      }
                 }  
             }  
208              # Close the session file.              # Close the session file.
209              $self->CloseSession();              $self->CloseSession();
210          }          }
# Line 225  Line 213 
213      }      }
214    
215  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
216  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.  
217    
218  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
219  method of the feature query object.  to the output so that the user does not get bored waiting for results. The L</PrintLine>
220    method performs this function. The single parameter should be text to be
221    output to the browser. In general, you'll invoke it as follows.
222    
223      $fq->AddExtraColumns(score => $sc);      $self->PrintLine("...my message text...<br />");
224    
225    The break tag is optional. When the Find method gets control, a paragraph will
226    have been started so that everything is XHTML-compliant.
227    
228  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
229  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 241 
241    
242  =head3 new  =head3 new
243    
244  C<< my $shelp = SearchHelper->new($query); >>      my $shelp = SearchHelper->new($cgi);
245    
246  Construct a new SearchHelper object.  Construct a new SearchHelper object.
247    
248  =over 4  =over 4
249    
250  =item query  =item cgi
251    
252  The CGI query object for the current script.  The CGI query object for the current script.
253    
# Line 267  Line 257 
257    
258  sub new {  sub new {
259      # Get the parameters.      # Get the parameters.
260      my ($class, $query) = @_;      my ($class, $cgi) = @_;
261      # Check for a session ID.      # Check for a session ID.
262      my $session_id = $query->param("SessionID");      my $session_id = $cgi->param("SessionID");
263      my $type = "old";      my $type = "old";
264      if (! $session_id) {      if (! $session_id) {
265            Trace("No session ID found.") if T(3);
266          # 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
267          # store it in the query object.          # store it in the query object.
268          $session_id = NewSessionID();          $session_id = FIGRules::NewSessionID();
269            Trace("New session ID is $session_id.") if T(3);
270          $type = "new";          $type = "new";
271          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
272        } else {
273            Trace("Session ID is $session_id.") if T(3);
274      }      }
275        Trace("Computing subclass.") if T(3);
276      # Compute the subclass name.      # Compute the subclass name.
277      $class =~ /SH(.+)$/;      my $subClass;
278      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
279            # Here we have a real search class.
280            $subClass = $1;
281        } else {
282            # Here we have a bare class. The bare class cannot search, but it can
283            # process search results.
284            $subClass = 'SearchHelper';
285        }
286        Trace("Subclass name is $subClass.") if T(3);
287      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
288      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
289      # Generate the form name.      # Generate the form name.
290      my $formName = "$class$formCount";      my $formName = "$class$formCount";
291      $formCount++;      $formCount++;
292        Trace("Creating helper.") if T(3);
293      # 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)
294      # 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
295      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
296      my $retVal = {      my $retVal = {
297                    query => $query,                    query => $cgi,
298                    type => $type,                    type => $type,
299                    class => $subClass,                    class => $subClass,
300                    sprout => undef,                    sprout => undef,
# Line 299  Line 303 
303                    scriptQueue => [],                    scriptQueue => [],
304                    genomeList => undef,                    genomeList => undef,
305                    genomeParms => [],                    genomeParms => [],
                   filtered => 0,  
306                   };                   };
307      # Bless and return it.      # Bless and return it.
308      bless $retVal, $class;      bless $retVal, $class;
# Line 308  Line 311 
311    
312  =head3 Q  =head3 Q
313    
314  C<< my $query = $shelp->Q(); >>      my $query = $shelp->Q();
315    
316  Return the CGI query object.  Return the CGI query object.
317    
# Line 325  Line 328 
328    
329  =head3 DB  =head3 DB
330    
331  C<< my $sprout = $shelp->DB(); >>      my $sprout = $shelp->DB();
332    
333  Return the Sprout database object.  Return the Sprout database object.
334    
# Line 346  Line 349 
349    
350  =head3 IsNew  =head3 IsNew
351    
352  C<< my $flag = $shelp->IsNew(); >>      my $flag = $shelp->IsNew();
353    
354  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
355  session already has search results ready to process.  session already has search results ready to process.
# Line 362  Line 365 
365    
366  =head3 ID  =head3 ID
367    
368  C<< my $sessionID = $shelp->ID(); >>      my $sessionID = $shelp->ID();
369    
370  Return the current session ID.  Return the current session ID.
371    
# Line 377  Line 380 
380    
381  =head3 FormName  =head3 FormName
382    
383  C<< my $name = $shelp->FormName(); >>      my $name = $shelp->FormName();
384    
385  Return the name of the form this helper object will generate.  Return the name of the form this helper object will generate.
386    
# Line 392  Line 395 
395    
396  =head3 QueueFormScript  =head3 QueueFormScript
397    
398  C<< $shelp->QueueFormScript($statement); >>      $shelp->QueueFormScript($statement);
399    
400  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
401  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 427  Line 430 
430    
431  =head3 FormStart  =head3 FormStart
432    
433  C<< my $html = $shelp->FormStart($title); >>      my $html = $shelp->FormStart($title);
434    
435  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
436  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 454  Line 457 
457      my ($self, $title) = @_;      my ($self, $title) = @_;
458      # Get the CGI object.      # Get the CGI object.
459      my $cgi = $self->Q();      my $cgi = $self->Q();
460      # Start the form.      # Start the form. Note we use the override option on the Class value, in
461        # case the Advanced button was used.
462      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
463                   $cgi->start_form(-method => 'POST',                   $cgi->start_form(-method => 'POST',
464                                    -action => $cgi->url(-relative => 1),                                    -action => $cgi->url(-relative => 1),
465                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
466                   $cgi->hidden(-name => 'Class',                   $cgi->hidden(-name => 'Class',
467                                -value => $self->{class}) .                                -value => $self->{class},
468                                  -override => 1) .
469                   $cgi->hidden(-name => 'SPROUT',                   $cgi->hidden(-name => 'SPROUT',
470                                -value => 1) .                                -value => 1) .
471                   $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));  
     }  
472      # 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.
473      my $anchorName = $self->FormName();      my $anchorName = $self->FormName();
474      $retVal .= "<a name=\"$anchorName\"></a>\n";      $retVal .= "<a name=\"$anchorName\"></a>\n";
# Line 480  Line 478 
478    
479  =head3 FormEnd  =head3 FormEnd
480    
481  C<< my $htmlText = $shelp->FormEnd(); >>      my $htmlText = $shelp->FormEnd();
482    
483  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
484  C<div> tags.  C<div> tags.
# Line 512  Line 510 
510    
511  =head3 SetMessage  =head3 SetMessage
512    
513  C<< $shelp->SetMessage($msg); >>      $shelp->SetMessage($msg);
514    
515  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
516  if an invalid parameter value is specified.  if an invalid parameter value is specified.
# Line 536  Line 534 
534    
535  =head3 Message  =head3 Message
536    
537  C<< my $text = $shelp->Message(); >>      my $text = $shelp->Message();
538    
539  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
540  value is specified.  value is specified.
# Line 552  Line 550 
550    
551  =head3 OpenSession  =head3 OpenSession
552    
553  C<< $shelp->OpenSession(); >>      $shelp->OpenSession($rhelp);
554    
555    Set up the session cache file and write out the column headers.
556    This method should not be called until all the columns have
557    been configured, including the extra columns.
558    
559    =over 4
560    
561    =item rhelp
562    
563  Set up to open the session cache file for writing. Note we don't actually  Result helper for formatting the output. This has the column
564  open the file until after we know the column headers.  headers stored in it.
565    
566    =back
567    
568  =cut  =cut
569    
570  sub OpenSession {  sub OpenSession {
571      # Get the parameters.      # Get the parameters.
572      my ($self) = @_;      my ($self, $rhelp) = @_;
573      # Denote we have not yet written out the column headers.      # Insure the result helper is valid.
574      $self->{cols} = undef;      if (! defined($rhelp)) {
575            Confess("No result type specified for $self->{class}.");
576        } elsif(! $rhelp->isa('ResultHelper')) {
577            Confess("Invalid result type specified for $self->{class}.");
578        } else {
579            # Get the column headers and write them out.
580            my $colHdrs = $rhelp->GetColumnHeaders();
581            Trace(scalar(@{$colHdrs}) . " column headers written to output.") if T(3);
582            $self->WriteColumnHeaders(@{$colHdrs});
583        }
584  }  }
585    
586  =head3 GetCacheFileName  =head3 GetCacheFileName
587    
588  C<< my $fileName = $shelp->GetCacheFileName(); >>      my $fileName = $shelp->GetCacheFileName();
589    
590  Return the name to be used for this session's cache file.  Return the name to be used for this session's cache file.
591    
# Line 583  Line 600 
600    
601  =head3 GetTempFileName  =head3 GetTempFileName
602    
603  C<< my $fileName = $shelp->GetTempFileName($type); >>      my $fileName = $shelp->GetTempFileName($type);
604    
605  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
606  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 607  Line 624 
624      my ($self, $type) = @_;      my ($self, $type) = @_;
625      # Compute the file name. Note it gets stuffed in the FIG temporary      # Compute the file name. Note it gets stuffed in the FIG temporary
626      # directory.      # directory.
627      my $retVal = "$FIG_Config::temp/tmp_" . $self->ID() . ".$type";      my $retVal = FIGRules::GetTempFileName(sessionID => $self->ID(), extension => $type);
628      # Return the result.      # Return the result.
629      return $retVal;      return $retVal;
630  }  }
631    
 =head3 PutFeature  
   
 C<< $shelp->PutFeature($fdata); >>  
   
 Store a feature in the result cache. This is the workhorse method for most  
 searches, since the primary data item in the database is features.  
   
 For each feature, there are certain columns that are standard: the feature name, the  
 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.  
   
     $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
     $shelp->PutFeature($fd);  
   
 For correct results, all values should be specified for all extra columns in all calls to  
 B<PutFeature>. (In particular, the column header names are computed on the first  
 call.) If a column is to be blank for the current feature, its value can be given  
 as C<undef>.  
   
     if (! $essentialFlag) {  
         $essentialFlag = undef;  
     }  
     $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
     $shelp->PutFeature($fd);  
   
 =over 4  
   
 =item fdata  
   
 B<FeatureData> object containing the current feature data.  
   
 =back  
   
 =cut  
   
 sub PutFeature {  
     # Get the parameters.  
     my ($self, $fd) = @_;  
     # Get the CGI query object.  
     my $cgi = $self->Q();  
     # 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);  
 }  
   
632  =head3 WriteColumnHeaders  =head3 WriteColumnHeaders
633    
634  C<< $shelp->WriteColumnHeaders(@colNames); >>      $shelp->WriteColumnHeaders(@colNames);
635    
636  Write out the column headers for the current search session. The column headers  Write out the column headers for the current search session. The column headers
637  are sent to the cache file, and then the cache is re-opened as a sort pipe and  are sent to the cache file, and then the cache is re-opened as a sort pipe and
# Line 702  Line 641 
641    
642  =item colNames  =item colNames
643    
644  A list of column names in the desired presentation order.  A list of column names in the desired presentation order. For extra columns,
645    the column name is the hash supplied as the column definition.
646    
647  =back  =back
648    
# Line 714  Line 654 
654      # Get the cache file name and open it for output.      # Get the cache file name and open it for output.
655      my $fileName = $self->GetCacheFileName();      my $fileName = $self->GetCacheFileName();
656      my $handle1 = Open(undef, ">$fileName");      my $handle1 = Open(undef, ">$fileName");
657        # Freeze the column headers.
658        my @colHdrs = map { freeze($_) } @colNames;
659      # Write the column headers and close the file.      # Write the column headers and close the file.
660      Tracer::PutLine($handle1, \@colNames);      Tracer::PutLine($handle1, \@colHdrs);
661      close $handle1;      close $handle1;
662      # Now open the sort pipe and save the file handle. Note how we append the      # Now open the sort pipe and save the file handle. Note how we append the
663      # sorted data to the column header row already in place. The output will      # sorted data to the column header row already in place. The output will
# Line 724  Line 666 
666      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
667  }  }
668    
669    =head3 ReadColumnHeaders
670    
671        my @colHdrs = $shelp->ReadColumnHeaders($fh);
672    
673    Read the column headers from the specified file handle. The column headers are
674    frozen strings intermixed with frozen hash references. The strings represent
675    column names defined in the result helper. The hash references represent the
676    definitions of the extra columns.
677    
678    =over 4
679    
680    =item fh
681    
682    File handle from which the column headers are to be read.
683    
684    =item RETURN
685    
686    Returns a list of the column headers pulled from the specified file's first line.
687    
688    =back
689    
690    =cut
691    
692    sub ReadColumnHeaders {
693        # Get the parameters.
694        my ($self, $fh) = @_;
695        # Read and thaw the columns.
696        my @retVal = map { thaw($_) } Tracer::GetLine($fh);
697        # Return them to the caller.
698        return @retVal;
699    }
700    
701  =head3 WriteColumnData  =head3 WriteColumnData
702    
703  C<< $shelp->WriteColumnData($key, @colValues); >>      $shelp->WriteColumnData($key, @colValues);
704    
705  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
706  the session file is already open for output.  the session file is already open for output.
# Line 750  Line 724 
724      my ($self, $key, @colValues) = @_;      my ($self, $key, @colValues) = @_;
725      # Write them to the cache file.      # Write them to the cache file.
726      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);
727        Trace("Column data is " . join("; ", $key, @colValues) . ".") if T(4);
728  }  }
729    
730  =head3 CloseSession  =head3 CloseSession
731    
732  C<< $shelp->CloseSession(); >>      $shelp->CloseSession();
733    
734  Close the session file.  Close the session file.
735    
# Line 768  Line 743 
743          # We found one, so close it.          # We found one, so close it.
744          Trace("Closing session file.") if T(2);          Trace("Closing session file.") if T(2);
745          close $self->{fileHandle};          close $self->{fileHandle};
746            # Tell the user.
747            my $cgi = $self->Q();
748            $self->PrintLine("Output formatting complete.<br />");
749      }      }
750  }  }
751    
 =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;  
 }  
   
752  =head3 OrganismData  =head3 OrganismData
753    
754  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>      my ($orgName, $group) = $shelp->Organism($genomeID);
755    
756  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.
757  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 810  Line 765 
765    
766  =item RETURN  =item RETURN
767    
768  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,
769  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
770  organism is not in an NMPDR group.  organism is not in an NMPDR group. The third item is the organism's domain.
771    
772  =back  =back
773    
# Line 822  Line 777 
777      # Get the parameters.      # Get the parameters.
778      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
779      # Declare the return variables.      # Declare the return variables.
780      my ($orgName, $group);      my ($orgName, $group, $domain);
781      # Check the cache.      # Check the cache.
782      my $cache = $self->{orgs};      my $cache = $self->{orgs};
783      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
784          ($orgName, $group) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
785            Trace("Cached organism $genomeID has group \"$group\".") if T(4);
786      } else {      } else {
787          # Here we have to use the database.          # Here we have to use the database.
788          my $sprout = $self->DB();          my $sprout = $self->DB();
789          my ($genus, $species, $strain, $group) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $newGroup, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,
790                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
791                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
792                                                       'Genome(primary-group)']);                                                                   'Genome(primary-group)',
793                                                                     'Genome(taxonomy)']);
794          # Format and cache the name and display group.          # Format and cache the name and display group.
795          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          Trace("Caching organism $genomeID with group \"$newGroup\".") if T(4);
796                                                              $strain);          ($orgName, $group, $domain) = $self->SaveOrganismData($newGroup, $genomeID, $genus, $species,
797                                                                  $strain, $taxonomy);
798            Trace("Returning group $group.") if T(4);
799      }      }
800      # Return the result.      # Return the result.
801      return ($orgName, $group);      return ($orgName, $group, $domain);
802  }  }
803    
804  =head3 Organism  =head3 Organism
805    
806  C<< my $orgName = $shelp->Organism($genomeID); >>      my $orgName = $shelp->Organism($genomeID);
807    
808  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,
809  species, and unique characterization. A cache is used to improve performance.  species, and unique characterization. A cache is used to improve performance.
# Line 867  Line 826 
826      # Get the parameters.      # Get the parameters.
827      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
828      # Get the organism data.      # Get the organism data.
829      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]";  
     }  
830      # Return the result.      # Return the result.
831      return $retVal;      return $retVal;
832  }  }
833    
834  =head3 ComputeFASTA  =head3 ComputeFASTA
835    
836  C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>      my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth);
837    
838  Parse a sequence input and convert it into a FASTA string of the desired type. Note  Parse a sequence input and convert it into a FASTA string of the desired type with
839  that it is possible to convert a DNA sequence into a protein sequence, but the reverse  the desired flanking width.
 is not possible.  
840    
841  =over 4  =over 4
842    
 =item incomingType  
   
 C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.  
   
843  =item desiredType  =item desiredType
844    
845  C<dna> to return a DNA sequence, C<prot> to return a protein sequence. If the  C<dna> to return a DNA sequence, C<prot> to return a protein sequence, C<dnaPattern>
846  I<$incomingType> is C<prot> and this value is C<dna>, an error will be thrown.  to return a DNA search pattern, C<protPattern> to return a protein search pattern.
847    
848  =item sequence  =item sequence
849    
# Line 972  Line 853 
853  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
854  line will be provided.  line will be provided.
855    
856    =item flankingWidth
857    
858    If the DNA FASTA of a feature is desired, the number of base pairs to either side of the
859    feature that should be included. Currently we can't do this for Proteins because the
860    protein translation of a feature doesn't always match the DNA and is taken directly
861    from the database.
862    
863  =item RETURN  =item RETURN
864    
865  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 984  Line 872 
872    
873  sub ComputeFASTA {  sub ComputeFASTA {
874      # Get the parameters.      # Get the parameters.
875      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence, $flankingWidth) = @_;
876      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
877      my $retVal;      my $retVal;
878      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
879      my $okFlag = 1;      my $okFlag = 1;
880      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
881      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
882      Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
883      # Check for a feature specification.      # Check for a feature specification. The smoking gun for that is a vertical bar.
884      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
885          # 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
886          # it.          # it.
# Line 1007  Line 895 
895              $self->SetMessage("No gene found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
896              $okFlag = 0;              $okFlag = 0;
897          } else {          } else {
898              # Set the FASTA label.              # Set the FASTA label. The ID is the first favored alias.
899              my $fastaLabel = $fid;              my $favored = $self->Q()->param('FavoredAlias') || 'fig';
900                my $favorLen = length $favored;
901                ($fastaLabel) = grep { substr($_, 0, $favorLen) eq $favored } $sprout->FeatureAliases($fid);
902                if (! $fastaLabel) {
903                    # In an emergency, fall back to the original ID.
904                    $fastaLabel = $fid;
905                }
906              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
907              if ($desiredType eq 'prot') {              if ($desiredType =~ /prot/) {
908                  # We want protein, so get the translation.                  # We want protein, so get the translation.
909                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
910                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
911              } else {              } elsif ($desiredType =~ /dna/) {
912                  # 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
913                    # locations.
914                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
915                    if ($flankingWidth > 0) {
916                        # Here we need to add flanking data. Convert the locations to a list
917                        # of location objects.
918                        my @locObjects = map { BasicLocation->new($_) } @locList;
919                        # Initialize the return variable. We will put the DNA in here segment by segment.
920                        $fastaData = "";
921                        # Now we widen each location by the flanking width and stash the results. This
922                        # requires getting the contig length for each contig so we don't fall off the end.
923                        for my $locObject (@locObjects) {
924                            Trace("Current location is " . $locObject->String . ".") if T(4);
925                            # Remember the current start and length.
926                            my ($start, $len) = ($locObject->Left, $locObject->Length);
927                            # Get the contig length.
928                            my $contigLen = $sprout->ContigLength($locObject->Contig);
929                            # Widen the location and get its DNA.
930                            $locObject->Widen($flankingWidth, $contigLen);
931                            my $fastaSegment = $sprout->DNASeq([$locObject->String()]);
932                            # Now we need to do some case changing. The main DNA is upper case and
933                            # the flanking DNA is lower case.
934                            my $leftFlank = $start - $locObject->Left;
935                            my $rightFlank = $leftFlank + $len;
936                            Trace("Wide location is " . $locObject->String . ". Flanks are $leftFlank and $rightFlank. Contig len is $contigLen.") if T(4);
937                            my $fancyFastaSegment = lc(substr($fastaSegment, 0, $leftFlank)) .
938                                                    uc(substr($fastaSegment, $leftFlank, $rightFlank - $leftFlank)) .
939                                                    lc(substr($fastaSegment, $rightFlank));
940                            $fastaData .= $fancyFastaSegment;
941                        }
942                    } else {
943                        # Here we have just the raw sequence.
944                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
945                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  }
946                    Trace((length $fastaData) . " characters returned for DNA of $fastaLabel.") if T(3);
947              }              }
948          }          }
     } elsif ($incomingType eq 'prot' && $desiredType eq 'dna') {  
         # Here we're being asked to do an impossible conversion.  
         $self->SetMessage("Cannot convert a protein sequence to DNA.");  
         $okFlag = 0;  
949      } else {      } else {
950          Trace("Analyzing FASTA sequence.") if T(4);          Trace("Analyzing FASTA sequence.") if T(4);
951          # Here we are expecting a FASTA. We need to see if there's a label.          # Here we are expecting a FASTA. We need to see if there's a label.
# Line 1037  Line 958 
958              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);
959              # 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
960              # as data.              # as data.
961              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "$desiredType sequence specified by user";
962              $fastaData = $sequence;              $fastaData = $sequence;
963          }          }
964          # 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.
965            if ($desiredType !~ /pattern/i) {
966          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
967          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
         # Finally, if the user wants to convert to protein, we do it here. Note that  
         # we've already prevented a conversion from protein to DNA.  
         if ($incomingType ne $desiredType) {  
             $fastaData = Sprout::Protein($fastaData);  
             # Check for bad characters.  
             if ($fastaData =~ /X/) {  
                 $self->SetMessage("Invalid characters detected. Is the input really of type $incomingType?");  
                 $okFlag = 0;  
968              }              }
969          } elsif ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {          # Finally, verify that it's DNA if we're doing DNA stuff.
970              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {
971                $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
972              $okFlag = 0;              $okFlag = 0;
973          }          }
974      }      }
975      Trace("FASTA data sequence: $fastaData") if T(4);      Trace("FASTA data sequence: $fastaData") if T(4);
976      # Only proceed if no error was detected.      # Only proceed if no error was detected.
977      if ($okFlag) {      if ($okFlag) {
978            if ($desiredType =~ /pattern/i) {
979                # For a scan, there is no label and no breakup.
980                $retVal = $fastaData;
981            } else {
982          # 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
983          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
984          # 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 1068  Line 987 
987          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
988          $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
989      }      }
990        }
991      # Return the result.      # Return the result.
992      return $retVal;      return $retVal;
993  }  }
994    
995  =head3 SubsystemTree  =head3 SubsystemTree
996    
997  C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>      my $tree = SearchHelper::SubsystemTree($sprout, %options);
998    
999  This method creates a subsystem selection tree suitable for passing to  This method creates a subsystem selection tree suitable for passing to
1000  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 1124  Line 1044 
1044      # Read in the subsystems.      # Read in the subsystems.
1045      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1046                                 ['Subsystem(classification)', 'Subsystem(id)']);                                 ['Subsystem(classification)', 'Subsystem(id)']);
1047        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1048        # is at the end, ALL subsystems are unclassified and we don't bother.
1049        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1050            while ($subs[0]->[0] eq '') {
1051                my $classLess = shift @subs;
1052                push @subs, $classLess;
1053            }
1054        }
1055      # Declare the return variable.      # Declare the return variable.
1056      my @retVal = ();      my @retVal = ();
1057      # 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 1198  Line 1126 
1126              if ($optionThing->{links}) {              if ($optionThing->{links}) {
1127                  # Compute the link value.                  # Compute the link value.
1128                  my $linkable = uri_escape($id);                  my $linkable = uri_escape($id);
1129                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";                  $nodeContent->{link} = "../FIG/seedviewer.cgi?page=Subsystems;subsystem=$linkable";
1130              }              }
1131              if ($optionThing->{radio}) {              if ($optionThing->{radio}) {
1132                  # Compute the radio value.                  # Compute the radio value.
# Line 1216  Line 1144 
1144    
1145  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1146    
1147  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>      my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows);
1148    
1149  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
1150  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 1273  Line 1201 
1201      # Get the form name.      # Get the form name.
1202      my $formName = $self->FormName();      my $formName = $self->FormName();
1203      # Check to see if we already have a genome list in memory.      # Check to see if we already have a genome list in memory.
     my $genomes = $self->{genomeList};  
1204      my $groupHash;      my $groupHash;
1205        my @groups;
1206        my $nmpdrGroupCount;
1207        my $genomes = $self->{genomeList};
1208      if (defined $genomes) {      if (defined $genomes) {
1209          # We have a list ready to use.          # We have a list ready to use.
1210          $groupHash = $genomes;          $groupHash = $genomes;
1211            @groups = @{$self->{groupList}};
1212            $nmpdrGroupCount = $self->{groupCount};
1213      } else {      } else {
1214          # Get a list of all the genomes in group order. In fact, we only need them ordered          # Get a list of all the genomes in group order. In fact, we only need them ordered
1215          # by name (genus,species,strain), but putting primary-group in front enables us to          # by name (genus,species,strain), but putting primary-group in front enables us to
# Line 1286  Line 1218 
1218                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
1219                                           [], ['Genome(primary-group)', 'Genome(id)',                                           [], ['Genome(primary-group)', 'Genome(id)',
1220                                                'Genome(genus)', 'Genome(species)',                                                'Genome(genus)', 'Genome(species)',
1221                                                'Genome(unique-characterization)']);                                                'Genome(unique-characterization)',
1222                                                  'Genome(taxonomy)']);
1223          # Create a hash to organize the genomes by group. Each group will contain a list of          # Create a hash to organize the genomes by group. Each group will contain a list of
1224          # 2-tuples, the first element being the genome ID and the second being the genome          # 2-tuples, the first element being the genome ID and the second being the genome
1225          # name.          # name.
1226          my %gHash = ();          my %gHash = ();
1227          for my $genome (@genomeList) {          for my $genome (@genomeList) {
1228              # Get the genome data.              # Get the genome data.
1229              my ($group, $genomeID, $genus, $species, $strain) = @{$genome};              my ($group, $genomeID, $genus, $species, $strain, $taxonomy) = @{$genome};
1230              # Compute and cache its name and display group.              # Compute and cache its name and display group.
1231              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,              my ($name, $displayGroup, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1232                                                                  $strain);                                                                           $strain, $taxonomy);
1233              # Push the genome into the group's list. Note that we use the real group              # Push the genome into the group's list. Note that we use the real group
1234              # name here, not the display group name.              # name here, not the display group name.
1235              push @{$gHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name, $domain];
1236            }
1237            # We are almost ready to unroll the menu out of the group hash. The final step is to separate
1238            # the supporting genomes by domain. First, we extract the NMPDR groups and sort them. They
1239            # are sorted by the first capitalized word. Groups with "other" are sorted after groups
1240            # that aren't "other". At some point, we will want to make this less complicated.
1241            my %sortGroups = map { $_ =~ /(other)?(.*)([A-Z].+)/; "$3$1$2" => $_ }
1242                                 grep { $_ ne $FIG_Config::otherGroup } keys %gHash;
1243            @groups = map { $sortGroups{$_} } sort keys %sortGroups;
1244            # Remember the number of NMPDR groups.
1245            $nmpdrGroupCount = scalar @groups;
1246            # Loop through the supporting genomes, classifying them by domain. We'll also keep a list
1247            # of the domains found.
1248            my @otherGenomes = @{$gHash{$FIG_Config::otherGroup}};
1249            my @domains = ();
1250            for my $genomeData (@otherGenomes) {
1251                my ($genomeID, $name, $domain) = @{$genomeData};
1252                if (exists $gHash{$domain}) {
1253                    push @{$gHash{$domain}}, $genomeData;
1254                } else {
1255                    $gHash{$domain} = [$genomeData];
1256                    push @domains, $domain;
1257                }
1258          }          }
1259            # Add the domain groups at the end of the main group list. The main group list will now
1260            # contain all the categories we need to display the genomes.
1261            push @groups, sort @domains;
1262            # Delete the supporting group.
1263            delete $gHash{$FIG_Config::otherGroup};
1264          # Save the genome list for future use.          # Save the genome list for future use.
1265          $self->{genomeList} = \%gHash;          $self->{genomeList} = \%gHash;
1266            $self->{groupList} = \@groups;
1267            $self->{groupCount} = $nmpdrGroupCount;
1268          $groupHash = \%gHash;          $groupHash = \%gHash;
1269      }      }
     # 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;  
1270      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal
1271      # with the possibility of undefined values in the incoming list.      # with the possibility of undefined values in the incoming list.
1272      my %selectedHash = ();      my %selectedHash = ();
# Line 1345  Line 1303 
1303          # Get the genomes in the group.          # Get the genomes in the group.
1304          for my $genome (@{$groupHash->{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1305              # Count this organism if it's NMPDR.              # Count this organism if it's NMPDR.
1306              if ($group ne $FIG_Config::otherGroup) {              if ($nmpdrGroupCount > 0) {
1307                  $nmpdrCount++;                  $nmpdrCount++;
1308              }              }
1309              # Get the organism ID and name.              # Get the organism ID, name, and domain.
1310              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name, $domain) = @{$genome};
1311              # See if it's selected.              # See if it's selected.
1312              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1313              # Generate the option tag.              # Generate the option tag.
1314              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION class=\"$domain\" value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1315              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1316          }          }
1317          # Close the option group.          # Close the option group.
1318          push @lines, "  </OPTGROUP>";          push @lines, "  </OPTGROUP>";
1319            # Record this group in the nmpdrGroup count. When that gets to 0, we've finished the NMPDR
1320            # groups.
1321            $nmpdrGroupCount--;
1322      }      }
1323      # Close the SELECT tag.      # Close the SELECT tag.
1324      push @lines, "</SELECT>";      push @lines, "</SELECT>";
# Line 1367  Line 1328 
1328          # the search box. This allows the user to type text and have all genomes containing          # the search box. This allows the user to type text and have all genomes containing
1329          # the text selected automatically.          # the text selected automatically.
1330          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
1331          push @lines, "<br>Select genomes containing <INPUT type=\"text\" name=\"$searchThingName\" " .          push @lines, "<br />" .
1332                       "size=\"30\" onBlur=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />";                       "<INPUT type=\"button\" name=\"MacroSearch\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .
1333                         "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />" . Hint("Genome Control",
1334                                                                                                "Enter a genome number, then click the button to the left " .
1335                                                                                                "in order to select the genome with that number. " .
1336                                                                                                "Enter a genus, species, or strain and click the " .
1337                                                                                                "button to select all genomes with that genus, species, " .
1338                                                                                                "or strain name.");
1339          # Next are the buttons to set and clear selections.          # Next are the buttons to set and clear selections.
1340          push @lines, "<br />";          push @lines, "<br />";
1341          push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";
1342          push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1343          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1344          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";          # push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
1345          # Add the status display, too.          # Add the status display, too.
1346          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1347          # Queue to update the status display when the form loads. We need to modify the show statement          # Queue to update the status display when the form loads. We need to modify the show statement
# Line 1395  Line 1362 
1362    
1363  =head3 PropertyMenu  =head3 PropertyMenu
1364    
1365  C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>      my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force);
1366    
1367  Generate a property name dropdown menu.  Generate a property name dropdown menu.
1368    
# Line 1445  Line 1412 
1412    
1413  =head3 MakeTable  =head3 MakeTable
1414    
1415  C<< my $htmlText = $shelp->MakeTable(\@rows); >>      my $htmlText = $shelp->MakeTable(\@rows);
1416    
1417  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
1418  other words, each must have the TR and TD tags included.  other words, each must have the TR and TD tags included.
# Line 1461  Line 1428 
1428  =item rows  =item rows
1429    
1430  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
1431  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
1432  set the width. Everything else will be left as is.  will be modified to set the width. Everything else will be left as is.
1433    
1434  =item RETURN  =item RETURN
1435    
# Line 1477  Line 1444 
1444      my ($self, $rows) = @_;      my ($self, $rows) = @_;
1445      # Get the CGI object.      # Get the CGI object.
1446      my $cgi = $self->Q();      my $cgi = $self->Q();
1447      # 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.
1448        # This flag will be set to FALSE when that happens.
1449        my $needWidth = 1;
1450      # 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
1451      # is already specified on the first column bad things will happen.      # is already specified on the first column bad things will happen.
1452      for my $row (@{$rows}) {      for my $row (@{$rows}) {
1453          $row =~ s/(<td|th)/$1 width="150"/i;          # See if this row needs a width.
1454            if ($needWidth && $row =~ /<(td|th) ([^>]+)>/i) {
1455                # Here we have a first cell and its tag parameters are in $2.
1456                my $elements = $2;
1457                if ($elements !~ /colspan/i) {
1458                    Trace("No colspan tag found in element \'$elements\'.") if T(3);
1459                    # Here there's no colspan, so we plug in the width. We
1460                    # eschew the "g" modifier on the substitution because we
1461                    # only want to update the first cell.
1462                    $row =~ s/(<(td|th))/$1 width="150"/i;
1463                    # Denote we don't need this any more.
1464                    $needWidth = 0;
1465                }
1466            }
1467      }      }
1468      # Create the table.      # Create the table.
1469      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = $cgi->table({border => 2, cellspacing => 2,
# Line 1493  Line 1475 
1475    
1476  =head3 SubmitRow  =head3 SubmitRow
1477    
1478  C<< my $htmlText = $shelp->SubmitRow(); >>      my $htmlText = $shelp->SubmitRow($caption);
1479    
1480  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1481  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
1482  near the top of the form.  near the top of the form.
1483    
 =cut  
   
 sub SubmitRow {  
     # Get the parameters.  
     my ($self) = @_;  
     my $cgi = $self->Q();  
     # Get the current page size.  
     my $pageSize = $cgi->param('PageSize');  
     # Get the incoming external-link flag.  
     my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);  
     # Create the row.  
     my $retVal = $cgi->Tr($cgi->td("Results/Page"),  
                           $cgi->td($cgi->popup_menu(-name => 'PageSize',  
                                                     -values => [10, 25, 50, 100, 1000],  
                                                     -default => $pageSize) . " " .  
                                    $cgi->checkbox(-name => 'ShowURL',  
                                                   -value => 1,  
                                                   -label => 'Show URL')),  
                           $cgi->td($cgi->submit(-class => 'goButton',  
                                                 -name => 'Search',  
                                                 -value => 'Go')));  
     # Return the result.  
     return $retVal;  
 }  
   
 =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.  
   
1484  =over 4  =over 4
1485    
1486  =item sprout  =item caption (optional)
1487    
1488  Sprout object for accessing the database.  Caption to be put on the search button. The default is C<Go>.
   
 =item feat  
   
 ID of the feature whose Gbrowse URL is desired.  
1489    
1490  =item RETURN  =item RETURN
1491    
1492  Returns a GET-style URL for the Gbrowse CGI, with parameters specifying the genome  Returns a table row containing the controls for submitting the search
1493  ID, contig ID, starting offset, and stopping offset.  and tuning the results.
1494    
1495  =back  =back
1496    
1497  =cut  =cut
1498    
1499  sub GBrowseFeatureURL {  sub SubmitRow {
1500      # Get the parameters.      # Get the parameters.
1501      my ($sprout, $feat) = @_;      my ($self, $caption) = @_;
1502      # Declare the return variable.      my $cgi = $self->Q();
1503      my $retVal;      # Compute the button caption.
1504      # Compute the genome ID.      my $realCaption = (defined $caption ? $caption : 'Go');
1505      my ($genomeID) = FIGRules::ParseFeatureID($feat);      # Get the current page size.
1506      # Only proceed if the feature ID produces a valid genome.      my $pageSize = $cgi->param('PageSize');
1507      if ($genomeID) {      # Get the current feature ID type.
1508          # Get the feature location string.      my $aliasType = $self->GetPreferredAliasType();
1509          my $loc = $sprout->FeatureLocation($feat);      # Create the rows.
1510          # Compute the contig, start, and stop points.      my $retVal = $cgi->Tr($cgi->td("Identifier Type "),
1511          my($contig, $start, $stop) = BasicLocation::Parse($loc);                            $cgi->td({ colspan => 2 },
1512          Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);                                     $cgi->popup_menu(-name => 'AliasType',
1513          # Now we need to do some goofiness to insure that the location is not too                                                      -values => ['FIG', AliasAnalysis::AliasTypes() ],
1514          # big and that we get some surrounding stuff.                                                      -default => $aliasType) .
1515          my $mid = int(($start + $stop) / 2);                                     Hint("Identifier Type", "Specify how you want gene names to be displayed."))) .
1516          my $chunk_len = 20000;                   "\n" .
1517          my $max_feature = 40000;                   $cgi->Tr($cgi->td("Results/Page"),
1518          my $feat_len = abs($stop - $start);                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1519          if ($feat_len > $chunk_len) {                                                      -values => [10, 25, 50, 100, 1000],
1520              if ($feat_len > $max_feature) {                                                      -default => $pageSize)),
1521                  $chunk_len = $max_feature;                            $cgi->td($cgi->submit(-class => 'goButton',
1522              } else {                                                  -name => 'Search',
1523                  $chunk_len = $feat_len + 100;                                                  -value => $realCaption)));
             }  
         }  
         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";  
     }  
1524      # Return the result.      # Return the result.
1525      return $retVal;      return $retVal;
1526  }  }
1527    
1528  =head3 GetGenomes  =head3 GetGenomes
1529    
1530  C<< my @genomeList = $shelp->GetGenomes($parmName); >>      my @genomeList = $shelp->GetGenomes($parmName);
1531    
1532  Return the list of genomes specified by the specified CGI query parameter.  Return the list of genomes specified by the specified CGI query parameter.
1533  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 1665  Line 1571 
1571    
1572  =head3 GetHelpText  =head3 GetHelpText
1573    
1574  C<< my $htmlText = $shelp->GetHelpText(); >>      my $htmlText = $shelp->GetHelpText();
1575    
1576  Get the help text for this search. The help text is stored in files on the template  Get the help text for this search. The help text is stored in files on the template
1577  server. The help text for a specific search is taken from a file named  server. The help text for a specific search is taken from a file named
1578  C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.  C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1579  There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the  There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1580  feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>  feature filtering performed by the B<RHFeatures> object, C<SearchHelp1_GenomeControl.inc>
1581  describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>  describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1582  describes the standard controls for a search, such as page size, URL display, and  describes the standard controls for a search, such as page size, URL display, and
1583  external alias display.  external alias display.
# Line 1706  Line 1612 
1612    
1613  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1614    
1615  C<< my $url = $shelp->ComputeSearchURL(); >>      my $url = $shelp->ComputeSearchURL(%overrides);
1616    
1617  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
1618  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 1716  Line 1622 
1622  main complication is that if the user specified all genomes, we'll want to  main complication is that if the user specified all genomes, we'll want to
1623  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1624    
1625    =over 4
1626    
1627    =item overrides
1628    
1629    Hash containing override values for the parameters, where the parameter name is
1630    the key and the parameter value is the override value. If the override value is
1631    C<undef>, the parameter will be deleted from the result.
1632    
1633    =item RETURN
1634    
1635    Returns a GET-style URL for invoking the search with the specified overrides.
1636    
1637    =back
1638    
1639  =cut  =cut
1640    
1641  sub ComputeSearchURL {  sub ComputeSearchURL {
1642      # Get the parameters.      # Get the parameters.
1643      my ($self) = @_;      my ($self, %overrides) = @_;
1644      # Get the database and CGI query object.      # Get the database and CGI query object.
1645      my $cgi = $self->Q();      my $cgi = $self->Q();
1646      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1747  Line 1667 
1667          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1668          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1669          # Check for special cases.          # Check for special cases.
1670          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1671              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1672              @values = ();              @values = ();
1673          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1761  Line 1681 
1681              if ($allFlag) {              if ($allFlag) {
1682                  @values = ();                  @values = ();
1683              }              }
1684            } elsif (exists $overrides{$parmKey}) {
1685                # Here the value is being overridden, so we skip it for now.
1686                @values = ();
1687          }          }
1688          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1689          if (@values) {          if (@values) {
1690              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1691          }          }
1692      }      }
1693      # Add the parameters to the URL.      # Now do the overrides.
1694      $retVal .= "?" . join(";", @urlList);      for my $overKey (keys %overrides) {
1695      # Return the result.          # Only use this override if it's not a delete marker.
1696      return $retVal;          if (defined $overrides{$overKey}) {
1697                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1698  }  }
   
 =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.");  
1699      }      }
1700        # Add the parameters to the URL.
1701        $retVal .= "?" . join(";", @urlList);
1702      # Return the result.      # Return the result.
1703      return $retVal;      return $retVal;
1704  }  }
1705    
1706  =head3 AdvancedClassList  =head3 AdvancedClassList
1707    
1708  C<< my @classes = SearchHelper::AdvancedClassList(); >>      my @classes = SearchHelper::AdvancedClassList();
1709    
1710  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
1711  of available searches on the search page.  of available searches on the search page.
1712    
1713  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.
1714    
1715  =cut  =cut
1716    
1717  sub AdvancedClassList {  sub AdvancedClassList {
1718      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;      # Determine the search helper module directory.
1719      return @retVal;      my $libDirectory = $INC{'SearchHelper.pm'};
1720        $libDirectory =~ s/SearchHelper\.pm//;
1721        # Read it, keeping only the helper modules.
1722        my @modules = grep { /^SH\w+\.pm/ } Tracer::OpenDir($libDirectory, 0);
1723        # Convert the file names to search types.
1724        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } @modules;
1725        # Return the result in alphabetical order.
1726        return sort @retVal;
1727  }  }
1728    
1729  =head3 SelectionTree  =head3 SelectionTree
1730    
1731  C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>      my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options);
1732    
1733  Display a selection tree.  Display a selection tree.
1734    
# Line 2016  Line 1917 
1917    
1918  =head3 ShowBranch  =head3 ShowBranch
1919    
1920  C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>      my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType);
1921    
1922  This is a recursive method that displays a branch of the tree.  This is a recursive method that displays a branch of the tree.
1923    
# Line 2112  Line 2013 
2013                      if ($hasChildren) {                      if ($hasChildren) {
2014                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
2015                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2016                            Trace("Children of $myLabel finished.") if T(4);
2017                      }                      }
2018                  }                  }
2019              }              }
# Line 2146  Line 2048 
2048              }              }
2049              # Next, we format the label.              # Next, we format the label.
2050              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
2051              Trace("Formatting tree node for $myLabel.") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
2052              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
2053              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
2054                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
# Line 2167  Line 2069 
2069    
2070  =head3 GetDivID  =head3 GetDivID
2071    
2072  C<< my $idString = SearchHelper::GetDivID($name); >>      my $idString = SearchHelper::GetDivID($name);
2073    
2074  Return a new HTML ID string.  Return a new HTML ID string.
2075    
# Line 2196  Line 2098 
2098      return $retVal;      return $retVal;
2099  }  }
2100    
2101  =head2 Feature Column Methods  =head3 PrintLine
   
 The methods in this column 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.  
   
 =head3 DefaultFeatureColumns  
   
 C<< my @colNames = $shelp->DefaultFeatureColumns(); >>  
   
 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  
2102    
2103  C<< my $title = $shelp->FeatureColumnTitle($colName); >>      $shelp->PrintLine($message);
2104    
2105  Return the column heading title to be used for the specified feature column.  Print a line of CGI output. This is used during the operation of the B<Find> method while
2106    searching, so the user sees progress in real-time.
2107    
2108  =over 4  =over 4
2109    
2110  =item name  =item message
   
 Name of the desired feature column.  
   
 =item RETURN  
2111    
2112  Returns the title to be used as the column header for the named feature column.  HTML text to display.
2113    
2114  =back  =back
2115    
2116  =cut  =cut
2117    
2118  sub FeatureColumnTitle {  sub PrintLine {
2119      # Get the parameters.      # Get the parameters.
2120      my ($self, $colName) = @_;      my ($self, $message) = @_;
2121      # Declare the return variable. We default to a blank column name.      # Send them to the output.
2122      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";  
2123      }      }
     # Return the result.  
     return $retVal;  
 }  
   
2124    
2125  =head3 FeatureColumnValue  =head3 GetHelper
2126    
2127  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>      my $shelp = SearchHelper::GetHelper($parm, $type => $className);
2128    
2129  Return the value to be displayed in the specified feature column.  Return a helper object with the given class name. If no such class exists, an
2130    error will be thrown.
2131    
2132  =over 4  =over 4
2133    
2134  =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.  
         my $gurl = "GetGBrowse.cgi?fid=$fid";  
         $retVal = $cgi->a({ href => $gurl, title => "GBrowse for $fid" },  
                           $cgi->img({ src => "../images/button-gbrowse.png",  
                                       border => 0 })  
                          );  
     } 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.  
         my $hurl = HTML::fid_link($cgi, $fid, 0, 1);  
         $retVal = $cgi->a({ href => $hurl, title => "Protein page for $fid" },  
                           $cgi->img({ src => "../images/button-nmpdr.png",  
                                      border => 0 })  
                          );  
     }elsif ($colName eq 'subsystem') {  
         # Another run-time column: subsystem list.  
         $retVal = "%%subsystem=$fid";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 RunTimeColumns  
2135    
2136  C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>  Parameter to pass to the constructor. This is a CGI object for a search helper
2137    and a search helper object for the result helper.
 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  
2138    
2139  =item type  =item type
2140    
2141  Type of column.  Type of helper: C<RH> for a result helper and C<SH> for a search helper.
2142    
2143  =item text  =item className
2144    
2145  Data relevant to this row of the column.  Class name for the helper object, without the preceding C<SH> or C<RH>. This is
2146    identical to what the script expects for the C<Class> or C<ResultType> parameter.
2147    
2148  =item RETURN  =item RETURN
2149    
2150  Returns the fully-formatted HTML text to go in the specified column.  Returns a helper object for the specified class.
2151    
2152  =back  =back
2153    
2154  =cut  =cut
2155    
2156  sub RunTimeColumns {  sub GetHelper {
2157      # Get the parameters.      # Get the parameters.
2158      my ($self, $type, $text) = @_;      my ($parm, $type, $className) = @_;
2159      # Declare the return variable.      # Declare the return variable.
2160      my $retVal = "";      my $retVal;
2161      # Get the Sprout and CGI objects.      # Try to create the helper.
2162      my $sprout = $self->DB();      eval {
2163      my $cgi = $self->Q();          # Load it into memory. If it's already there nothing will happen here.
2164      Trace("Runtime column $type with text \"$text\" found.") if T(4);          my $realName = "$type$className";
2165      # Separate the text into a type and data.          Trace("Requiring helper $realName.") if T(3);
2166      if ($type eq 'alias') {          require "$realName.pm";
2167          # Here the caller wants external alias links for a feature. The text          Trace("Constructing helper object.") if T(3);
2168          # is the feature ID.          # Construct the object.
2169          my $fid = $text;          $retVal = eval("$realName->new(\$parm)");
2170          # The complicated part is we have to hyperlink them. First, get the          # Commit suicide if it didn't work.
2171          # aliases.          if (! defined $retVal) {
2172          Trace("Generating aliases for feature $fid.") if T(4);              die "Could not find a $type handler of type $className.";
2173          my @aliases = $sprout->FeatureAliases($fid);          }
2174          # Only proceed if we found some.      };
2175          if (@aliases) {      # Check for errors.
2176              # Join the aliases into a comma-delimited list.      if ($@) {
2177              my $aliasList = join(", ", @aliases);          Confess("Error retrieving $type$className: $@");
             # Ask the HTML processor to hyperlink them.  
             $retVal = HTML::set_prot_links($cgi, $aliasList);  
         }  
     } 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);  
         # Convert them to links.  
         my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;  
         # String them into a list.  
         $retVal = join(", ", @links);  
     } 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);  
2178      }      }
2179      # Return the result.      # Return the result.
2180      return $retVal;      return $retVal;
# Line 2460  Line 2182 
2182    
2183  =head3 SaveOrganismData  =head3 SaveOrganismData
2184    
2185  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>      my ($name, $displayGroup, $domain) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy);
2186    
2187  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
2188  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 2490  Line 2212 
2212    
2213  Strain of the species represented by the genome.  Strain of the species represented by the genome.
2214    
2215    =item taxonomy
2216    
2217    Taxonomy of the species represented by the genome.
2218    
2219  =item RETURN  =item RETURN
2220    
2221  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
2222  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.
2223    
2224  =back  =back
2225    
# Line 2501  Line 2227 
2227    
2228  sub SaveOrganismData {  sub SaveOrganismData {
2229      # Get the parameters.      # Get the parameters.
2230      my ($self, $group, $genomeID, $genus, $species, $strain) = @_;      my ($self, $group, $genomeID, $genus, $species, $strain, $taxonomy) = @_;
2231      # Declare the return values.      # Declare the return values.
2232      my ($name, $displayGroup);      my ($name, $displayGroup);
2233      # 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 2517  Line 2243 
2243          # 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
2244          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2245          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2246            Trace("Group = $displayGroup, translated from \"$group\".") if T(4);
2247      }      }
2248        # Compute the domain from the taxonomy.
2249        my ($domain) = split /\s*;\s*/, $taxonomy, 2;
2250      # Cache the group and organism data.      # Cache the group and organism data.
2251      my $cache = $self->{orgs};      my $cache = $self->{orgs};
2252      $cache->{$genomeID} = [$name, $displayGroup];      $cache->{$genomeID} = [$name, $displayGroup, $domain];
2253      # Return the result.      # Return the result.
2254      return ($name, $displayGroup);      return ($name, $displayGroup, $domain);
2255  }  }
2256    
2257  =head3 ValidateKeywords  =head3 ValidateKeywords
2258    
2259  C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>      my $okFlag = $shelp->ValidateKeywords($keywordString, $required);
2260    
2261  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
2262  set.  set.
# Line 2563  Line 2292 
2292      if (! @wordList) {      if (! @wordList) {
2293          if ($required) {          if ($required) {
2294              $self->SetMessage("No search words specified.");              $self->SetMessage("No search words specified.");
2295            } else {
2296                $retVal = 1;
2297          }          }
2298      } elsif (! @plusWords) {      } elsif (! @plusWords) {
2299          $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 2573  Line 2304 
2304      return $retVal;      return $retVal;
2305  }  }
2306    
2307    =head3 TuningParameters
2308    
2309        my $options = $shelp->TuningParameters(%parmHash);
2310    
2311    Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names
2312    to their default values. The parameters and their values will be returned as a hash reference.
2313    
2314    =over 4
2315    
2316    =item parmHash
2317    
2318    Hash mapping parameter names to their default values.
2319    
2320    =item RETURN
2321    
2322    Returns a reference to a hash containing the parameter names mapped to their actual values.
2323    
2324    =back
2325    
2326    =cut
2327    
2328    sub TuningParameters {
2329        # Get the parameters.
2330        my ($self, %parmHash) = @_;
2331        # Declare the return variable.
2332        my $retVal = {};
2333        # Get the CGI Query Object.
2334        my $cgi = $self->Q();
2335        # Loop through the parameter names.
2336        for my $parm (keys %parmHash) {
2337            # Get the incoming value for this parameter.
2338            my $value = $cgi->param($parm);
2339            # Zero might be a valid value, so we do an is-defined check rather than an OR.
2340            if (defined($value)) {
2341                $retVal->{$parm} = $value;
2342            } else {
2343                $retVal->{$parm} = $parmHash{$parm};
2344            }
2345        }
2346        # Return the result.
2347        return $retVal;
2348    }
2349    
2350    =head3 GetPreferredAliasType
2351    
2352        my $type = $shelp->GetPreferredAliasType();
2353    
2354    Return the preferred alias type for the current session. This information is stored
2355    in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>
2356    (which indicates the FIG ID).
2357    
2358    =cut
2359    
2360    sub GetPreferredAliasType {
2361        # Get the parameters.
2362        my ($self) = @_;
2363        # Determine the preferred type.
2364        my $cgi = $self->Q();
2365        my $retVal = $cgi->param('AliasType') || 'FIG';
2366        # Return it.
2367        return $retVal;
2368    }
2369    
2370  =head2 Virtual Methods  =head2 Virtual Methods
2371    
2372  =head3 Form  =head3 Form
2373    
2374  C<< my $html = $shelp->Form(); >>      my $html = $shelp->Form();
2375    
2376  Generate the HTML for a form to request a new search.  Generate the HTML for a form to request a new search.
2377    
2378  =head3 Find  =head3 Find
2379    
2380  C<< my $resultCount = $shelp->Find(); >>      my $resultCount = $shelp->Find();
2381    
2382  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
2383  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
2384  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
2385  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.
2386    
2387    =cut
2388    
2389    sub Find {
2390        # Get the parameters.
2391        my ($self) = @_;
2392        $self->Message("Call to pure virtual Find method in helper of type " . ref($self) . ".");
2393        return undef;
2394    }
2395    
2396  =head3 Description  =head3 Description
2397    
2398  C<< my $htmlText = $shelp->Description(); >>      my $htmlText = $shelp->Description();
2399    
2400  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
2401  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,
2402  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.
2403    
2404  =head3 SortKey  =cut
2405    
2406    sub Description {
2407        # Get the parameters.
2408        my ($self) = @_;
2409        $self->Message("Call to pure virtual Description method in helper of type " . ref($self) . ".");
2410        return "Unknown search type";
2411    }
2412    
2413    =head3 SearchTitle
2414    
2415        my $titleHtml = $shelp->SearchTitle();
2416    
2417    Return the display title for this search. The display title appears above the search results.
2418    If no result is returned, no title will be displayed. The result should be an html string
2419    that can be legally put inside a block tag such as C<h3> or C<p>.
2420    
2421    =cut
2422    
2423    sub SearchTitle {
2424        # Get the parameters.
2425        my ($self) = @_;
2426        # Declare the return variable.
2427        my $retVal = "";
2428        # Return it.
2429        return $retVal;
2430    }
2431    
2432    =head3 DefaultColumns
2433    
2434  C<< my $key = $shelp->SortKey($fdata); >>      $shelp->DefaultColumns($rhelp);
2435    
2436  Return the sort key for the specified feature data. The default is to sort by feature name,  Store the default columns in the result helper. The default action is just to ask
2437  floating NMPDR organisms to the top. If a full-text search is used, then the default  the result helper for its default columns, but this may be changed by overriding
2438  sort is by relevance followed by feature name. This sort may be overridden by the  this method.
 search class to provide fancier functionality. This method is called by  
 B<PutFeature>, so it is only used for feature searches. A non-feature search  
 would presumably have its own sort logic.  
2439    
2440  =over 4  =over 4
2441    
2442  =item record  =item rhelp
2443    
2444    Result helper object in which the column list should be stored.
2445    
2446  The C<FeatureData> containing the current feature.  =back
2447    
2448    =cut
2449    
2450    sub DefaultColumns {
2451        # Get the parameters.
2452        my ($self, $rhelp) = @_;
2453        # Get the default columns from the result helper.
2454        my @cols = $rhelp->DefaultResultColumns();
2455        # Store them back.
2456        $rhelp->SetColumns(@cols);
2457    }
2458    
2459    =head3 Hint
2460    
2461        my $htmlText = SearchHelper::Hint($wikiPage, $hintText);
2462    
2463    Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2464    This HTML can be put in forms to provide a useful hinting mechanism.
2465    
2466    =over 4
2467    
2468    =item wikiPage
2469    
2470    Name of the wiki page to be popped up when the hint mark is clicked.
2471    
2472    =item hintText
2473    
2474    Text to display for the hint. It is raw html, but may not contain any double quotes.
2475    
2476  =item RETURN  =item RETURN
2477    
2478  Returns a key field that can be used to sort this row in among the results.  Returns the html for the hint facility. The resulting html shows a small button-like thing that
2479    uses the standard FIG popup technology.
2480    
2481  =back  =back
2482    
2483  =cut  =cut
2484    
2485  sub SortKey {  sub Hint {
2486      # Get the parameters.      # Get the parameters.
2487      my ($self, $fdata) = @_;      my ($wikiPage, $hintText) = @_;
2488      # Get the feature ID from the record.      # Escape the single quotes in the hint text.
2489      my $fid = $fdata->FID();      my $quotedText = $hintText;
2490      # Get the group from the feature ID.      $quotedText =~ s/'/\\'/g;
2491      my $group = $self->FeatureGroup($fid);      # Convert the wiki page name to a URL.
2492      # Ask the feature query object to form the sort key.      my $wikiURL = join("", map { ucfirst $_ } split /\s+/, $wikiPage);
2493      my $retVal = $fdata->SortKey($self, $group);      $wikiURL = "wiki/view.cgi/FIG/$wikiURL";
2494      # Return the result.      # Create the html.
2495        my $retVal = "&nbsp;<input type=\"button\" class=\"hintbutton\" onMouseOver=\"javascript:if (!this.tooltip) { " .
2496                     "this.tooltip = new Popup_Tooltip(this, 'Search Hint', '$quotedText', '', 1); this.tooltip.addHandler(); } " .
2497                     "return false;\" value=\"?\" onClick=\"javascript:window.open('$wikiURL', 'nmpdrHelp');\" />";
2498        # Return it.
2499      return $retVal;      return $retVal;
2500  }  }
2501    
2502    
2503  1;  1;

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.40

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3