[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.15, Fri Nov 10 22:01:36 2006 UTC revision 1.35, Mon Jul 16 20:53:11 2007 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.
217  entirely in favor of your own custom filtering, you could include extra columns  
218  in the output, or you could search for something that's not a feature at all. The  In addition to the finding and filtering, it is necessary to send status messages
219  above code is just a loose framework.  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  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>      $self->PrintLine("...my message text...<br />");
 method of the feature query object.  
224    
225      $fq->AddExtraColumns(score => $sc);  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 244  Line 234 
234    
235  # This counter is used to insure every form on the page has a unique name.  # This counter is used to insure every form on the page has a unique name.
236  my $formCount = 0;  my $formCount = 0;
237    # This counter is used to generate unique DIV IDs.
238    my $divCount = 0;
239    
240  =head2 Public Methods  =head2 Public Methods
241    
242  =head3 new  =head3 new
243    
244  C<< my $shelp = SearchHelper->new($query); >>  C<< 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 265  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 297  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 452  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);
# Line 550  Line 557 
557    
558  =head3 OpenSession  =head3 OpenSession
559    
560  C<< $shelp->OpenSession(); >>  C<< $shelp->OpenSession($rhelp); >>
561    
562    Set up the session cache file and write out the column headers.
563    This method should not be called until all the columns have
564    been configured, including the extra columns.
565    
566    =over 4
567    
568  Set up to open the session cache file for writing. Note we don't actually  =item rhelp
569  open the file until after we know the column headers.  
570    Result helper for formatting the output. This has the column
571    headers stored in it.
572    
573    =back
574    
575  =cut  =cut
576    
577  sub OpenSession {  sub OpenSession {
578      # Get the parameters.      # Get the parameters.
579      my ($self) = @_;      my ($self, $rhelp) = @_;
580      # Denote we have not yet written out the column headers.      # Insure the result helper is valid.
581      $self->{cols} = undef;      if (! defined($rhelp)) {
582            Confess("No result type specified for $self->{class}.");
583        } elsif(! $rhelp->isa('ResultHelper')) {
584            Confess("Invalid result type specified for $self->{class}.");
585        } else {
586            # Get the column headers and write them out.
587            my $colHdrs = $rhelp->GetColumnHeaders();
588            Trace(scalar(@{$colHdrs}) . " column headers written to output.") if T(3);
589            $self->WriteColumnHeaders(@{$colHdrs});
590        }
591  }  }
592    
593  =head3 GetCacheFileName  =head3 GetCacheFileName
# Line 605  Line 631 
631      my ($self, $type) = @_;      my ($self, $type) = @_;
632      # Compute the file name. Note it gets stuffed in the FIG temporary      # Compute the file name. Note it gets stuffed in the FIG temporary
633      # directory.      # directory.
634      my $retVal = "$FIG_Config::temp/tmp_" . $self->ID() . ".$type";      my $retVal = FIGRules::GetTempFileName(sessionID => $self->ID(), extension => $type);
635      # Return the result.      # Return the result.
636      return $retVal;      return $retVal;
637  }  }
638    
 =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);  
 }  
   
639  =head3 WriteColumnHeaders  =head3 WriteColumnHeaders
640    
641  C<< $shelp->WriteColumnHeaders(@colNames); >>  C<< $shelp->WriteColumnHeaders(@colNames); >>
# Line 700  Line 648 
648    
649  =item colNames  =item colNames
650    
651  A list of column names in the desired presentation order.  A list of column names in the desired presentation order. For extra columns,
652    the column name is the hash supplied as the column definition.
653    
654  =back  =back
655    
# Line 712  Line 661 
661      # Get the cache file name and open it for output.      # Get the cache file name and open it for output.
662      my $fileName = $self->GetCacheFileName();      my $fileName = $self->GetCacheFileName();
663      my $handle1 = Open(undef, ">$fileName");      my $handle1 = Open(undef, ">$fileName");
664        # Freeze the column headers.
665        my @colHdrs = map { freeze($_) } @colNames;
666      # Write the column headers and close the file.      # Write the column headers and close the file.
667      Tracer::PutLine($handle1, \@colNames);      Tracer::PutLine($handle1, \@colHdrs);
668      close $handle1;      close $handle1;
669      # 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
670      # 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 722  Line 673 
673      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
674  }  }
675    
676    =head3 ReadColumnHeaders
677    
678    C<< my @colHdrs = $shelp->ReadColumnHeaders($fh); >>
679    
680    Read the column headers from the specified file handle. The column headers are
681    frozen strings intermixed with frozen hash references. The strings represent
682    column names defined in the result helper. The hash references represent the
683    definitions of the extra columns.
684    
685    =over 4
686    
687    =item fh
688    
689    File handle from which the column headers are to be read.
690    
691    =item RETURN
692    
693    Returns a list of the column headers pulled from the specified file's first line.
694    
695    =back
696    
697    =cut
698    
699    sub ReadColumnHeaders {
700        # Get the parameters.
701        my ($self, $fh) = @_;
702        # Read and thaw the columns.
703        my @retVal = map { thaw($_) } Tracer::GetLine($fh);
704        # Return them to the caller.
705        return @retVal;
706    }
707    
708  =head3 WriteColumnData  =head3 WriteColumnData
709    
710  C<< $shelp->WriteColumnData($key, @colValues); >>  C<< $shelp->WriteColumnData($key, @colValues); >>
# Line 748  Line 731 
731      my ($self, $key, @colValues) = @_;      my ($self, $key, @colValues) = @_;
732      # Write them to the cache file.      # Write them to the cache file.
733      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);
734        Trace("Column data is " . join("; ", $key, @colValues) . ".") if T(4);
735  }  }
736    
737  =head3 CloseSession  =head3 CloseSession
# Line 766  Line 750 
750          # We found one, so close it.          # We found one, so close it.
751          Trace("Closing session file.") if T(2);          Trace("Closing session file.") if T(2);
752          close $self->{fileHandle};          close $self->{fileHandle};
753            # Tell the user.
754            my $cgi = $self->Q();
755            $self->PrintLine("Output formatting complete.<br />");
756      }      }
757  }  }
758    
 =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;  
 }  
   
759  =head3 OrganismData  =head3 OrganismData
760    
761  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>
# Line 808  Line 772 
772    
773  =item RETURN  =item RETURN
774    
775  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,
776  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
777  organism is not in an NMPDR group.  organism is not in an NMPDR group. The third item is the organism's domain.
778    
779  =back  =back
780    
# Line 820  Line 784 
784      # Get the parameters.      # Get the parameters.
785      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
786      # Declare the return variables.      # Declare the return variables.
787      my ($orgName, $group);      my ($orgName, $group, $domain);
788      # Check the cache.      # Check the cache.
789      my $cache = $self->{orgs};      my $cache = $self->{orgs};
790      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
791          ($orgName, $group) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
792      } else {      } else {
793          # Here we have to use the database.          # Here we have to use the database.
794          my $sprout = $self->DB();          my $sprout = $self->DB();
795          my ($genus, $species, $strain, $group) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $group, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,
796                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
797                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
798                                                       'Genome(primary-group)']);                                                                   'Genome(primary-group)',
799                                                                     'Genome(taxonomy)']);
800          # Format and cache the name and display group.          # Format and cache the name and display group.
801          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          ($orgName, $group, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
802                                                              $strain);                                                                $strain, $taxonomy);
803      }      }
804      # Return the result.      # Return the result.
805      return ($orgName, $group);      return ($orgName, $group, $domain);
806  }  }
807    
808  =head3 Organism  =head3 Organism
# Line 865  Line 830 
830      # Get the parameters.      # Get the parameters.
831      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
832      # Get the organism data.      # Get the organism data.
833      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]";  
     }  
834      # Return the result.      # Return the result.
835      return $retVal;      return $retVal;
836  }  }
837    
838  =head3 ComputeFASTA  =head3 ComputeFASTA
839    
840  C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth); >>
841    
842  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
843  that it is possible to convert a DNA sequence into a protein sequence, but the reverse  the desired flanking width.
 is not possible.  
844    
845  =over 4  =over 4
846    
 =item incomingType  
   
 C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.  
   
847  =item desiredType  =item desiredType
848    
849  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>
850  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.
851    
852  =item sequence  =item sequence
853    
# Line 970  Line 857 
857  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
858  line will be provided.  line will be provided.
859    
860    =item flankingWidth
861    
862    If the DNA FASTA of a feature is desired, the number of base pairs to either side of the
863    feature that should be included. Currently we can't do this for Proteins because the
864    protein translation of a feature doesn't always match the DNA and is taken directly
865    from the database.
866    
867  =item RETURN  =item RETURN
868    
869  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 982  Line 876 
876    
877  sub ComputeFASTA {  sub ComputeFASTA {
878      # Get the parameters.      # Get the parameters.
879      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence, $flankingWidth) = @_;
880      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
881      my $retVal;      my $retVal;
882      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
883      my $okFlag = 1;      my $okFlag = 1;
884      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
885      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
886      Trace("FASTA incoming type is $incomingType, desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
887      # Check for a feature specification.      # Check for a feature specification. The smoking gun for that is a vertical bar.
888      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
889          # 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
890          # it.          # it.
# Line 1002  Line 896 
896          # exist.          # exist.
897          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
898          if (! $figID) {          if (! $figID) {
899              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
900              $okFlag = 0;              $okFlag = 0;
901          } else {          } else {
902              # Set the FASTA label.              # Set the FASTA label. The ID is the first favored alias.
903              my $fastaLabel = $fid;              my $favored = $self->Q()->param('FavoredAlias') || 'fig';
904                my $favorLen = length $favored;
905                ($fastaLabel) = grep { substr($_, 0, $favorLen) eq $favored } $sprout->FeatureAliases($fid);
906                if (! $fastaLabel) {
907                    # In an emergency, fall back to the original ID.
908                    $fastaLabel = $fid;
909                }
910              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
911              if ($desiredType eq 'prot') {              if ($desiredType =~ /prot/) {
912                  # We want protein, so get the translation.                  # We want protein, so get the translation.
913                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
914                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
915              } else {              } elsif ($desiredType =~ /dna/) {
916                  # 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
917                    # locations.
918                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
919                    if ($flankingWidth > 0) {
920                        # Here we need to add flanking data. Convert the locations to a list
921                        # of location objects.
922                        my @locObjects = map { BasicLocation->new($_) } @locList;
923                        # Initialize the return variable. We will put the DNA in here segment by segment.
924                        $fastaData = "";
925                        # Now we widen each location by the flanking width and stash the results. This
926                        # requires getting the contig length for each contig so we don't fall off the end.
927                        for my $locObject (@locObjects) {
928                            Trace("Current location is " . $locObject->String . ".") if T(4);
929                            # Remember the current start and length.
930                            my ($start, $len) = ($locObject->Left, $locObject->Length);
931                            # Get the contig length.
932                            my $contigLen = $sprout->ContigLength($locObject->Contig);
933                            # Widen the location and get its DNA.
934                            $locObject->Widen($flankingWidth, $contigLen);
935                            my $fastaSegment = $sprout->DNASeq([$locObject->String()]);
936                            # Now we need to do some case changing. The main DNA is upper case and
937                            # the flanking DNA is lower case.
938                            my $leftFlank = $start - $locObject->Left;
939                            my $rightFlank = $leftFlank + $len;
940                            Trace("Wide location is " . $locObject->String . ". Flanks are $leftFlank and $rightFlank. Contig len is $contigLen.") if T(4);
941                            my $fancyFastaSegment = lc(substr($fastaSegment, 0, $leftFlank)) .
942                                                    uc(substr($fastaSegment, $leftFlank, $rightFlank - $leftFlank)) .
943                                                    lc(substr($fastaSegment, $rightFlank));
944                            $fastaData .= $fancyFastaSegment;
945                        }
946                    } else {
947                        # Here we have just the raw sequence.
948                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
949                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  }
950                    Trace((length $fastaData) . " characters returned for DNA of $fastaLabel.") if T(3);
951              }              }
952          }          }
     } 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;  
953      } else {      } else {
954          Trace("Analyzing FASTA sequence.") if T(4);          Trace("Analyzing FASTA sequence.") if T(4);
955          # 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 1035  Line 962 
962              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);
963              # 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
964              # as data.              # as data.
965              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "$desiredType sequence specified by user";
966              $fastaData = $sequence;              $fastaData = $sequence;
967          }          }
968          # 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.
969            if ($desiredType !~ /pattern/i) {
970          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
971          $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;  
972              }              }
973          } elsif ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {          # Finally, verify that it's DNA if we're doing DNA stuff.
974              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {
975                $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
976              $okFlag = 0;              $okFlag = 0;
977          }          }
978      }      }
979      Trace("FASTA data sequence: $fastaData") if T(4);      Trace("FASTA data sequence: $fastaData") if T(4);
980      # Only proceed if no error was detected.      # Only proceed if no error was detected.
981      if ($okFlag) {      if ($okFlag) {
982            if ($desiredType =~ /pattern/i) {
983                # For a scan, there is no label and no breakup.
984                $retVal = $fastaData;
985            } else {
986          # 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
987          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
988          # 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 1066  Line 991 
991          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
992          $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
993      }      }
994        }
995      # Return the result.      # Return the result.
996      return $retVal;      return $retVal;
997  }  }
998    
999    =head3 SubsystemTree
1000    
1001    C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>
1002    
1003    This method creates a subsystem selection tree suitable for passing to
1004    L</SelectionTree>. Each leaf node in the tree will have a link to the
1005    subsystem display page. In addition, each node can have a radio button. The
1006    radio button alue is either C<classification=>I<string>, where I<string> is
1007    a classification string, or C<id=>I<string>, where I<string> is a subsystem ID.
1008    Thus, it can either be used to filter by a group of related subsystems or a
1009    single subsystem.
1010    
1011    =over 4
1012    
1013    =item sprout
1014    
1015    Sprout database object used to get the list of subsystems.
1016    
1017    =item options
1018    
1019    Hash containing options for building the tree.
1020    
1021    =item RETURN
1022    
1023    Returns a reference to a tree list suitable for passing to L</SelectionTree>.
1024    
1025    =back
1026    
1027    The supported options are as follows.
1028    
1029    =over 4
1030    
1031    =item radio
1032    
1033    TRUE if the tree should be configured for radio buttons. The default is FALSE.
1034    
1035    =item links
1036    
1037    TRUE if the tree should be configured for links. The default is TRUE.
1038    
1039    =back
1040    
1041    =cut
1042    
1043    sub SubsystemTree {
1044        # Get the parameters.
1045        my ($sprout, %options) = @_;
1046        # Process the options.
1047        my $optionThing = Tracer::GetOptions({ radio => 0, links => 1 }, \%options);
1048        # Read in the subsystems.
1049        my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1050                                   ['Subsystem(classification)', 'Subsystem(id)']);
1051        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1052        # is at the end, ALL subsystems are unclassified and we don't bother.
1053        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1054            while ($subs[0]->[0] eq '') {
1055                my $classLess = shift @subs;
1056                push @subs, $classLess;
1057            }
1058        }
1059        # Declare the return variable.
1060        my @retVal = ();
1061        # Each element in @subs represents a leaf node, so as we loop through it we will be
1062        # producing one leaf node at a time. The leaf node is represented as a 2-tuple. The
1063        # first element is a semi-colon-delimited list of the classifications for the
1064        # subsystem. There will be a stack of currently-active classifications, which we will
1065        # compare to the incoming classifications from the end backward. A new classification
1066        # requires starting a new branch. A different classification requires closing an old
1067        # branch and starting a new one. Each classification in the stack will also contain
1068        # that classification's current branch. We'll add a fake classification at the
1069        # beginning that we can use to represent the tree as a whole.
1070        my $rootName = '<root>';
1071        # Create the classification stack. Note the stack is a pair of parallel lists,
1072        # one containing names and the other containing content.
1073        my @stackNames = ($rootName);
1074        my @stackContents = (\@retVal);
1075        # Add a null entry at the end of the subsystem list to force an unrolling.
1076        push @subs, ['', undef];
1077        # Loop through the subsystems.
1078        for my $sub (@subs) {
1079            # Pull out the classification list and the subsystem ID.
1080            my ($classString, $id) = @{$sub};
1081            Trace("Processing class \"$classString\" and subsystem $id.") if T(4);
1082            # Convert the classification string to a list with the root classification in
1083            # the front.
1084            my @classList = ($rootName, split($FIG_Config::splitter, $classString));
1085            # Find the leftmost point at which the class list differs from the stack.
1086            my $matchPoint = 0;
1087            while ($matchPoint <= $#stackNames && $matchPoint <= $#classList &&
1088                   $stackNames[$matchPoint] eq $classList[$matchPoint]) {
1089                $matchPoint++;
1090            }
1091            Trace("Match point is $matchPoint. Stack length is " . scalar(@stackNames) .
1092                  ". Class List length is " . scalar(@classList) . ".") if T(4);
1093            # Unroll the stack to the matchpoint.
1094            while ($#stackNames >= $matchPoint) {
1095                my $popped = pop @stackNames;
1096                pop @stackContents;
1097                Trace("\"$popped\" popped from stack.") if T(4);
1098            }
1099            # Start branches for any new classifications.
1100            while ($#stackNames < $#classList) {
1101                # The branch for a new classification contains its radio button
1102                # data and then a list of children. So, at this point, if radio buttons
1103                # are desired, we put them into the content.
1104                my $newLevel = scalar(@stackNames);
1105                my @newClassContent = ();
1106                if ($optionThing->{radio}) {
1107                    my $newClassString = join($FIG_Config::splitter, @classList[1..$newLevel]);
1108                    push @newClassContent, { value => "classification=$newClassString%" };
1109                }
1110                # The new classification node is appended to its parent's content
1111                # and then pushed onto the stack. First, we need the node name.
1112                my $nodeName = $classList[$newLevel];
1113                # Add the classification to its parent. This makes it part of the
1114                # tree we'll be returning to the user.
1115                push @{$stackContents[$#stackNames]}, $nodeName, \@newClassContent;
1116                # Push the classification onto the stack.
1117                push @stackContents, \@newClassContent;
1118                push @stackNames, $nodeName;
1119                Trace("\"$nodeName\" pushed onto stack.") if T(4);
1120            }
1121            # Now the stack contains all our parent branches. We add the subsystem to
1122            # the branch at the top of the stack, but only if it's NOT the dummy node.
1123            if (defined $id) {
1124                # Compute the node name from the ID.
1125                my $nodeName = $id;
1126                $nodeName =~ s/_/ /g;
1127                # Create the node's leaf hash. This depends on the value of the radio
1128                # and link options.
1129                my $nodeContent = {};
1130                if ($optionThing->{links}) {
1131                    # Compute the link value.
1132                    my $linkable = uri_escape($id);
1133                    $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;show_clusters=1;SPROUT=1";
1134                }
1135                if ($optionThing->{radio}) {
1136                    # Compute the radio value.
1137                    $nodeContent->{value} = "id=$id";
1138                }
1139                # Push the node into its parent branch.
1140                Trace("\"$nodeName\" added to node list.") if T(4);
1141                push @{$stackContents[$#stackNames]}, $nodeName, $nodeContent;
1142            }
1143        }
1144        # Return the result.
1145        return \@retVal;
1146    }
1147    
1148    
1149  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1150    
1151  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
# Line 1129  Line 1205 
1205      # Get the form name.      # Get the form name.
1206      my $formName = $self->FormName();      my $formName = $self->FormName();
1207      # 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};  
1208      my $groupHash;      my $groupHash;
1209        my @groups;
1210        my $nmpdrGroupCount;
1211        my $genomes = $self->{genomeList};
1212      if (defined $genomes) {      if (defined $genomes) {
1213          # We have a list ready to use.          # We have a list ready to use.
1214          $groupHash = $genomes;          $groupHash = $genomes;
1215            @groups = @{$self->{groupList}};
1216            $nmpdrGroupCount = $self->{groupCount};
1217      } else {      } else {
1218          # 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
1219          # 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 1142  Line 1222 
1222                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
1223                                           [], ['Genome(primary-group)', 'Genome(id)',                                           [], ['Genome(primary-group)', 'Genome(id)',
1224                                                'Genome(genus)', 'Genome(species)',                                                'Genome(genus)', 'Genome(species)',
1225                                                'Genome(unique-characterization)']);                                                'Genome(unique-characterization)',
1226                                                  'Genome(taxonomy)']);
1227          # 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
1228          # 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
1229          # name.          # name.
1230          my %gHash = ();          my %gHash = ();
1231          for my $genome (@genomeList) {          for my $genome (@genomeList) {
1232              # Get the genome data.              # Get the genome data.
1233              my ($group, $genomeID, $genus, $species, $strain) = @{$genome};              my ($group, $genomeID, $genus, $species, $strain, $taxonomy) = @{$genome};
1234              # Compute and cache its name and display group.              # Compute and cache its name and display group.
1235              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,              my ($name, $displayGroup, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1236                                                                  $strain);                                                                           $strain, $taxonomy);
1237              # 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
1238              # name here, not the display group name.              # name here, not the display group name.
1239              push @{$gHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name, $domain];
1240            }
1241            # We are almost ready to unroll the menu out of the group hash. The final step is to separate
1242            # the supporting genomes by domain. First, we sort the NMPDR groups.
1243            @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %gHash;
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 1201  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 1223  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("Enter a genome number, then click the button to the left " .
1334                                                                                                "in order to select the genome with that number. " .
1335                                                                                                "Enter a genus, species, or strain and click the " .
1336                                                                                                "button to select all genomes with that genus, species, " .
1337                                                                                                "or strain name.");
1338          # Next are the buttons to set and clear selections.          # Next are the buttons to set and clear selections.
1339          push @lines, "<br />";          push @lines, "<br />";
1340          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\" />";
# Line 1317  Line 1427 
1427  =item rows  =item rows
1428    
1429  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
1430  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
1431  set the width. Everything else will be left as is.  will be modified to set the width. Everything else will be left as is.
1432    
1433  =item RETURN  =item RETURN
1434    
# Line 1333  Line 1443 
1443      my ($self, $rows) = @_;      my ($self, $rows) = @_;
1444      # Get the CGI object.      # Get the CGI object.
1445      my $cgi = $self->Q();      my $cgi = $self->Q();
1446      # 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.
1447        # This flag will be set to FALSE when that happens.
1448        my $needWidth = 1;
1449      # 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
1450      # is already specified on the first column bad things will happen.      # is already specified on the first column bad things will happen.
1451      for my $row (@{$rows}) {      for my $row (@{$rows}) {
1452          $row =~ s/(<td|th)/$1 width="150"/i;          # See if this row needs a width.
1453            if ($needWidth && $row =~ /<(td|th) ([^>]+)>/i) {
1454                # Here we have a first cell and its tag parameters are in $2.
1455                my $elements = $2;
1456                if ($elements !~ /colspan/i) {
1457                    Trace("No colspan tag found in element \'$elements\'.") if T(3);
1458                    # Here there's no colspan, so we plug in the width. We
1459                    # eschew the "g" modifier on the substitution because we
1460                    # only want to update the first cell.
1461                    $row =~ s/(<(td|th))/$1 width="150"/i;
1462                    # Denote we don't need this any more.
1463                    $needWidth = 0;
1464                }
1465            }
1466      }      }
1467      # Create the table.      # Create the table.
1468      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = $cgi->table({border => 2, cellspacing => 2,
# Line 1349  Line 1474 
1474    
1475  =head3 SubmitRow  =head3 SubmitRow
1476    
1477  C<< my $htmlText = $shelp->SubmitRow(); >>  C<< my $htmlText = $shelp->SubmitRow($caption); >>
1478    
1479  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1480  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
1481  near the top of the form.  near the top of the form.
1482    
 =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.  
   
1483  =over 4  =over 4
1484    
1485  =item sprout  =item caption (optional)
1486    
1487  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.  
1488    
1489  =item RETURN  =item RETURN
1490    
1491  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
1492  ID, contig ID, starting offset, and stopping offset.  and tuning the results.
1493    
1494  =back  =back
1495    
1496  =cut  =cut
1497    
1498  sub GBrowseFeatureURL {  sub SubmitRow {
1499      # Get the parameters.      # Get the parameters.
1500      my ($sprout, $feat) = @_;      my ($self, $caption) = @_;
1501      # Declare the return variable.      my $cgi = $self->Q();
1502      my $retVal;      # Compute the button caption.
1503      # Compute the genome ID.      my $realCaption = (defined $caption ? $caption : 'Go');
1504      my ($genomeID) = FIGRules::ParseFeatureID($feat);      # Get the current page size.
1505      # Only proceed if the feature ID produces a valid genome.      my $pageSize = $cgi->param('PageSize');
1506      if ($genomeID) {      # Get the current feature ID type.
1507          # Get the feature location string.      my $aliasType = $self->GetPreferredAliasType();
1508          my $loc = $sprout->FeatureLocation($feat);      # Create the rows.
1509          # Compute the contig, start, and stop points.      my $retVal = $cgi->Tr($cgi->td("ID Type"), $cgi->td({ colspan => 2 },
1510          my($contig, $start, $stop) = BasicLocation::Parse($loc);                                                          $cgi->popup_menu(-name => 'AliasType',
1511          Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);                                                                           -values => ['FIG', AliasAnalysis::AliasTypes() ],
1512          # Now we need to do some goofiness to insure that the location is not too                                                                           -default => $aliasType) .
1513          # big and that we get some surrounding stuff.                                                          Hint("Specify how you want gene names to be displayed."))) .
1514          my $mid = int(($start + $stop) / 2);                   "\n" .
1515          my $chunk_len = 20000;                   $cgi->Tr($cgi->td("Results/Page"),
1516          my $max_feature = 40000;                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1517          my $feat_len = abs($stop - $start);                                                      -values => [10, 25, 50, 100, 1000],
1518          if ($feat_len > $chunk_len) {                                                      -default => $pageSize)),
1519              if ($feat_len > $max_feature) {                            $cgi->td($cgi->submit(-class => 'goButton',
1520                  $chunk_len = $max_feature;                                                  -name => 'Search',
1521              } else {                                                  -value => $realCaption)));
                 $chunk_len = $feat_len + 100;  
             }  
         }  
         my($show_start, $show_stop);  
         if ($chunk_len == $max_feature) {  
             $show_start = $start - 300;  
         } else {  
             $show_start = $mid - int($chunk_len / 2);  
         }  
         if ($show_start < 1) {  
             $show_start = 1;  
         }  
         $show_stop = $show_start + $chunk_len - 1;  
         my $clen = $sprout->ContigLength($contig);  
         if ($show_stop > $clen) {  
             $show_stop = $clen;  
         }  
         my $seg_id = $contig;  
         $seg_id =~ s/:/--/g;  
         Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);  
         # Assemble all the pieces.  
         $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id&start=$show_start&stop=$show_stop";  
     }  
1522      # Return the result.      # Return the result.
1523      return $retVal;      return $retVal;
1524  }  }
# Line 1527  Line 1575 
1575  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
1576  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>.
1577  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
1578  feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>  feature filtering performed by the B<RHFeatures> object, C<SearchHelp1_GenomeControl.inc>
1579  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>
1580  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
1581  external alias display.  external alias display.
# Line 1562  Line 1610 
1610    
1611  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1612    
1613  C<< my $url = $shelp->ComputeSearchURL(); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1614    
1615  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
1616  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 1572  Line 1620 
1620  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
1621  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1622    
1623    =over 4
1624    
1625    =item overrides
1626    
1627    Hash containing override values for the parameters, where the parameter name is
1628    the key and the parameter value is the override value. If the override value is
1629    C<undef>, the parameter will be deleted from the result.
1630    
1631    =item RETURN
1632    
1633    Returns a GET-style URL for invoking the search with the specified overrides.
1634    
1635    =back
1636    
1637  =cut  =cut
1638    
1639  sub ComputeSearchURL {  sub ComputeSearchURL {
1640      # Get the parameters.      # Get the parameters.
1641      my ($self) = @_;      my ($self, %overrides) = @_;
1642      # Get the database and CGI query object.      # Get the database and CGI query object.
1643      my $cgi = $self->Q();      my $cgi = $self->Q();
1644      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1603  Line 1665 
1665          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1666          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1667          # Check for special cases.          # Check for special cases.
1668          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1669              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1670              @values = ();              @values = ();
1671          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1617  Line 1679 
1679              if ($allFlag) {              if ($allFlag) {
1680                  @values = ();                  @values = ();
1681              }              }
1682            } elsif (exists $overrides{$parmKey}) {
1683                # Here the value is being overridden, so we skip it for now.
1684                @values = ();
1685          }          }
1686          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1687          if (@values) {          if (@values) {
1688              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1689          }          }
1690      }      }
1691        # Now do the overrides.
1692        for my $overKey (keys %overrides) {
1693            # Only use this override if it's not a delete marker.
1694            if (defined $overrides{$overKey}) {
1695                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1696            }
1697        }
1698      # Add the parameters to the URL.      # Add the parameters to the URL.
1699      $retVal .= "?" . join(";", @urlList);      $retVal .= "?" . join(";", @urlList);
1700      # Return the result.      # Return the result.
1701      return $retVal;      return $retVal;
1702  }  }
1703    
1704  =head3 GetRunTimeValue  =head3 AdvancedClassList
1705    
1706    C<< my @classes = SearchHelper::AdvancedClassList(); >>
1707    
1708    Return a list of advanced class names. This list is used to generate the directory
1709    of available searches on the search page.
1710    
1711    We do a file search to accomplish this, but to pull it off we need to look at %INC.
1712    
1713    =cut
1714    
1715    sub AdvancedClassList {
1716        # Determine the search helper module directory.
1717        my $libDirectory = $INC{'SearchHelper.pm'};
1718        $libDirectory =~ s/SearchHelper\.pm//;
1719        # Read it, keeping only the helper modules.
1720        my @modules = grep { /^SH\w+\.pm/ } Tracer::OpenDir($libDirectory, 0);
1721        # Convert the file names to search types.
1722        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } @modules;
1723        # Return the result in alphabetical order.
1724        return sort @retVal;
1725    }
1726    
1727    =head3 SelectionTree
1728    
1729    C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1730    
1731  C<< my $htmlText = $shelp->GetRunTimeValue($text); >>  Display a selection tree.
1732    
1733  Compute a run-time column value.  This method creates the HTML for a tree selection control. The tree is implemented as a set of
1734    nested HTML unordered lists. Each selectable element of the tree will contain a radio button. In
1735    addition, some of the tree nodes can contain hyperlinks.
1736    
1737    The tree itself is passed in as a multi-level list containing node names followed by
1738    contents. Each content element is a reference to a similar list. The first element of
1739    each list may be a hash reference. If so, it should contain one or both of the following
1740    keys.
1741    
1742  =over 4  =over 4
1743    
1744  =item text  =item link
1745    
1746  The run-time column text. It consists of 2 percent signs, a column type, an equal  The navigation URL to be popped up if the user clicks on the node name.
 sign, and the data for the current row.  
1747    
1748  =item RETURN  =item value
1749    
1750  Returns the fully-formatted HTML text to go into the current column of the current row.  The form value to be returned if the user selects the tree node.
1751    
1752  =back  =back
1753    
1754  =cut  The presence of a C<link> key indicates the node name will be hyperlinked. The presence of
1755    a C<value> key indicates the node name will have a radio button. If a node has no children,
1756    you may pass it a hash reference instead of a list reference.
1757    
1758  sub GetRunTimeValue {  The following example shows the hash for a three-level tree with links on the second level and
1759      # Get the parameters.  radio buttons on the third.
     my ($self, $text) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Parse the incoming text.  
     if ($text =~ /^%%([^=]+)=(.*)$/) {  
         $retVal = $self->RunTimeColumns($1, $2);  
     } else {  
         Confess("Invalid run-time column string \"$text\" encountered in session file.");  
     }  
     # Return the result.  
     return $retVal;  
 }  
1760    
1761  =head3 AdvancedClassList      [   Objects => [
1762                Entities => [
1763                    {link => "../docs/WhatIsAnEntity.html"},
1764                    Genome => {value => 'GenomeData'},
1765                    Feature => {value => 'FeatureData'},
1766                    Contig => {value => 'ContigData'},
1767                ],
1768                Relationships => [
1769                    {link => "../docs/WhatIsARelationShip.html"},
1770                    HasFeature => {value => 'GenomeToFeature'},
1771                    IsOnContig => {value => 'FeatureToContig'},
1772                ]
1773            ]
1774        ]
1775    
1776  C<< my @classes = SearchHelper::AdvancedClassList(); >>  Note how each leaf of the tree has a hash reference for its value, while the branch nodes
1777    all have list references.
1778    
1779  Return a list of advanced class names. This list is used to generate the directory  This next example shows how to set up a taxonomy selection field. The value returned
1780  of available searches on the search page.  by the tree control will be the taxonomy string for the selected node ready for use
1781    in a LIKE-style SQL filter. Only the single branch ending in campylobacter is shown for
1782    reasons of space.
1783    
1784  We use the %INC variable to accomplish this.      [   All => [
1785                {value => "%"},
1786                Bacteria => [
1787                    {value => "Bacteria%"},
1788                    Proteobacteria => [
1789                        {value => "Bacteria; Proteobacteria%"},
1790                        Epsilonproteobacteria => [
1791                            {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"},
1792                            Campylobacterales => [
1793                                {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"},
1794                                Campylobacteraceae =>
1795                                    {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"},
1796                                ...
1797                            ]
1798                            ...
1799                        ]
1800                        ...
1801                    ]
1802                    ...
1803                ]
1804                ...
1805            ]
1806        ]
1807    
 =cut  
1808    
1809  sub AdvancedClassList {  This method of tree storage allows the caller to control the order in which the tree nodes
1810      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;  are displayed and to completely control value selection and use of hyperlinks. It is, however
1811      return @retVal;  a bit complicated. Eventually, tree-building classes will be provided to simplify things.
1812    
1813    The parameters to this method are as follows.
1814    
1815    =over 4
1816    
1817    =item cgi
1818    
1819    CGI object used to generate the HTML.
1820    
1821    =item tree
1822    
1823    Reference to a hash describing a tree. See the description above.
1824    
1825    =item options
1826    
1827    Hash containing options for the tree display.
1828    
1829    =back
1830    
1831    The allowable options are as follows
1832    
1833    =over 4
1834    
1835    =item nodeImageClosed
1836    
1837    URL of the image to display next to the tree nodes when they are collapsed. Clicking
1838    on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.
1839    
1840    =item nodeImageOpen
1841    
1842    URL of the image to display next to the tree nodes when they are expanded. Clicking
1843    on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.
1844    
1845    =item style
1846    
1847    Style to use for the tree. The default is C<tree>. Because the tree style is implemented
1848    as nested lists, the key components of this style are the definitions for the C<ul> and
1849    C<li> tags. The default style file contains the following definitions.
1850    
1851        .tree ul {
1852           margin-left: 0; padding-left: 22px
1853        }
1854        .tree li {
1855            list-style-type: none;
1856  }  }
1857    
1858  =head2 Feature Column Methods  The default image is 22 pixels wide, so in the above scheme each tree level is indented from its
1859    parent by the width of the node image. This use of styles limits the things we can do in formatting
1860    the tree, but it has the advantage of vastly simplifying the tree creation.
1861    
1862  The methods in this column manage feature column data. If you want to provide the  =item name
 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.  
1863    
1864  There is one special column name syntax for extra columns (that is, nonstandard  Field name to give to the radio buttons in the tree. The default is C<selection>.
 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.  
1865    
1866  =head3 DefaultFeatureColumns  =item target
1867    
1868  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>  Frame target for links. The default is C<_self>.
1869    
1870  Return a list of the default feature column identifiers. These identifiers can  =item selected
1871  be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to  
1872  produce the column titles and row values.  If specified, the value of the radio button to be pre-selected.
1873    
1874    =back
1875    
1876  =cut  =cut
1877    
1878  sub DefaultFeatureColumns {  sub SelectionTree {
1879      # Get the parameters.      # Get the parameters.
1880      my ($self) = @_;      my ($cgi, $tree, %options) = @_;
1881        # Get the options.
1882        my $optionThing = Tracer::GetOptions({ name => 'selection',
1883                                               nodeImageClosed => '../FIG/Html/plus.gif',
1884                                               nodeImageOpen => '../FIG/Html/minus.gif',
1885                                               style => 'tree',
1886                                               target => '_self',
1887                                               selected => undef},
1888                                             \%options);
1889        # Declare the return variable. We'll do the standard thing with creating a list
1890        # of HTML lines and rolling them together at the end.
1891        my @retVal = ();
1892        # Only proceed if the tree is present.
1893        if (defined($tree)) {
1894            # Validate the tree.
1895            if (ref $tree ne 'ARRAY') {
1896                Confess("Selection tree is not a list reference.");
1897            } elsif (scalar @{$tree} == 0) {
1898                # The tree is empty, so we do nothing.
1899            } elsif ($tree->[0] eq 'HASH') {
1900                Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
1901            } else {
1902                # Here we have a real tree. Apply the tree style.
1903                push @retVal, $cgi->start_div({ class => $optionThing->{style} });
1904                # Give us a DIV ID.
1905                my $divID = GetDivID($optionThing->{name});
1906                # Show the tree.
1907                push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
1908                # Close the DIV block.
1909                push @retVal, $cgi->end_div();
1910            }
1911        }
1912      # Return the result.      # Return the result.
1913      return qw(orgName function gblink protlink);      return join("\n", @retVal, "");
1914  }  }
1915    
1916  =head3 FeatureColumnTitle  =head3 ShowBranch
1917    
1918  C<< my $title = $shelp->FeatureColumnTitle($colName); >>  C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>
1919    
1920  Return the column heading title to be used for the specified feature column.  This is a recursive method that displays a branch of the tree.
1921    
1922  =over 4  =over 4
1923    
1924  =item name  =item cgi
1925    
1926    CGI object used to format HTML.
1927    
1928    =item label
1929    
1930    Label of this tree branch. It is only used in error messages.
1931    
1932    =item id
1933    
1934    ID to be given to this tree branch. The ID is used in the code that expands and collapses
1935    tree nodes.
1936    
1937    =item branch
1938    
1939    Reference to a list containing the content of the tree branch. The list contains an optional
1940    hash reference that is ignored and the list of children, each child represented by a name
1941    and then its contents. The contents could by a hash reference (indicating the attributes
1942    of a leaf node), or another tree branch.
1943    
1944  Name of the desired feature column.  =item options
1945    
1946    Options from the original call to L</SelectionTree>.
1947    
1948    =item displayType
1949    
1950    C<block> if the contents of this list are to be displayed, C<none> if they are to be
1951    hidden.
1952    
1953  =item RETURN  =item RETURN
1954    
1955  Returns the title to be used as the column header for the named feature column.  Returns one or more HTML lines that can be used to display the tree branch.
1956    
1957  =back  =back
1958    
1959  =cut  =cut
1960    
1961  sub FeatureColumnTitle {  sub ShowBranch {
1962      # Get the parameters.      # Get the parameters.
1963      my ($self, $colName) = @_;      my ($cgi, $label, $id, $branch, $options, $displayType) = @_;
1964      # Declare the return variable. We default to a blank column name.      # Declare the return variable.
1965      my $retVal = "&nbsp;";      my @retVal = ();
1966      # Process the column name.      # Start the branch.
1967      if ($colName =~ /^X=(.+)$/) {      push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });
1968          # Here we have an extra column.      # Check for the hash and choose the start location accordingly.
1969          $retVal = $1;      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
1970      } elsif ($colName eq 'alias') {      # Get the list length.
1971          $retVal = "External Aliases";      my $i1 = scalar(@{$branch});
1972      } elsif ($colName eq 'fid') {      # Verify we have an even number of elements.
1973          $retVal = "FIG ID";      if (($i1 - $i0) % 2 != 0) {
1974      } elsif ($colName eq 'function') {          Trace("Branch elements are from $i0 to $i1.") if T(3);
1975          $retVal = "Functional Assignment";          Confess("Odd number of elements in tree branch $label.");
1976      } elsif ($colName eq 'gblink') {      } else {
1977          $retVal = "GBrowse";          # Loop through the elements.
1978      } elsif ($colName eq 'group') {          for (my $i = $i0; $i < $i1; $i += 2) {
1979          $retVal = "NMDPR Group";              # Get this node's label and contents.
1980      } elsif ($colName =~ /^keyword:(.+)$/) {              my ($myLabel, $myContent) = ($branch->[$i], $branch->[$i+1]);
1981          $retVal = ucfirst $1;              # Get an ID for this node's children (if any).
1982      } elsif ($colName eq 'orgName') {              my $myID = GetDivID($options->{name});
1983          $retVal = "Feature Name";              # Now we need to find the list of children and the options hash.
1984      } elsif ($colName eq 'protlink') {              # This is a bit ugly because we allow the shortcut of a hash without an
1985          $retVal = "NMPDR Protein Page";              # enclosing list. First, we need some variables.
1986      } elsif ($colName eq 'subsystem') {              my $attrHash = {};
1987          $retVal = "Subsystems";              my @childHtml = ();
1988                my $hasChildren = 0;
1989                if (! ref $myContent) {
1990                    Confess("Invalid tree definition. Scalar found as content of node \"$myLabel\".");
1991                } elsif (ref $myContent eq 'HASH') {
1992                    # Here the node is a leaf and its content contains the link/value hash.
1993                    $attrHash = $myContent;
1994                } elsif (ref $myContent eq 'ARRAY') {
1995                    # Here the node may be a branch. Its content is a list.
1996                    my $len = scalar @{$myContent};
1997                    if ($len >= 1) {
1998                        # Here the first element of the list could by the link/value hash.
1999                        if (ref $myContent->[0] eq 'HASH') {
2000                            $attrHash = $myContent->[0];
2001                            # If there's data in the list besides the hash, it's our child list.
2002                            # We can pass the entire thing as the child list, because the hash
2003                            # is ignored.
2004                            if ($len > 1) {
2005                                $hasChildren = 1;
2006                            }
2007                        } else {
2008                            $hasChildren = 1;
2009      }      }
2010                        # If we have children, create the child list with a recursive call.
2011                        if ($hasChildren) {
2012                            Trace("Processing children of $myLabel.") if T(4);
2013                            push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2014                            Trace("Children of $myLabel finished.") if T(4);
2015                        }
2016                    }
2017                }
2018                # Okay, it's time to pause and take stock. We have the label of the current node
2019                # in $myLabel, its attributes in $attrHash, and if it is NOT a leaf node, we
2020                # have a child list in @childHtml. If it IS a leaf node, $hasChildren is 0.
2021                # Compute the image HTML. It's tricky, because we have to deal with the open and
2022                # closed images.
2023                my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
2024                my $image = $images[$hasChildren];
2025                my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});
2026                if ($hasChildren) {
2027                    # If there are children, we wrap the image in a toggle hyperlink.
2028                    $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
2029                                          $prefixHtml);
2030                }
2031                # Now the radio button, if any. Note we use "defined" in case the user wants the
2032                # value to be 0.
2033                if (defined $attrHash->{value}) {
2034                    # Due to a glitchiness in the CGI stuff, we have to build the attribute
2035                    # hash for the "input" method. If the item is pre-selected, we add
2036                    # "checked => undef" to the hash. Otherwise, we can't have "checked"
2037                    # at all.
2038                    my $radioParms = { type => 'radio',
2039                                       name => $options->{name},
2040                                       value => $attrHash->{value},
2041                                     };
2042                    if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
2043                        $radioParms->{checked} = undef;
2044                    }
2045                    $prefixHtml .= $cgi->input($radioParms);
2046                }
2047                # Next, we format the label.
2048                my $labelHtml = $myLabel;
2049                Trace("Formatting tree node for \"$myLabel\".") if T(4);
2050                # Apply a hyperlink if necessary.
2051                if (defined $attrHash->{link}) {
2052                    $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
2053                                         $labelHtml);
2054                }
2055                # Finally, roll up the child HTML. If there are no children, we'll get a null string
2056                # here.
2057                my $childHtml = join("\n", @childHtml);
2058                # Now we have all the pieces, so we can put them together.
2059                push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");
2060            }
2061        }
2062        # Close the tree branch.
2063        push @retVal, $cgi->end_ul();
2064      # Return the result.      # Return the result.
2065      return $retVal;      return @retVal;
2066  }  }
2067    
2068    =head3 GetDivID
2069    
2070  =head3 FeatureColumnValue  C<< my $idString = SearchHelper::GetDivID($name); >>
2071    
2072  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  Return a new HTML ID string.
   
 Return the value to be displayed in the specified feature column.  
2073    
2074  =over 4  =over 4
2075    
2076  =item colName  =item name
2077    
2078  Name of the column to be displayed.  Name to be prefixed to the ID string.
2079    
2080  =item record  =item RETURN
2081    
2082  DBObject record for the feature being displayed in the current row.  Returns a hopefully-unique ID string.
2083    
2084  =item extraCols  =back
2085    
2086  Reference to a hash of extra column names to values. If the incoming column name  =cut
 begins with C<X=>, its value will be taken from this hash.  
2087    
2088  =item RETURN  sub GetDivID {
2089        # Get the parameters.
2090        my ($name) = @_;
2091        # Compute the ID.
2092        my $retVal = "elt_$name$divCount";
2093        # Increment the counter to make sure this ID is not re-used.
2094        $divCount++;
2095        # Return the result.
2096        return $retVal;
2097    }
2098    
2099    =head3 PrintLine
2100    
2101    C<< $shelp->PrintLine($message); >>
2102    
2103  Returns the HTML to be displayed in the named column for the specified feature.  Print a line of CGI output. This is used during the operation of the B<Find> method while
2104    searching, so the user sees progress in real-time.
2105    
2106    =over 4
2107    
2108    =item message
2109    
2110    HTML text to display.
2111    
2112  =back  =back
2113    
2114  =cut  =cut
2115    
2116  sub FeatureColumnValue {  sub PrintLine {
2117      # Get the parameters.      # Get the parameters.
2118      my ($self, $colName, $record, $extraCols) = @_;      my ($self, $message) = @_;
2119      # Get the sprout and CGI objects.      # Send them to the output.
2120      my $cgi = $self->Q();      print "$message\n";
     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;  
2121  }  }
2122    
2123  =head3 RunTimeColumns  =head3 GetHelper
2124    
2125  C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>  C<< my $shelp = SearchHelper::GetHelper($parm, $type => $className); >>
2126    
2127  Return the HTML text for a run-time column. Run-time columns are evaluated when the  Return a helper object with the given class name. If no such class exists, an
2128  list is displayed, rather than when it is generated.  error will be thrown.
2129    
2130  =over 4  =over 4
2131    
2132    =item parm
2133    
2134    Parameter to pass to the constructor. This is a CGI object for a search helper
2135    and a search helper object for the result helper.
2136    
2137  =item type  =item type
2138    
2139  Type of column.  Type of helper: C<RH> for a result helper and C<SH> for a search helper.
2140    
2141  =item text  =item className
2142    
2143  Data relevant to this row of the column.  Class name for the helper object, without the preceding C<SH> or C<RH>. This is
2144    identical to what the script expects for the C<Class> or C<ResultType> parameter.
2145    
2146  =item RETURN  =item RETURN
2147    
2148  Returns the fully-formatted HTML text to go in the specified column.  Returns a helper object for the specified class.
2149    
2150  =back  =back
2151    
2152  =cut  =cut
2153    
2154  sub RunTimeColumns {  sub GetHelper {
2155      # Get the parameters.      # Get the parameters.
2156      my ($self, $type, $text) = @_;      my ($parm, $type, $className) = @_;
2157      # Declare the return variable.      # Declare the return variable.
2158      my $retVal = "";      my $retVal;
2159      # Get the Sprout and CGI objects.      # Try to create the helper.
2160      my $sprout = $self->DB();      eval {
2161      my $cgi = $self->Q();          # Load it into memory. If it's already there nothing will happen here.
2162      Trace("Runtime column $type with text \"$text\" found.") if T(4);          my $realName = "$type$className";
2163      # Separate the text into a type and data.          Trace("Requiring helper $realName.") if T(3);
2164      if ($type eq 'alias') {          require "$realName.pm";
2165          # Here the caller wants external alias links for a feature. The text          Trace("Constructing helper object.") if T(3);
2166          # is the feature ID.          # Construct the object.
2167          my $fid = $text;          $retVal = eval("$realName->new(\$parm)");
2168          # The complicated part is we have to hyperlink them. First, get the          # Commit suicide if it didn't work.
2169          # aliases.          if (! defined $retVal) {
2170          Trace("Generating aliases for feature $fid.") if T(4);              die "Could not find a $type handler of type $className.";
2171          my @aliases = $sprout->FeatureAliases($fid);          }
2172          # Only proceed if we found some.      };
2173          if (@aliases) {      # Check for errors.
2174              # Join the aliases into a comma-delimited list.      if ($@) {
2175              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);  
2176      }      }
2177      # Return the result.      # Return the result.
2178      return $retVal;      return $retVal;
# Line 1945  Line 2180 
2180    
2181  =head3 SaveOrganismData  =head3 SaveOrganismData
2182    
2183  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); >>
2184    
2185  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
2186  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 1975  Line 2210 
2210    
2211  Strain of the species represented by the genome.  Strain of the species represented by the genome.
2212    
2213    =item taxonomy
2214    
2215    Taxonomy of the species represented by the genome.
2216    
2217  =item RETURN  =item RETURN
2218    
2219  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
2220  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.
2221    
2222  =back  =back
2223    
# Line 1986  Line 2225 
2225    
2226  sub SaveOrganismData {  sub SaveOrganismData {
2227      # Get the parameters.      # Get the parameters.
2228      my ($self, $group, $genomeID, $genus, $species, $strain) = @_;      my ($self, $group, $genomeID, $genus, $species, $strain, $taxonomy) = @_;
2229      # Declare the return values.      # Declare the return values.
2230      my ($name, $displayGroup);      my ($name, $displayGroup);
2231      # 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 2003  Line 2242 
2242          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2243          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2244      }      }
2245        # Compute the domain from the taxonomy.
2246        my ($domain) = split /\s*;\s*/, $taxonomy, 2;
2247      # Cache the group and organism data.      # Cache the group and organism data.
2248      my $cache = $self->{orgs};      my $cache = $self->{orgs};
2249      $cache->{$genomeID} = [$name, $displayGroup];      $cache->{$genomeID} = [$name, $displayGroup, $domain];
2250      # Return the result.      # Return the result.
2251      return ($name, $displayGroup);      return ($name, $displayGroup, $domain);
2252    }
2253    
2254    =head3 ValidateKeywords
2255    
2256    C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>
2257    
2258    Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2259    set.
2260    
2261    =over 4
2262    
2263    =item keywordString
2264    
2265    Keyword string specified as a parameter to the current search.
2266    
2267    =item required
2268    
2269    TRUE if there must be at least one keyword specified, else FALSE.
2270    
2271    =item RETURN
2272    
2273    Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
2274    is acceptable if the I<$required> parameter is not specified.
2275    
2276    =back
2277    
2278    =cut
2279    
2280    sub ValidateKeywords {
2281        # Get the parameters.
2282        my ($self, $keywordString, $required) = @_;
2283        # Declare the return variable.
2284        my $retVal = 0;
2285        my @wordList = split /\s+/, $keywordString;
2286        # Right now our only real worry is a list of all minus words. The problem with it is that
2287        # it will return an incorrect result.
2288        my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
2289        if (! @wordList) {
2290            if ($required) {
2291                $self->SetMessage("No search words specified.");
2292            } else {
2293                $retVal = 1;
2294            }
2295        } elsif (! @plusWords) {
2296            $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
2297        } else {
2298            $retVal = 1;
2299        }
2300        # Return the result.
2301        return $retVal;
2302    }
2303    
2304    =head3 TuningParameters
2305    
2306    C<< my $options = $shelp->TuningParameters(%parmHash); >>
2307    
2308    Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names
2309    to their default values. The parameters and their values will be returned as a hash reference.
2310    
2311    =over 4
2312    
2313    =item parmHash
2314    
2315    Hash mapping parameter names to their default values.
2316    
2317    =item RETURN
2318    
2319    Returns a reference to a hash containing the parameter names mapped to their actual values.
2320    
2321    =back
2322    
2323    =cut
2324    
2325    sub TuningParameters {
2326        # Get the parameters.
2327        my ($self, %parmHash) = @_;
2328        # Declare the return variable.
2329        my $retVal = {};
2330        # Get the CGI Query Object.
2331        my $cgi = $self->Q();
2332        # Loop through the parameter names.
2333        for my $parm (keys %parmHash) {
2334            # Get the incoming value for this parameter.
2335            my $value = $cgi->param($parm);
2336            # Zero might be a valid value, so we do an is-defined check rather than an OR.
2337            if (defined($value)) {
2338                $retVal->{$parm} = $value;
2339            } else {
2340                $retVal->{$parm} = $parmHash{$parm};
2341            }
2342        }
2343        # Return the result.
2344        return $retVal;
2345    }
2346    
2347    =head3 GetPreferredAliasType
2348    
2349    C<< my $type = $shelp->GetPreferredAliasType(); >>
2350    
2351    Return the preferred alias type for the current session. This information is stored
2352    in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>
2353    (which indicates the FIG ID).
2354    
2355    =cut
2356    
2357    sub GetPreferredAliasType {
2358        # Get the parameters.
2359        my ($self) = @_;
2360        # Determine the preferred type.
2361        my $cgi = $self->Q();
2362        my $retVal = $cgi->param('AliasType') || 'FIG';
2363        # Return it.
2364        return $retVal;
2365  }  }
2366    
2367  =head2 Virtual Methods  =head2 Virtual Methods
# Line 2027  Line 2381 
2381  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
2382  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.
2383    
2384    =cut
2385    
2386    sub Find {
2387        # Get the parameters.
2388        my ($self) = @_;
2389        $self->Message("Call to pure virtual Find method in helper of type " . ref($self) . ".");
2390        return undef;
2391    }
2392    
2393  =head3 Description  =head3 Description
2394    
2395  C<< my $htmlText = $shelp->Description(); >>  C<< my $htmlText = $shelp->Description(); >>
# Line 2035  Line 2398 
2398  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,
2399  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.
2400    
2401  =head3 SortKey  =cut
2402    
2403    sub Description {
2404        # Get the parameters.
2405        my ($self) = @_;
2406        $self->Message("Call to pure virtual Description method in helper of type " . ref($self) . ".");
2407        return "Unknown search type";
2408    }
2409    
2410    =head3 SearchTitle
2411    
2412    C<< my $titleHtml = $shelp->SearchTitle(); >>
2413    
2414  C<< my $key = $shelp->SortKey($fdata); >>  Return the display title for this search. The display title appears above the search results.
2415    If no result is returned, no title will be displayed. The result should be an html string
2416    that can be legally put inside a block tag such as C<h3> or C<p>.
2417    
2418  Return the sort key for the specified feature data. The default is to sort by feature name,  =cut
2419  floating NMPDR organisms to the top. If a full-text search is used, then the default  
2420  sort is by relevance followed by feature name. This sort may be overridden by the  sub SearchTitle {
2421  search class to provide fancier functionality. This method is called by      # Get the parameters.
2422  B<PutFeature>, so it is only used for feature searches. A non-feature search      my ($self) = @_;
2423  would presumably have its own sort logic.      # Declare the return variable.
2424        my $retVal = "";
2425        # Return it.
2426        return $retVal;
2427    }
2428    
2429    =head3 DefaultColumns
2430    
2431    C<< $shelp->DefaultColumns($rhelp); >>
2432    
2433    Store the default columns in the result helper. The default action is just to ask
2434    the result helper for its default columns, but this may be changed by overriding
2435    this method.
2436    
2437  =over 4  =over 4
2438    
2439  =item record  =item rhelp
2440    
2441    Result helper object in which the column list should be stored.
2442    
2443  The C<FeatureData> containing the current feature.  =back
2444    
2445    =cut
2446    
2447    sub DefaultColumns {
2448        # Get the parameters.
2449        my ($self, $rhelp) = @_;
2450        # Get the default columns from the result helper.
2451        my @cols = $rhelp->DefaultResultColumns();
2452        # Store them back.
2453        $rhelp->SetColumns(@cols);
2454    }
2455    
2456    =head3 Hint
2457    
2458    C<< my $htmlText = SearchHelper::Hint($hintText); >>
2459    
2460    Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2461    This HTML can be put in forms to provide a useful hinting mechanism.
2462    
2463    =over 4
2464    
2465    =item hintText
2466    
2467    Text to display for the hint. It is raw html, but may not contain any double quotes.
2468    
2469  =item RETURN  =item RETURN
2470    
2471  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
2472    uses the standard FIG popup technology.
2473    
2474  =back  =back
2475    
2476  =cut  =cut
2477    
2478  sub SortKey {  sub Hint {
2479      # Get the parameters.      # Get the parameters.
2480      my ($self, $fdata) = @_;      my ($hintText) = @_;
2481      # Get the feature ID from the record.      # Escape the single quotes.
2482      my $fid = $fdata->FID();      my $quotedText = $hintText;
2483      # Get the group from the feature ID.      $quotedText =~ s/'/\\'/g;
2484      my $group = $self->FeatureGroup($fid);      # Create the html.
2485      # Ask the feature query object to form the sort key.      my $retVal = "&nbsp;<input type=\"button\" class=\"hintbutton\" onMouseOver=\"javascript:if (!this.tooltip) { " .
2486      my $retVal = $fdata->SortKey($self, $group);                   "this.tooltip = new Popup_Tooltip(this, 'Search Hint', '$quotedText', '', 1); this.tooltip.addHandler(); } " .
2487      # Return the result.                   "return false;\" value=\"?\" />";
2488        # Return it.
2489      return $retVal;      return $retVal;
2490  }  }
2491    
2492    
2493  1;  1;

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.35

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3