[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.2, Wed Sep 27 16:55:38 2006 UTC revision 1.28, Tue Apr 10 06:05:40 2007 UTC
# Line 17  Line 17 
17      use HTML;      use HTML;
18      use BasicLocation;      use BasicLocation;
19      use FeatureQuery;      use FeatureQuery;
20        use URI::Escape;
21        use PageBuilder;
22    
23  =head1 Search Helper Base Class  =head1 Search Helper Base Class
24    
# Line 73  Line 75 
75    
76  List of JavaScript statements to be executed after the form is closed.  List of JavaScript statements to be executed after the form is closed.
77    
78    =item genomeHash
79    
80    Cache of the genome group hash used to build genome selection controls.
81    
82    =item genomeParms
83    
84    List of the parameters that are used to select multiple genomes.
85    
86    =item filtered
87    
88    TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this
89    field is updated by the B<FeatureQuery> object.
90    
91    =item extraPos
92    
93    C<0> if the extra columns are to be at the beginning, else C<1>. The
94    default is zero; use the L</SetExtraPos> method to change this option.
95    
96  =back  =back
97    
98  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 98  Line 118 
118    
119  =item 4  =item 4
120    
121  In the C<SearchSkeleton.cgi> script, add a C<use> statement for your search tool  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.
 and then put the class name in the C<@advancedClasses> list.  
122    
123  =back  =back
124    
# Line 139  Line 158 
158    
159  =item 1  =item 1
160    
161  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes.  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
162    L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
163    name. Note that as an assist to people working with GET-style links, if no
164    genomes are specified and the incoming request style is GET, all genomes will
165    be returned.
166    
167  =item 2  =item 2
168    
# Line 158  Line 181 
181    
182  =back  =back
183    
184    If you are doing a feature search, you can also change the list of feature
185    columns displayed and their display order by overriding
186    L</DefaultFeatureColumns>.
187    
188  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
189  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
190    
# Line 195  Line 222 
222                      }                      }
223                  }                  }
224              }              }
         }  
225          # Close the session file.          # Close the session file.
226          $self->CloseSession();          $self->CloseSession();
227            }
228          # Return the result count.          # Return the result count.
229          return $retVal;          return $retVal;
230      }      }
231    
232  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
233  are variations on the above them. For example, you could eschew feature filtering  are variations on the above theme. For example, you could eschew feature filtering
234  entirely in favor of your own custom filtering, you could include extra columns  entirely in favor of your own custom filtering, you could include extra columns
235  in the output, or you could search for something that's not a feature at all. The  in the output, or you could search for something that's not a feature at all. The
236  above code is just a loose framework.  above code is just a loose framework.
237    
238    In addition to the finding and filtering, it is necessary to send status messages
239    to the output so that the user does not get bored waiting for results. The L</PrintLine>
240    method performs this function. The single parameter should be text to be
241    output to the browser. In general, you'll invoke it as follows.
242    
243        $self->PrintLine("...my message text...<br />");
244    
245    The break tag is optional. When the Find method gets control, a paragraph will
246    have been started so that everything is XHTML-compliant.
247    
248  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>
249  method of the feature query object.  method of the feature query object.
250    
# Line 218  Line 255 
255  by calling L</SetMessage>. If the parameters are valid, then the method must return  by calling L</SetMessage>. If the parameters are valid, then the method must return
256  the number of items found.  the number of items found.
257    
 =head2 Virtual Methods  
   
 =head3 Form  
   
 C<< my $html = $shelp->Form(); >>  
   
 Generate the HTML for a form to request a new search.  
   
 =head3 Find  
   
 C<< my $resultCount = $shelp->Find(); >>  
   
 Conduct a search based on the current CGI query parameters. The search results will  
 be written to the session cache file and the number of results will be  
 returned. If the search parameters are invalid, a result count of C<undef> will be  
 returned and a result message will be stored in this object describing the problem.  
   
 =head3 Description  
   
 C<< my $htmlText = $shelp->Description(); >>  
   
 Return a description of this search. The description is used for the table of contents  
 on the main search tools page. It may contain HTML, but it should be character-level,  
 not block-level, since the description is going to appear in a list.  
   
258  =cut  =cut
259    
260  # 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.
261  my $formCount = 0;  my $formCount = 0;
262    # This counter is used to generate unique DIV IDs.
263    my $divCount = 0;
264    
265  =head2 Public Methods  =head2 Public Methods
266    
267  =head3 new  =head3 new
268    
269  C<< my $shelp = SearchHelper->new($query); >>  C<< my $shelp = SearchHelper->new($cgi); >>
270    
271  Construct a new SearchHelper object.  Construct a new SearchHelper object.
272    
273  =over 4  =over 4
274    
275  =item query  =item cgi
276    
277  The CGI query object for the current script.  The CGI query object for the current script.
278    
# Line 268  Line 282 
282    
283  sub new {  sub new {
284      # Get the parameters.      # Get the parameters.
285      my ($class, $query) = @_;      my ($class, $cgi) = @_;
286      # Check for a session ID.      # Check for a session ID.
287      my $session_id = $query->param("SessionID");      my $session_id = $cgi->param("SessionID");
288      my $type = "old";      my $type = "old";
289      if (! $session_id) {      if (! $session_id) {
290            Trace("No session ID found.") if T(3);
291          # Here we're starting a new session. We create the session ID and          # Here we're starting a new session. We create the session ID and
292          # store it in the query object.          # store it in the query object.
293          $session_id = NewSessionID();          $session_id = NewSessionID();
294          $type = "new";          $type = "new";
295          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
296        } else {
297            Trace("Session ID is $session_id.") if T(3);
298      }      }
299      # Compute the subclass name.      # Compute the subclass name.
300      $class =~ /SH(.+)$/;      my $subClass;
301      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
302            # Here we have a real search class.
303            $subClass = $1;
304        } else {
305            # Here we have a bare class. The bare class cannot search, but it can
306            # process search results.
307            $subClass = 'SearchHelper';
308        }
309      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
310      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
311      # Generate the form name.      # Generate the form name.
312      my $formName = "$class$formCount";      my $formName = "$class$formCount";
313      $formCount++;      $formCount++;
# Line 291  Line 315 
315      # as well as an indicator as to whether or not the session is new, plus the      # as well as an indicator as to whether or not the session is new, plus the
316      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
317      my $retVal = {      my $retVal = {
318                    query => $query,                    query => $cgi,
319                    type => $type,                    type => $type,
320                    class => $subClass,                    class => $subClass,
321                    sprout => undef,                    sprout => undef,
322                    orgs => {},                    orgs => {},
323                    name => $formName,                    name => $formName,
324                    scriptQueue => [],                    scriptQueue => [],
325                      genomeList => undef,
326                      genomeParms => [],
327                      filtered => 0,
328                      extraPos => 0,
329                   };                   };
330      # Bless and return it.      # Bless and return it.
331      bless $retVal, $class;      bless $retVal, $class;
# Line 319  Line 347 
347      return $self->{query};      return $self->{query};
348  }  }
349    
350    
351    
352  =head3 DB  =head3 DB
353    
354  C<< my $sprout = $shelp->DB(); >>  C<< my $sprout = $shelp->DB(); >>
# Line 356  Line 386 
386      return ($self->{type} eq 'new');      return ($self->{type} eq 'new');
387  }  }
388    
389    =head3 SetExtraPos
390    
391    C<< $shelp->SetExtraPos($newValue); >>
392    
393    Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.
394    
395    =over 4
396    
397    =item newValue
398    
399    C<1> if the extra columns should be displayed at the end, else C<0>.
400    
401    =back
402    
403    =cut
404    
405    sub SetExtraPos {
406        my ($self, $newValue) = @_;
407        $self->{extraPos} = $newValue;
408    }
409    
410  =head3 ID  =head3 ID
411    
412  C<< my $sessionID = $shelp->ID(); >>  C<< my $sessionID = $shelp->ID(); >>
# Line 450  Line 501 
501      my ($self, $title) = @_;      my ($self, $title) = @_;
502      # Get the CGI object.      # Get the CGI object.
503      my $cgi = $self->Q();      my $cgi = $self->Q();
504      # Start the form.      # Start the form. Note we use the override option on the Class value, in
505        # case the Advanced button was used.
506      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
507                   $cgi->start_form(-method => 'POST',                   $cgi->start_form(-method => 'POST',
508                                    -action => $cgi->url(-relative => 1),                                    -action => $cgi->url(-relative => 1),
509                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
510                   $cgi->hidden(-name => 'Class',                   $cgi->hidden(-name => 'Class',
511                                -value => $self->{class}) .                                -value => $self->{class},
512                                  -override => 1) .
513                   $cgi->hidden(-name => 'SPROUT',                   $cgi->hidden(-name => 'SPROUT',
514                                -value => 1) .                                -value => 1) .
515                   $cgi->h3($title);                   $cgi->h3($title);
# Line 610  Line 663 
663    
664  =head3 PutFeature  =head3 PutFeature
665    
666  C<< $shelp->PutFeature($fquery); >>  C<< $shelp->PutFeature($fdata); >>
667    
668  Store a feature in the result cache. This is the workhorse method for most  Store a feature in the result cache. This is the workhorse method for most
669  searches, since the primary data item in the database is features.  searches, since the primary data item in the database is features.
# Line 621  Line 674 
674  the feature query object using the B<AddExtraColumns> method. For example, the following  the feature query object using the B<AddExtraColumns> method. For example, the following
675  code adds columns for essentiality and virulence.  code adds columns for essentiality and virulence.
676    
677      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
678      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
679    
680  For correct results, all values should be specified for all extra columns in all calls to  For correct results, all values should be specified for all extra columns in all calls to
681  B<PutFeature>. (In particular, the column header names are computed on the first  B<PutFeature>. (In particular, the column header names are computed on the first
# Line 632  Line 685 
685      if (! $essentialFlag) {      if (! $essentialFlag) {
686          $essentialFlag = undef;          $essentialFlag = undef;
687      }      }
688      $fq->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);      $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);
689      $shelp->PutFeature($fq);      $shelp->PutFeature($fd);
690    
691  =over 4  =over 4
692    
693  =item fquery  =item fdata
694    
695  FeatureQuery object containing the current feature data.  B<FeatureData> object containing the current feature data.
696    
697  =back  =back
698    
# Line 647  Line 700 
700    
701  sub PutFeature {  sub PutFeature {
702      # Get the parameters.      # Get the parameters.
703      my ($self, $fq) = @_;      my ($self, $fd) = @_;
704        # Get the CGI query object.
705        my $cgi = $self->Q();
706      # Get the feature data.      # Get the feature data.
707      my $record = $fq->Feature();      my $record = $fd->Feature();
708      my $extraCols = $fq->ExtraCols();      my $extraCols = $fd->ExtraCols();
709      # Check for a first-call situation.      # Check for a first-call situation.
710      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
711          # Here we need to set up the column information. Start with the defaults.          Trace("Setting up the columns.") if T(3);
712          $self->{cols} = $self->DefaultFeatureColumns();          # Tell the user what's happening.
713          # Append the extras, sorted by column name.          $self->PrintLine("Creating output columns.<br />");
714            # Here we need to set up the column information. First we accumulate the extras,
715            # sorted by column name.
716            my @xtraNames = ();
717          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
718              push @{$self->{cols}}, "X=$col";              push @xtraNames, "X=$col";
719          }          }
720          # Write out the column headers. This also prepares the cache file to receive          # Set up the column name array.
721            my @colNames = ();
722            # If extras go at the beginning, put them in first.
723            if (! $self->{extraPos}) {
724                push @colNames, @xtraNames;
725            }
726            # Add the default columns.
727            push @colNames, $self->DefaultFeatureColumns();
728            # Add any additional columns requested by the feature filter.
729            push @colNames, FeatureQuery::AdditionalColumns($self);
730            # If extras go at the end, put them in here.
731            if ($self->{extraPos}) {
732                push @colNames, @xtraNames;
733            }
734            Trace("Full column list determined.") if T(3);
735            # Save the full list.
736            $self->{cols} = \@colNames;
737            # Write out the column names. This also prepares the cache file to receive
738          # output.          # output.
739          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          Trace("Writing column headers.") if T(3);
740            $self->WriteColumnHeaders(@{$self->{cols}});
741            Trace("Column headers written.") if T(3);
742      }      }
743      # Get the feature ID.      # Get the feature ID.
744      my ($fid) = $record->Value('Feature(id)');      my $fid = $fd->FID();
745      # Loop through the column headers, producing the desired data.      # Loop through the column headers, producing the desired data.
746      my @output = ();      my @output = ();
747      for my $colName (@{$self->{cols}}) {      for my $colName (@{$self->{cols}}) {
748          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);          push @output, $self->FeatureColumnValue($colName, $record, $extraCols);
749      }      }
750      # Compute the sort key. The sort key floats NMPDR organism features to the      # Compute the sort key. The sort key usually floats NMPDR organism features to the
751      # top of the return list.      # top of the return list.
752      my $group = $self->FeatureGroup($fid);      my $key = $self->SortKey($fd);
     my $key = ($group ? "A$group" : "ZZ");  
753      # Write the feature data.      # Write the feature data.
754      $self->WriteColumnData($key, @output);      $self->WriteColumnData($key, @output);
755  }  }
# Line 754  Line 830 
830      # Check for an open session file.      # Check for an open session file.
831      if (defined $self->{fileHandle}) {      if (defined $self->{fileHandle}) {
832          # We found one, so close it.          # We found one, so close it.
833            Trace("Closing session file.") if T(2);
834          close $self->{fileHandle};          close $self->{fileHandle};
835            # Tell the user.
836            my $cgi = $self->Q();
837            $self->PrintLine("Output formatting complete.<br />");
838      }      }
839  }  }
840    
# Line 771  Line 851 
851      my $retVal;      my $retVal;
852      # Get a digest encoder.      # Get a digest encoder.
853      my $md5 = Digest::MD5->new();      my $md5 = Digest::MD5->new();
854      # If we have a randomization file, use it to seed the digester.      # Add the PID, the IP, and the time stamp. Note that the time stamp is
855      if (open(R, "/dev/urandom")) {      # actually two numbers, and we get them both because we're in list
856          my $b;      # context.
857          read(R, $b, 1024);      $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());
858          $md5->add($b);      # Hash up all this identifying data.
859      }      $retVal = $md5->hexdigest();
860      # Add the PID and the time stamp.      # Return the result.
     $md5->add($$, gettimeofday);  
     # Hash it up and clean the result so that it works as a file name.  
     $retVal = $md5->b64digest();  
     $retVal =~ s,/,\$,g;  
     $retVal =~ s,\+,@,g;  
     # Return it.  
861      return $retVal;      return $retVal;
862  }  }
863    
# Line 827  Line 901 
901                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
902                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
903                                                       'Genome(primary-group)']);                                                       'Genome(primary-group)']);
904          # Null out the supporting group.          # Format and cache the name and display group.
905          $group = "" if ($group eq $FIG_Config::otherGroup);          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
906          # If the organism does not exist, format an unknown name.                                                              $strain);
         if (! defined($genus)) {  
             $orgName = "Unknown Genome $genomeID";  
         } else {  
             # It does exist, so format the organism name.  
             $orgName = "$genus $species";  
             if ($strain) {  
                 $orgName .= " $strain";  
             }  
         }  
         # Save this organism in the cache.  
         $cache->{$genomeID} = [$orgName, $group];  
907      }      }
908      # Return the result.      # Return the result.
909      return ($orgName, $group);      return ($orgName, $group);
# Line 942  Line 1005 
1005      } else {      } else {
1006          # Here we can get its genome data.          # Here we can get its genome data.
1007          $retVal = $self->Organism($genomeID);          $retVal = $self->Organism($genomeID);
1008          # Append the type and number.          # Append the FIG ID.
1009          $retVal .= " [$type $num]";          $retVal .= " [$fid]";
1010      }      }
1011      # Return the result.      # Return the result.
1012      return $retVal;      return $retVal;
# Line 951  Line 1014 
1014    
1015  =head3 ComputeFASTA  =head3 ComputeFASTA
1016    
1017  C<< my $fasta = $shelp->ComputeFASTA($incomingType, $desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>
1018    
1019  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.
 that it is possible to convert a DNA sequence into a protein sequence, but the reverse  
 is not possible.  
1020    
1021  =over 4  =over 4
1022    
 =item incomingType  
   
 C<dna> if this is a DNA sequence, C<prot> if this is a protein sequence.  
   
1023  =item desiredType  =item desiredType
1024    
1025  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.
 I<$incomingType> is C<prot> and this value is C<dna>, an error will be thrown.  
1026    
1027  =item sequence  =item sequence
1028    
# Line 988  Line 1044 
1044    
1045  sub ComputeFASTA {  sub ComputeFASTA {
1046      # Get the parameters.      # Get the parameters.
1047      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence) = @_;
1048      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
1049      my $retVal;      my $retVal;
1050        # This variable will be cleared if an error is detected.
1051        my $okFlag = 1;
1052      # Create variables to hold the FASTA label and data.      # Create variables to hold the FASTA label and data.
1053      my ($fastaLabel, $fastaData);      my ($fastaLabel, $fastaData);
1054        Trace("FASTA desired type is $desiredType.") if T(4);
1055      # Check for a feature specification.      # Check for a feature specification.
1056      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
1057          # 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
1058          # it.          # it.
1059          my $fid = $1;          my $fid = $1;
1060            Trace("Feature ID for fasta is $fid.") if T(3);
1061          my $sprout = $self->DB();          my $sprout = $self->DB();
1062          # Get the FIG ID. Note that we only use the first feature found. We are not          # Get the FIG ID. Note that we only use the first feature found. We are not
1063          # supposed to have redundant aliases, though we may have an ID that doesn't          # supposed to have redundant aliases, though we may have an ID that doesn't
1064          # exist.          # exist.
1065          my ($figID) = $sprout->FeaturesByAlias($fid);          my ($figID) = $sprout->FeaturesByAlias($fid);
1066          if (! $figID) {          if (! $figID) {
1067              $self->SetMessage("No feature found with the ID \"$fid\".");              $self->SetMessage("No gene found with the ID \"$fid\".");
1068                $okFlag = 0;
1069          } else {          } else {
1070              # Set the FASTA label.              # Set the FASTA label.
1071              my $fastaLabel = $fid;              my $fastaLabel = $fid;
1072              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
1073              if ($desiredType =~ /prot/i) {              if ($desiredType eq 'prot') {
1074                  # We want protein, so get the translation.                  # We want protein, so get the translation.
1075                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
1076                    Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
1077              } else {              } else {
1078                  # 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.
1079                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
1080                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
1081                    Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);
1082              }              }
1083          }          }
     } elsif ($incomingType =~ /prot/ && $desiredType =~ /dna/) {  
         # Here we're being asked to do an impossible conversion.  
         $self->SetMessage("Cannot convert a protein sequence to DNA.");  
1084      } else {      } else {
1085            Trace("Analyzing FASTA sequence.") if T(4);
1086          # 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.
1087          if ($sequence =~ /^>\s*(\S.*)\s*\n(.+)$/) {          if ($sequence =~ /^>[\n\s]*(\S[^\n]*)\n(.+)$/s) {
1088                Trace("Label \"$1\" found in match to sequence:\n$sequence") if T(4);
1089              # Here we have a label, so we split it from the data.              # Here we have a label, so we split it from the data.
1090              $fastaLabel = $1;              $fastaLabel = $1;
1091              $fastaData = $2;              $fastaData = $2;
1092          } else {          } else {
1093                Trace("No label found in match to sequence:\n$sequence") if T(4);
1094              # 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
1095              # as data.              # as data.
1096              $fastaLabel = "User-specified $incomingType sequence";              $fastaLabel = "User-specified $desiredType sequence";
1097              $fastaData = $sequence;              $fastaData = $sequence;
1098          }          }
1099          # The next step is to clean the junk out of the sequence.          # The next step is to clean the junk out of the sequence.
1100          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1101          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1102          # Finally, if the user wants to convert to protein, we do it here. Note that          # Finally, verify that it's DNA if we're doing DNA stuff.
1103          # we've already prevented a conversion from protein to DNA.          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {
1104          if ($incomingType ne $desiredType) {              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
1105              $fastaData = Sprout::Protein($fastaData);              $okFlag = 0;
1106          }          }
1107      }      }
1108      # At this point, either "$fastaLabel" and "$fastaData" have values or an error is      Trace("FASTA data sequence: $fastaData") if T(4);
1109      # in progress.      # Only proceed if no error was detected.
1110      if (defined $fastaLabel) {      if ($okFlag) {
1111          # 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
1112          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
1113          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
1114          # the empty list items that appear between the so-called delimiters, since          # the empty list items that appear between the so-called delimiters, since
1115          # the delimiters are what we want.          # the delimiters are what we want.
1116          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
1117          my $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
1118      }      }
1119      # Return the result.      # Return the result.
1120      return $retVal;      return $retVal;
1121  }  }
1122    
1123    =head3 SubsystemTree
1124    
1125    C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>
1126    
1127    This method creates a subsystem selection tree suitable for passing to
1128    L</SelectionTree>. Each leaf node in the tree will have a link to the
1129    subsystem display page. In addition, each node can have a radio button. The
1130    radio button alue is either C<classification=>I<string>, where I<string> is
1131    a classification string, or C<id=>I<string>, where I<string> is a subsystem ID.
1132    Thus, it can either be used to filter by a group of related subsystems or a
1133    single subsystem.
1134    
1135    =over 4
1136    
1137    =item sprout
1138    
1139    Sprout database object used to get the list of subsystems.
1140    
1141    =item options
1142    
1143    Hash containing options for building the tree.
1144    
1145    =item RETURN
1146    
1147    Returns a reference to a tree list suitable for passing to L</SelectionTree>.
1148    
1149    =back
1150    
1151    The supported options are as follows.
1152    
1153    =over 4
1154    
1155    =item radio
1156    
1157    TRUE if the tree should be configured for radio buttons. The default is FALSE.
1158    
1159    =item links
1160    
1161    TRUE if the tree should be configured for links. The default is TRUE.
1162    
1163    =back
1164    
1165    =cut
1166    
1167    sub SubsystemTree {
1168        # Get the parameters.
1169        my ($sprout, %options) = @_;
1170        # Process the options.
1171        my $optionThing = Tracer::GetOptions({ radio => 0, links => 1 }, \%options);
1172        # Read in the subsystems.
1173        my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1174                                   ['Subsystem(classification)', 'Subsystem(id)']);
1175        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1176        # is at the end, ALL subsystems are unclassified and we don't bother.
1177        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1178            while ($subs[0]->[0] eq '') {
1179                my $classLess = shift @subs;
1180                push @subs, $classLess;
1181            }
1182        }
1183        # Declare the return variable.
1184        my @retVal = ();
1185        # Each element in @subs represents a leaf node, so as we loop through it we will be
1186        # producing one leaf node at a time. The leaf node is represented as a 2-tuple. The
1187        # first element is a semi-colon-delimited list of the classifications for the
1188        # subsystem. There will be a stack of currently-active classifications, which we will
1189        # compare to the incoming classifications from the end backward. A new classification
1190        # requires starting a new branch. A different classification requires closing an old
1191        # branch and starting a new one. Each classification in the stack will also contain
1192        # that classification's current branch. We'll add a fake classification at the
1193        # beginning that we can use to represent the tree as a whole.
1194        my $rootName = '<root>';
1195        # Create the classification stack. Note the stack is a pair of parallel lists,
1196        # one containing names and the other containing content.
1197        my @stackNames = ($rootName);
1198        my @stackContents = (\@retVal);
1199        # Add a null entry at the end of the subsystem list to force an unrolling.
1200        push @subs, ['', undef];
1201        # Loop through the subsystems.
1202        for my $sub (@subs) {
1203            # Pull out the classification list and the subsystem ID.
1204            my ($classString, $id) = @{$sub};
1205            Trace("Processing class \"$classString\" and subsystem $id.") if T(4);
1206            # Convert the classification string to a list with the root classification in
1207            # the front.
1208            my @classList = ($rootName, split($FIG_Config::splitter, $classString));
1209            # Find the leftmost point at which the class list differs from the stack.
1210            my $matchPoint = 0;
1211            while ($matchPoint <= $#stackNames && $matchPoint <= $#classList &&
1212                   $stackNames[$matchPoint] eq $classList[$matchPoint]) {
1213                $matchPoint++;
1214            }
1215            Trace("Match point is $matchPoint. Stack length is " . scalar(@stackNames) .
1216                  ". Class List length is " . scalar(@classList) . ".") if T(4);
1217            # Unroll the stack to the matchpoint.
1218            while ($#stackNames >= $matchPoint) {
1219                my $popped = pop @stackNames;
1220                pop @stackContents;
1221                Trace("\"$popped\" popped from stack.") if T(4);
1222            }
1223            # Start branches for any new classifications.
1224            while ($#stackNames < $#classList) {
1225                # The branch for a new classification contains its radio button
1226                # data and then a list of children. So, at this point, if radio buttons
1227                # are desired, we put them into the content.
1228                my $newLevel = scalar(@stackNames);
1229                my @newClassContent = ();
1230                if ($optionThing->{radio}) {
1231                    my $newClassString = join($FIG_Config::splitter, @classList[1..$newLevel]);
1232                    push @newClassContent, { value => "classification=$newClassString%" };
1233                }
1234                # The new classification node is appended to its parent's content
1235                # and then pushed onto the stack. First, we need the node name.
1236                my $nodeName = $classList[$newLevel];
1237                # Add the classification to its parent. This makes it part of the
1238                # tree we'll be returning to the user.
1239                push @{$stackContents[$#stackNames]}, $nodeName, \@newClassContent;
1240                # Push the classification onto the stack.
1241                push @stackContents, \@newClassContent;
1242                push @stackNames, $nodeName;
1243                Trace("\"$nodeName\" pushed onto stack.") if T(4);
1244            }
1245            # Now the stack contains all our parent branches. We add the subsystem to
1246            # the branch at the top of the stack, but only if it's NOT the dummy node.
1247            if (defined $id) {
1248                # Compute the node name from the ID.
1249                my $nodeName = $id;
1250                $nodeName =~ s/_/ /g;
1251                # Create the node's leaf hash. This depends on the value of the radio
1252                # and link options.
1253                my $nodeContent = {};
1254                if ($optionThing->{links}) {
1255                    # Compute the link value.
1256                    my $linkable = uri_escape($id);
1257                    $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;show_clusters=1;SPROUT=1";
1258                }
1259                if ($optionThing->{radio}) {
1260                    # Compute the radio value.
1261                    $nodeContent->{value} = "id=$id";
1262                }
1263                # Push the node into its parent branch.
1264                Trace("\"$nodeName\" added to node list.") if T(4);
1265                push @{$stackContents[$#stackNames]}, $nodeName, $nodeContent;
1266            }
1267        }
1268        # Return the result.
1269        return \@retVal;
1270    }
1271    
1272    
1273  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1274    
1275  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, \%options, \@selected); >>  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>
1276    
1277  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The
1278  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it
# Line 1071  Line 1284 
1284    
1285  Name to give to the menu.  Name to give to the menu.
1286    
1287  =item options  =item multiple
1288    
1289  Reference to a hash containing the options to be applied to the C<SELECT> tag form the menu.  TRUE if the user is allowed to select multiple genomes, else FALSE.
 Typical options would include C<multiple> to specify  
 that multiple selections are allowed and C<size> to set the number of rows to display  
 in the menu.  
1290    
1291  =item selected  =item selected
1292    
# Line 1084  Line 1294 
1294  is not intended to allow multiple selections, the list should be a singleton. If the  is not intended to allow multiple selections, the list should be a singleton. If the
1295  list is empty, nothing will be pre-selected.  list is empty, nothing will be pre-selected.
1296    
1297    =item rows (optional)
1298    
1299    Number of rows to display. If omitted, the default is 1 for a single-select list
1300    and 10 for a multi-select list.
1301    
1302    =item crossMenu (optional)
1303    
1304    If specified, is presumed to be the name of another genome menu whose contents
1305    are to be mutually exclusive with the contents of this menu. As a result, instead
1306    of the standard onChange event, the onChange event will deselect any entries in
1307    the other menu.
1308    
1309  =item RETURN  =item RETURN
1310    
1311  Returns the HTML text to generate a C<SELECT> menu inside a form.  Returns the HTML text to generate a C<SELECT> menu inside a form.
# Line 1094  Line 1316 
1316    
1317  sub NmpdrGenomeMenu {  sub NmpdrGenomeMenu {
1318      # Get the parameters.      # Get the parameters.
1319      my ($self, $menuName, $options, $selected) = @_;      my ($self, $menuName, $multiple, $selected, $rows, $cross) = @_;
1320      # Get the Sprout and CGI objects.      # Get the Sprout and CGI objects.
1321      my $sprout = $self->DB();      my $sprout = $self->DB();
1322      my $cgi = $self->Q();      my $cgi = $self->Q();
1323        # Compute the row count.
1324        if (! defined $rows) {
1325            $rows = ($multiple ? 10 : 1);
1326        }
1327        # Create the multiple tag.
1328        my $multipleTag = ($multiple ? " multiple" : "");
1329      # Get the form name.      # Get the form name.
1330      my $formName = $self->FormName();      my $formName = $self->FormName();
1331        # Check to see if we already have a genome list in memory.
1332        my $genomes = $self->{genomeList};
1333        my $groupHash;
1334        if (defined $genomes) {
1335            # We have a list ready to use.
1336            $groupHash = $genomes;
1337        } else {
1338      # 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
1339      # 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
1340      # take advantage of an existing index.      # take advantage of an existing index.
# Line 1111  Line 1346 
1346      # 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
1347      # 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
1348      # name.      # name.
1349      my %groupHash = ();          my %gHash = ();
1350      for my $genome (@genomeList) {      for my $genome (@genomeList) {
1351          # Get the genome data.          # Get the genome data.
1352          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};          my ($group, $genomeID, $genus, $species, $strain) = @{$genome};
1353          # Form the genome name.              # Compute and cache its name and display group.
1354          my $name = "$genus $species";              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1355          if ($strain) {                                                                  $strain);
1356              $name .= " $strain";              # Push the genome into the group's list. Note that we use the real group
1357          }              # name here, not the display group name.
1358          # Push the genome into the group's list.              push @{$gHash{$group}}, [$genomeID, $name];
1359          push @{$groupHash{$group}}, [$genomeID, $name];          }
1360            # Save the genome list for future use.
1361            $self->{genomeList} = \%gHash;
1362            $groupHash = \%gHash;
1363      }      }
1364      # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting      # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting
1365      # the supporting-genome group last.      # the supporting-genome group last.
1366      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %groupHash;      my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};
1367      push @groups, $FIG_Config::otherGroup;      push @groups, $FIG_Config::otherGroup;
1368      # Next, create a hash that specifies the pre-selected entries.      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal
1369      my %selectedHash = map { $_ => 1 } @{$selected};      # with the possibility of undefined values in the incoming list.
1370      # Now it gets complicated. We need a way to mark all the NMPDR genomes.      my %selectedHash = ();
1371        if (defined $selected) {
1372            %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};
1373        }
1374        # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage
1375        # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes
1376        # and use that to make the selections.
1377        my $nmpdrCount = 0;
1378      # Create the type counters.      # Create the type counters.
1379      my $groupCount = 1;      my $groupCount = 1;
1380      # Compute the ID for the status display.      # Compute the ID for the status display.
# Line 1138  Line 1383 
1383      my $showSelect = "showSelected($menuName, '$divID', 1000);";      my $showSelect = "showSelected($menuName, '$divID', 1000);";
1384      # If multiple selection is supported, create an onChange event.      # If multiple selection is supported, create an onChange event.
1385      my $onChange = "";      my $onChange = "";
1386      if ($options->{multiple}) {      if ($cross) {
1387            # Here we have a paired menu. Selecting something in our menu unselects it in the
1388            # other and redisplays the status of both.
1389            $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";
1390        } elsif ($multiple) {
1391            # This is an unpaired menu, so all we do is redisplay our status.
1392          $onChange = " onChange=\"$showSelect\"";          $onChange = " onChange=\"$showSelect\"";
1393      }      }
1394      # Create the SELECT tag and stuff it into the output array.      # Create the SELECT tag and stuff it into the output array.
1395      my $select = "<" . join(" ", "SELECT name=\"$menuName\"$onChange", map { " $_=\"$options->{$_}\"" } keys %{$options}) . ">";      my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");
     my @lines = ($select);  
1396      # Loop through the groups.      # Loop through the groups.
1397      for my $group (@groups) {      for my $group (@groups) {
1398          # Create the option group tag.          # Create the option group tag.
1399          my $tag = "<OPTGROUP label=\"$group\">";          my $tag = "<OPTGROUP label=\"$group\">";
1400          push @lines, "  $tag";          push @lines, "  $tag";
         # Compute the label for this group's options. This is seriously dirty stuff, as the  
         # label option may have functionality in future browsers. If that happens, we'll need  
         # to modify the genome text so that the "selectSome" method can tell which are NMPDR  
         # organisms and which aren't. Sadly, the OPTGROUP tag is invisible in the DOM Javascript  
         # hierarchy.  
         my $label = ($group eq $FIG_Config::otherGroup ? "other" : "nmpdr");  
1401          # Get the genomes in the group.          # Get the genomes in the group.
1402          for my $genome (@{$groupHash{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1403                # Count this organism if it's NMPDR.
1404                if ($group ne $FIG_Config::otherGroup) {
1405                    $nmpdrCount++;
1406                }
1407                # Get the organism ID and name.
1408              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name) = @{$genome};
1409              # See if it's selected.              # See if it's selected.
1410              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1411              # Generate the option tag.              # Generate the option tag.
1412              my $optionTag = "<OPTION value=\"$genomeID\" label=\"$label\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1413              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1414          }          }
1415          # Close the option group.          # Close the option group.
# Line 1170  Line 1418 
1418      # Close the SELECT tag.      # Close the SELECT tag.
1419      push @lines, "</SELECT>";      push @lines, "</SELECT>";
1420      # Check for multiple selection.      # Check for multiple selection.
1421      if ($options->{multiple}) {      if ($multiple) {
1422          # Since multi-select is on, we can set up some buttons to set and clear selections.          # Multi-select is on, so we need to add some selection helpers. First is
1423            # the search box. This allows the user to type text and have all genomes containing
1424            # the text selected automatically.
1425            my $searchThingName = "${menuName}_SearchThing";
1426            push @lines, "<br />" .
1427                         "<INPUT type=\"button\" name=\"Search\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .
1428                         "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";
1429            # Next are the buttons to set and clear selections.
1430          push @lines, "<br />";          push @lines, "<br />";
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
1431          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\" />";
1432          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, 'nmpdr'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";
1433          push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, 'other'); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";
1434            push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";
1435          # Add the status display, too.          # Add the status display, too.
1436          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";          push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";
1437          # Queue to update the status display when the form loads. We need to modify the show statement          # Queue to update the status display when the form loads. We need to modify the show statement
# Line 1185  Line 1440 
1440          # in case we decide to twiddle the parameters.          # in case we decide to twiddle the parameters.
1441          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;          $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;
1442          $self->QueueFormScript($showSelect);          $self->QueueFormScript($showSelect);
1443            # Finally, add this parameter to the list of genome parameters. This enables us to
1444            # easily find all the parameters used to select one or more genomes.
1445            push @{$self->{genomeParms}}, $menuName;
1446      }      }
1447      # Assemble all the lines into a string.      # Assemble all the lines into a string.
1448      my $retVal = join("\n", @lines, "");      my $retVal = join("\n", @lines, "");
# Line 1192  Line 1450 
1450      return $retVal;      return $retVal;
1451  }  }
1452    
1453    =head3 PropertyMenu
1454    
1455    C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>
1456    
1457    Generate a property name dropdown menu.
1458    
1459    =over 4
1460    
1461    =item menuName
1462    
1463    Name to give to the menu.
1464    
1465    =item selected
1466    
1467    Value of the property name to pre-select.
1468    
1469    =item force (optional)
1470    
1471    If TRUE, then the user will be forced to choose a property name. If FALSE,
1472    then an additional menu choice will be provided to select nothing.
1473    
1474    =item RETURN
1475    
1476    Returns a dropdown menu box that allows the user to select a property name. An additional
1477    selection entry will be provided for selecting no property name
1478    
1479    =back
1480    
1481    =cut
1482    
1483    sub PropertyMenu {
1484        # Get the parameters.
1485        my ($self, $menuName, $selected, $force) = @_;
1486        # Get the CGI and Sprout objects.
1487        my $sprout = $self->DB();
1488        my $cgi = $self->Q();
1489        # Create the property name list.
1490        my @propNames = ();
1491        if (! $force) {
1492            push @propNames, "";
1493        }
1494        # Get all the property names, putting them after the null choice if one exists.
1495        push @propNames, $sprout->GetChoices('Property', 'property-name');
1496        # Create a menu from them.
1497        my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,
1498                                      -default => $selected);
1499        # Return the result.
1500        return $retVal;
1501    }
1502    
1503  =head3 MakeTable  =head3 MakeTable
1504    
1505  C<< my $htmlText = $shelp->MakeTable(\@rows); >>  C<< my $htmlText = $shelp->MakeTable(\@rows); >>
# Line 1242  Line 1550 
1550    
1551  =head3 SubmitRow  =head3 SubmitRow
1552    
1553  C<< my $htmlText = $shelp->SubmitRow(); >>  C<< my $htmlText = $shelp->SubmitRow($caption); >>
1554    
1555  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1556  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
1557  near the top of the form.  near the top of the form.
1558    
1559    =over 4
1560    
1561    =item caption (optional)
1562    
1563    Caption to be put on the search button. The default is C<Go>.
1564    
1565    =item RETURN
1566    
1567    Returns a table row containing the controls for submitting the search
1568    and tuning the results.
1569    
1570    =back
1571    
1572  =cut  =cut
1573    
1574  sub SubmitRow {  sub SubmitRow {
1575      # Get the parameters.      # Get the parameters.
1576      my ($self) = @_;      my ($self, $caption) = @_;
1577      my $cgi = $self->Q();      my $cgi = $self->Q();
1578      # Declare the return variable.      # Compute the button caption.
1579        my $realCaption = (defined $caption ? $caption : 'Go');
1580        # Get the current page size.
1581        my $pageSize = $cgi->param('PageSize');
1582        # Get the incoming external-link flag.
1583        my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);
1584        # Create the row.
1585      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1586                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1587                                                      -values => [10, 25, 45, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1588                                                      -default => $cgi->param('PageSize'))),                                                      -default => $pageSize)),
1589                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1590                                                  -name => 'Search',                                                  -name => 'Search',
1591                                                  -value => 'Go')));                                                  -value => $realCaption)));
1592      # Return the result.      # Return the result.
1593      return $retVal;      return $retVal;
1594  }  }
1595    
1596  =head3 FeatureFilterRows  =head3 FeatureFilterRows
1597    
1598  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(@subset); >>
1599    
1600    This method creates table rows that can be used to filter features. The form
1601    values can be used to select features by genome using the B<FeatureQuery>
1602    object.
1603    
1604    =over 4
1605    
1606    =item subset
1607    
1608    List of rows to display. The default (C<all>) is to display all rows.
1609    C<words> displays the word search box, C<subsys> displays the subsystem
1610    selector, and C<options> displays the options row.
1611    
1612    =item RETURN
1613    
1614    Returns the html text for table rows containing the desired feature filtering controls.
1615    
1616  This method creates table rows that can be used to filter features. There are  =back
 two rows returned, and the values can be used to select features by genome  
 using the B<FeatureQuery> object.  
1617    
1618  =cut  =cut
1619    
1620  sub FeatureFilterRows {  sub FeatureFilterRows {
1621      # Get the parameters.      # Get the parameters.
1622      my ($self) = @_;      my ($self, @subset) = @_;
1623        if (@subset == 0 || $subset[0] eq 'all') {
1624            @subset = qw(words subsys options);
1625        }
1626      # Return the result.      # Return the result.
1627      return FeatureQuery::FilterRows($self);      return FeatureQuery::FilterRows($self, @subset);
1628  }  }
1629    
1630  =head3 GBrowseFeatureURL  =head3 GBrowseFeatureURL
# Line 1322  Line 1666 
1666          # Get the feature location string.          # Get the feature location string.
1667          my $loc = $sprout->FeatureLocation($feat);          my $loc = $sprout->FeatureLocation($feat);
1668          # Compute the contig, start, and stop points.          # Compute the contig, start, and stop points.
1669          my($start, $stop, $contig) = BasicLocation::Parse($loc);          my($contig, $start, $stop) = BasicLocation::Parse($loc);
1670            Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1671          # Now we need to do some goofiness to insure that the location is not too          # Now we need to do some goofiness to insure that the location is not too
1672          # big and that we get some surrounding stuff.          # big and that we get some surrounding stuff.
1673          my $mid = int(($start + $stop) / 2);          my $mid = int(($start + $stop) / 2);
# Line 1352  Line 1697 
1697          }          }
1698          my $seg_id = $contig;          my $seg_id = $contig;
1699          $seg_id =~ s/:/--/g;          $seg_id =~ s/:/--/g;
1700            Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1701          # Assemble all the pieces.          # Assemble all the pieces.
1702          $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id&start=$show_start&stop=$show_stop";          $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id;start=$show_start;stop=$show_stop";
1703      }      }
1704      # Return the result.      # Return the result.
1705      return $retVal;      return $retVal;
1706  }  }
1707    
1708  =head2 Feature Column Methods  =head3 GetGenomes
1709    
1710  The methods in this column manage feature column data. If you want to provide the  C<< my @genomeList = $shelp->GetGenomes($parmName); >>
 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.  
1711    
1712  There is one special column name syntax for extra columns (that is, nonstandard  Return the list of genomes specified by the specified CGI query parameter.
1713  feature columns). If the column name begins with C<X=>, then it is presumed to be  If the request method is POST, then the list of genome IDs is returned
1714  an extra column. The column title is the text after the C<X=>, and its value is  without preamble. If the request method is GET and the parameter is not
1715  pulled from the extra column hash.  specified, then it is treated as a request for all genomes. This makes it
1716    easier for web pages to link to a search that wants to specify all genomes.
1717    
1718  =head3 DefaultFeatureColumns  =over 4
1719    
1720    =item parmName
1721    
1722    Name of the parameter containing the list of genomes. This will be the
1723    first parameter passed to the L</NmpdrGenomeMenu> call that created the
1724    genome selection control on the form.
1725    
1726  C<< my $colNames = $shelp->DefaultFeatureColumns(); >>  =item RETURN
1727    
1728    Returns a list of the genomes to process.
1729    
1730  Return a reference to a list of the default feature column identifiers. These  =back
 identifiers can be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in  
 order to produce the column titles and row values.  
1731    
1732  =cut  =cut
1733    
1734  sub DefaultFeatureColumns {  sub GetGenomes {
1735        # Get the parameters.
1736        my ($self, $parmName) = @_;
1737        # Get the CGI query object.
1738        my $cgi = $self->Q();
1739        # Get the list of genome IDs in the request header.
1740        my @retVal = $cgi->param($parmName);
1741        Trace("Genome list for $parmName is (" . join(", ", @retVal) . ") with method " . $cgi->request_method() . ".") if T(3);
1742        # Check for the special GET case.
1743        if ($cgi->request_method() eq "GET" && ! @retVal) {
1744            # Here the caller wants all the genomes.
1745            my $sprout = $self->DB();
1746            @retVal = $sprout->Genomes();
1747        }
1748        # Return the result.
1749        return @retVal;
1750    }
1751    
1752    =head3 GetHelpText
1753    
1754    C<< my $htmlText = $shelp->GetHelpText(); >>
1755    
1756    Get the help text for this search. The help text is stored in files on the template
1757    server. The help text for a specific search is taken from a file named
1758    C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1759    There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1760    feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>
1761    describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1762    describes the standard controls for a search, such as page size, URL display, and
1763    external alias display.
1764    
1765    =cut
1766    
1767    sub GetHelpText {
1768      # Get the parameters.      # Get the parameters.
1769      my ($self) = @_;      my ($self) = @_;
1770        # Create a list to hold the pieces of the help.
1771        my @helps = ();
1772        # Get the template directory URL.
1773        my $urlBase = $FIG_Config::template_url;
1774        # Start with the specific help.
1775        my $class = $self->{class};
1776        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");
1777        # Add the genome control help if needed.
1778        if (scalar @{$self->{genomeParms}}) {
1779            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");
1780        }
1781        # Next the filter help.
1782        if ($self->{filtered}) {
1783            push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");
1784        }
1785        # Finally, the standard help.
1786        push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");
1787        # Assemble the pieces.
1788        my $retVal = join("\n<p>&nbsp;</p>\n", @helps);
1789      # Return the result.      # Return the result.
1790      return ['orgName', 'function', 'gblink', 'protlink'];      return $retVal;
1791  }  }
1792    
1793  =head3 FeatureColumnTitle  =head3 ComputeSearchURL
1794    
1795  C<< my $title = $shelp->FeatureColumnTitle($colName); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1796    
1797  Return the column heading title to be used for the specified feature column.  Compute the GET-style URL for the current search. In order for this to work, there
1798    must be a copy of the search form on the current page. This will always be the
1799    case if the search is coming from C<SearchSkeleton.cgi>.
1800    
1801    A little expense is involved in order to make the URL as smart as possible. The
1802    main complication is that if the user specified all genomes, we'll want to
1803    remove the parameter entirely from a get-style URL.
1804    
1805  =over 4  =over 4
1806    
1807  =item name  =item overrides
1808    
1809  Name of the desired feature column.  Hash containing override values for the parameters, where the parameter name is
1810    the key and the parameter value is the override value. If the override value is
1811    C<undef>, the parameter will be deleted from the result.
1812    
1813  =item RETURN  =item RETURN
1814    
1815  Returns the title to be used as the column header for the named feature column.  Returns a GET-style URL for invoking the search with the specified overrides.
1816    
1817  =back  =back
1818    
1819  =cut  =cut
1820    
1821  sub FeatureColumnTitle {  sub ComputeSearchURL {
1822      # Get the parameters.      # Get the parameters.
1823      my ($self, $colName) = @_;      my ($self, %overrides) = @_;
1824      # Declare the return variable. We default to a blank column name.      # Get the database and CGI query object.
1825      my $retVal = "&nbsp;";      my $cgi = $self->Q();
1826      # Process the column name.      my $sprout = $self->DB();
1827      if ($colName =~ /^X=(.+)$/) {      # Start with the full URL.
1828          # Here we have an extra column.      my $retVal = $cgi->url(-full => 1);
1829          $retVal = $1;      # Get all the query parameters in a hash.
1830      } elsif ($colName eq 'orgName') {      my %parms = $cgi->Vars();
1831          $retVal = "Name";      # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
1832      } elsif ($colName eq 'fid') {      # characters separating the individual values. We have to convert those to lists. In addition,
1833          $retVal = "FIG ID";      # the multiple-selection genome parameters and the feature type parameter must be checked to
1834      } elsif ($colName eq 'alias') {      # determine whether or not they can be removed from the URL. First, we get a list of the
1835          $retVal = "External Aliases";      # genome parameters and a list of all genomes. Note that we only need the list if a
1836      } elsif ($colName eq 'function') {      # multiple-selection genome parameter has been found on the form.
1837          $retVal = "Functional Assignment";      my %genomeParms = map { $_ => 1 } @{$self->{genomeParms}};
1838      } elsif ($colName eq 'gblink') {      my @genomeList;
1839          $retVal = "GBrowse";      if (keys %genomeParms) {
1840      } elsif ($colName eq 'protlink') {          @genomeList = $sprout->Genomes();
1841          $retVal = "NMPDR Protein Page";      }
1842      } elsif ($colName eq 'group') {      # Create a list to hold the URL parameters we find.
1843          $retVal = "NMDPR Group";      my @urlList = ();
1844        # Now loop through the parameters in the hash, putting them into the output URL.
1845        for my $parmKey (keys %parms) {
1846            # Get a list of the parameter values. If there's only one, we'll end up with
1847            # a singleton list, but that's okay.
1848            my @values = split (/\0/, $parms{$parmKey});
1849            # Check for special cases.
1850            if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1851                # These are bookkeeping parameters we don't need to start a search.
1852                @values = ();
1853            } elsif ($parmKey =~ /_SearchThing$/) {
1854                # Here the value coming in is from a genome control's search thing. It does
1855                # not affect the results of the search, so we clear it.
1856                @values = ();
1857            } elsif ($genomeParms{$parmKey}) {
1858                # Here we need to see if the user wants all the genomes. If he does,
1859                # we erase all the values just like with features.
1860                my $allFlag = $sprout->IsAllGenomes(\@values, \@genomeList);
1861                if ($allFlag) {
1862                    @values = ();
1863                }
1864            } elsif (exists $overrides{$parmKey}) {
1865                # Here the value is being overridden, so we skip it for now.
1866                @values = ();
1867            }
1868            # If we still have values, create the URL parameters.
1869            if (@values) {
1870                push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1871            }
1872        }
1873        # Now do the overrides.
1874        for my $overKey (keys %overrides) {
1875            # Only use this override if it's not a delete marker.
1876            if (defined $overrides{$overKey}) {
1877                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1878            }
1879      }      }
1880        # Add the parameters to the URL.
1881        $retVal .= "?" . join(";", @urlList);
1882      # Return the result.      # Return the result.
1883      return $retVal;      return $retVal;
1884  }  }
1885    
1886  =head3 FeatureColumnValue  =head3 GetRunTimeValue
1887    
1888  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  C<< my $htmlText = $shelp->GetRunTimeValue($text); >>
1889    
1890  Return the value to be displayed in the specified feature column.  Compute a run-time column value.
1891    
1892  =over 4  =over 4
1893    
1894  =item colName  =item text
   
 Name of the column to be displayed.  
   
 =item record  
   
 DBObject record for the feature being displayed in the current row.  
   
 =item extraCols  
1895    
1896  Reference to a hash of extra column names to values. If the incoming column name  The run-time column text. It consists of 2 percent signs, a column type, an equal
1897  begins with C<X=>, its value will be taken from this hash.  sign, and the data for the current row.
1898    
1899  =item RETURN  =item RETURN
1900    
1901  Returns the HTML to be displayed in the named column for the specified feature.  Returns the fully-formatted HTML text to go into the current column of the current row.
1902    
1903  =back  =back
1904    
1905  =cut  =cut
1906    
1907  sub FeatureColumnValue {  sub GetRunTimeValue {
1908      # Get the parameters.      # Get the parameters.
1909      my ($self, $colName, $record, $extraCols) = @_;      my ($self, $text) = @_;
1910      # Get the sprout and CGI objects.      # Declare the return variable.
1911      my $cgi = $self->Q();      my $retVal;
1912      my $sprout = $self->DB();      # Parse the incoming text.
1913      # Get the feature ID.      if ($text =~ /^%%([^=]+)=(.*)$/) {
1914            $retVal = $self->RunTimeColumns($1, $2);
1915        } else {
1916            Confess("Invalid run-time column string \"$text\" encountered in session file.");
1917        }
1918        # Return the result.
1919        return $retVal;
1920    }
1921    
1922    =head3 AdvancedClassList
1923    
1924    C<< my @classes = SearchHelper::AdvancedClassList(); >>
1925    
1926    Return a list of advanced class names. This list is used to generate the directory
1927    of available searches on the search page.
1928    
1929    We use the %INC variable to accomplish this.
1930    
1931    =cut
1932    
1933    sub AdvancedClassList {
1934        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;
1935        return @retVal;
1936    }
1937    
1938    =head3 SelectionTree
1939    
1940    C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>
1941    
1942    Display a selection tree.
1943    
1944    This method creates the HTML for a tree selection control. The tree is implemented as a set of
1945    nested HTML unordered lists. Each selectable element of the tree will contain a radio button. In
1946    addition, some of the tree nodes can contain hyperlinks.
1947    
1948    The tree itself is passed in as a multi-level list containing node names followed by
1949    contents. Each content element is a reference to a similar list. The first element of
1950    each list may be a hash reference. If so, it should contain one or both of the following
1951    keys.
1952    
1953    =over 4
1954    
1955    =item link
1956    
1957    The navigation URL to be popped up if the user clicks on the node name.
1958    
1959    =item value
1960    
1961    The form value to be returned if the user selects the tree node.
1962    
1963    =back
1964    
1965    The presence of a C<link> key indicates the node name will be hyperlinked. The presence of
1966    a C<value> key indicates the node name will have a radio button. If a node has no children,
1967    you may pass it a hash reference instead of a list reference.
1968    
1969    The following example shows the hash for a three-level tree with links on the second level and
1970    radio buttons on the third.
1971    
1972        [   Objects => [
1973                Entities => [
1974                    {link => "../docs/WhatIsAnEntity.html"},
1975                    Genome => {value => 'GenomeData'},
1976                    Feature => {value => 'FeatureData'},
1977                    Contig => {value => 'ContigData'},
1978                ],
1979                Relationships => [
1980                    {link => "../docs/WhatIsARelationShip.html"},
1981                    HasFeature => {value => 'GenomeToFeature'},
1982                    IsOnContig => {value => 'FeatureToContig'},
1983                ]
1984            ]
1985        ]
1986    
1987    Note how each leaf of the tree has a hash reference for its value, while the branch nodes
1988    all have list references.
1989    
1990    This next example shows how to set up a taxonomy selection field. The value returned
1991    by the tree control will be the taxonomy string for the selected node ready for use
1992    in a LIKE-style SQL filter. Only the single branch ending in campylobacter is shown for
1993    reasons of space.
1994    
1995        [   All => [
1996                {value => "%"},
1997                Bacteria => [
1998                    {value => "Bacteria%"},
1999                    Proteobacteria => [
2000                        {value => "Bacteria; Proteobacteria%"},
2001                        Epsilonproteobacteria => [
2002                            {value => "Bacteria; Proteobacteria;Epsilonproteobacteria%"},
2003                            Campylobacterales => [
2004                                {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales%"},
2005                                Campylobacteraceae =>
2006                                    {value => "Bacteria; Proteobacteria; Epsilonproteobacteria; Campylobacterales; Campylobacteraceae%"},
2007                                ...
2008                            ]
2009                            ...
2010                        ]
2011                        ...
2012                    ]
2013                    ...
2014                ]
2015                ...
2016            ]
2017        ]
2018    
2019    
2020    This method of tree storage allows the caller to control the order in which the tree nodes
2021    are displayed and to completely control value selection and use of hyperlinks. It is, however
2022    a bit complicated. Eventually, tree-building classes will be provided to simplify things.
2023    
2024    The parameters to this method are as follows.
2025    
2026    =over 4
2027    
2028    =item cgi
2029    
2030    CGI object used to generate the HTML.
2031    
2032    =item tree
2033    
2034    Reference to a hash describing a tree. See the description above.
2035    
2036    =item options
2037    
2038    Hash containing options for the tree display.
2039    
2040    =back
2041    
2042    The allowable options are as follows
2043    
2044    =over 4
2045    
2046    =item nodeImageClosed
2047    
2048    URL of the image to display next to the tree nodes when they are collapsed. Clicking
2049    on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.
2050    
2051    =item nodeImageOpen
2052    
2053    URL of the image to display next to the tree nodes when they are expanded. Clicking
2054    on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.
2055    
2056    =item style
2057    
2058    Style to use for the tree. The default is C<tree>. Because the tree style is implemented
2059    as nested lists, the key components of this style are the definitions for the C<ul> and
2060    C<li> tags. The default style file contains the following definitions.
2061    
2062        .tree ul {
2063           margin-left: 0; padding-left: 22px
2064        }
2065        .tree li {
2066            list-style-type: none;
2067        }
2068    
2069    The default image is 22 pixels wide, so in the above scheme each tree level is indented from its
2070    parent by the width of the node image. This use of styles limits the things we can do in formatting
2071    the tree, but it has the advantage of vastly simplifying the tree creation.
2072    
2073    =item name
2074    
2075    Field name to give to the radio buttons in the tree. The default is C<selection>.
2076    
2077    =item target
2078    
2079    Frame target for links. The default is C<_self>.
2080    
2081    =item selected
2082    
2083    If specified, the value of the radio button to be pre-selected.
2084    
2085    =back
2086    
2087    =cut
2088    
2089    sub SelectionTree {
2090        # Get the parameters.
2091        my ($cgi, $tree, %options) = @_;
2092        # Get the options.
2093        my $optionThing = Tracer::GetOptions({ name => 'selection',
2094                                               nodeImageClosed => '../FIG/Html/plus.gif',
2095                                               nodeImageOpen => '../FIG/Html/minus.gif',
2096                                               style => 'tree',
2097                                               target => '_self',
2098                                               selected => undef},
2099                                             \%options);
2100        # Declare the return variable. We'll do the standard thing with creating a list
2101        # of HTML lines and rolling them together at the end.
2102        my @retVal = ();
2103        # Only proceed if the tree is present.
2104        if (defined($tree)) {
2105            # Validate the tree.
2106            if (ref $tree ne 'ARRAY') {
2107                Confess("Selection tree is not a list reference.");
2108            } elsif (scalar @{$tree} == 0) {
2109                # The tree is empty, so we do nothing.
2110            } elsif ($tree->[0] eq 'HASH') {
2111                Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
2112            } else {
2113                # Here we have a real tree. Apply the tree style.
2114                push @retVal, $cgi->start_div({ class => $optionThing->{style} });
2115                # Give us a DIV ID.
2116                my $divID = GetDivID($optionThing->{name});
2117                # Show the tree.
2118                push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
2119                # Close the DIV block.
2120                push @retVal, $cgi->end_div();
2121            }
2122        }
2123        # Return the result.
2124        return join("\n", @retVal, "");
2125    }
2126    
2127    =head3 ShowBranch
2128    
2129    C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>
2130    
2131    This is a recursive method that displays a branch of the tree.
2132    
2133    =over 4
2134    
2135    =item cgi
2136    
2137    CGI object used to format HTML.
2138    
2139    =item label
2140    
2141    Label of this tree branch. It is only used in error messages.
2142    
2143    =item id
2144    
2145    ID to be given to this tree branch. The ID is used in the code that expands and collapses
2146    tree nodes.
2147    
2148    =item branch
2149    
2150    Reference to a list containing the content of the tree branch. The list contains an optional
2151    hash reference that is ignored and the list of children, each child represented by a name
2152    and then its contents. The contents could by a hash reference (indicating the attributes
2153    of a leaf node), or another tree branch.
2154    
2155    =item options
2156    
2157    Options from the original call to L</SelectionTree>.
2158    
2159    =item displayType
2160    
2161    C<block> if the contents of this list are to be displayed, C<none> if they are to be
2162    hidden.
2163    
2164    =item RETURN
2165    
2166    Returns one or more HTML lines that can be used to display the tree branch.
2167    
2168    =back
2169    
2170    =cut
2171    
2172    sub ShowBranch {
2173        # Get the parameters.
2174        my ($cgi, $label, $id, $branch, $options, $displayType) = @_;
2175        # Declare the return variable.
2176        my @retVal = ();
2177        # Start the branch.
2178        push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });
2179        # Check for the hash and choose the start location accordingly.
2180        my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
2181        # Get the list length.
2182        my $i1 = scalar(@{$branch});
2183        # Verify we have an even number of elements.
2184        if (($i1 - $i0) % 2 != 0) {
2185            Trace("Branch elements are from $i0 to $i1.") if T(3);
2186            Confess("Odd number of elements in tree branch $label.");
2187        } else {
2188            # Loop through the elements.
2189            for (my $i = $i0; $i < $i1; $i += 2) {
2190                # Get this node's label and contents.
2191                my ($myLabel, $myContent) = ($branch->[$i], $branch->[$i+1]);
2192                # Get an ID for this node's children (if any).
2193                my $myID = GetDivID($options->{name});
2194                # Now we need to find the list of children and the options hash.
2195                # This is a bit ugly because we allow the shortcut of a hash without an
2196                # enclosing list. First, we need some variables.
2197                my $attrHash = {};
2198                my @childHtml = ();
2199                my $hasChildren = 0;
2200                if (! ref $myContent) {
2201                    Confess("Invalid tree definition. Scalar found as content of node \"$myLabel\".");
2202                } elsif (ref $myContent eq 'HASH') {
2203                    # Here the node is a leaf and its content contains the link/value hash.
2204                    $attrHash = $myContent;
2205                } elsif (ref $myContent eq 'ARRAY') {
2206                    # Here the node may be a branch. Its content is a list.
2207                    my $len = scalar @{$myContent};
2208                    if ($len >= 1) {
2209                        # Here the first element of the list could by the link/value hash.
2210                        if (ref $myContent->[0] eq 'HASH') {
2211                            $attrHash = $myContent->[0];
2212                            # If there's data in the list besides the hash, it's our child list.
2213                            # We can pass the entire thing as the child list, because the hash
2214                            # is ignored.
2215                            if ($len > 1) {
2216                                $hasChildren = 1;
2217                            }
2218                        } else {
2219                            $hasChildren = 1;
2220                        }
2221                        # If we have children, create the child list with a recursive call.
2222                        if ($hasChildren) {
2223                            Trace("Processing children of $myLabel.") if T(4);
2224                            push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2225                            Trace("Children of $myLabel finished.") if T(4);
2226                        }
2227                    }
2228                }
2229                # Okay, it's time to pause and take stock. We have the label of the current node
2230                # in $myLabel, its attributes in $attrHash, and if it is NOT a leaf node, we
2231                # have a child list in @childHtml. If it IS a leaf node, $hasChildren is 0.
2232                # Compute the image HTML. It's tricky, because we have to deal with the open and
2233                # closed images.
2234                my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
2235                my $image = $images[$hasChildren];
2236                my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});
2237                if ($hasChildren) {
2238                    # If there are children, we wrap the image in a toggle hyperlink.
2239                    $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
2240                                          $prefixHtml);
2241                }
2242                # Now the radio button, if any. Note we use "defined" in case the user wants the
2243                # value to be 0.
2244                if (defined $attrHash->{value}) {
2245                    # Due to a glitchiness in the CGI stuff, we have to build the attribute
2246                    # hash for the "input" method. If the item is pre-selected, we add
2247                    # "checked => undef" to the hash. Otherwise, we can't have "checked"
2248                    # at all.
2249                    my $radioParms = { type => 'radio',
2250                                       name => $options->{name},
2251                                       value => $attrHash->{value},
2252                                     };
2253                    if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
2254                        $radioParms->{checked} = undef;
2255                    }
2256                    $prefixHtml .= $cgi->input($radioParms);
2257                }
2258                # Next, we format the label.
2259                my $labelHtml = $myLabel;
2260                Trace("Formatting tree node for \"$myLabel\".") if T(4);
2261                # Apply a hyperlink if necessary.
2262                if (defined $attrHash->{link}) {
2263                    $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
2264                                         $labelHtml);
2265                }
2266                # Finally, roll up the child HTML. If there are no children, we'll get a null string
2267                # here.
2268                my $childHtml = join("\n", @childHtml);
2269                # Now we have all the pieces, so we can put them together.
2270                push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");
2271            }
2272        }
2273        # Close the tree branch.
2274        push @retVal, $cgi->end_ul();
2275        # Return the result.
2276        return @retVal;
2277    }
2278    
2279    =head3 GetDivID
2280    
2281    C<< my $idString = SearchHelper::GetDivID($name); >>
2282    
2283    Return a new HTML ID string.
2284    
2285    =over 4
2286    
2287    =item name
2288    
2289    Name to be prefixed to the ID string.
2290    
2291    =item RETURN
2292    
2293    Returns a hopefully-unique ID string.
2294    
2295    =back
2296    
2297    =cut
2298    
2299    sub GetDivID {
2300        # Get the parameters.
2301        my ($name) = @_;
2302        # Compute the ID.
2303        my $retVal = "elt_$name$divCount";
2304        # Increment the counter to make sure this ID is not re-used.
2305        $divCount++;
2306        # Return the result.
2307        return $retVal;
2308    }
2309    
2310    =head2 Feature Column Methods
2311    
2312    The methods in this section manage feature column data. If you want to provide the
2313    capability to include new types of data in feature columns, then all the changes
2314    are made to this section of the source file. Technically, this should be implemented
2315    using object-oriented methods, but this is simpler for non-programmers to maintain.
2316    To add a new column of feature data, you must first give it a name. For example,
2317    the name for the protein page link column is C<protlink>. If the column is to appear
2318    in the default list of feature columns, add it to the list returned by
2319    L</DefaultFeatureColumns>. Then add code to produce the column title to
2320    L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>. If the
2321    feature column should be excluded from downloads, add it to the C<FeatureColumnSkip>
2322    hash. Everything else will happen automatically.
2323    
2324    There is a special column name syntax for extra columns (that is, nonstandard
2325    feature columns). If the column name begins with C<X=>, then it is presumed to be
2326    an extra column. The column title is the text after the C<X=>, and its value is
2327    pulled from the extra column hash.
2328    
2329    =cut
2330    
2331    # This hash is used to determine which columns should not be included in downloads.
2332    my %FeatureColumnSkip = map { $_ => 1 } qw(gblink viewerlink protlink);
2333    
2334    =head3 DefaultFeatureColumns
2335    
2336    C<< my @colNames = $shelp->DefaultFeatureColumns(); >>
2337    
2338    Return a list of the default feature column identifiers. These identifiers can
2339    be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to
2340    produce the column titles and row values.
2341    
2342    =cut
2343    
2344    sub DefaultFeatureColumns {
2345        # Get the parameters.
2346        my ($self) = @_;
2347        # Return the result.
2348        return qw(orgName function gblink protlink);
2349    }
2350    
2351    =head3 FeatureColumnTitle
2352    
2353    C<< my $title = $shelp->FeatureColumnTitle($colName); >>
2354    
2355    Return the column heading title to be used for the specified feature column.
2356    
2357    =over 4
2358    
2359    =item name
2360    
2361    Name of the desired feature column.
2362    
2363    =item RETURN
2364    
2365    Returns the title to be used as the column header for the named feature column.
2366    
2367    =back
2368    
2369    =cut
2370    
2371    sub FeatureColumnTitle {
2372        # Get the parameters.
2373        my ($self, $colName) = @_;
2374        # Declare the return variable. We default to a blank column name.
2375        my $retVal = "&nbsp;";
2376        # Process the column name.
2377        if ($colName =~ /^X=(.+)$/) {
2378            # Here we have an extra column.
2379            $retVal = $1;
2380        } elsif ($colName eq 'alias') {
2381            $retVal = "External Aliases";
2382        } elsif ($colName eq 'fid') {
2383            $retVal = "FIG ID";
2384        } elsif ($colName eq 'function') {
2385            $retVal = "Functional Assignment";
2386        } elsif ($colName eq 'gblink') {
2387            $retVal = "GBrowse";
2388        } elsif ($colName eq 'group') {
2389            $retVal = "NMDPR Group";
2390        } elsif ($colName =~ /^keyword:(.+)$/) {
2391            $retVal = ucfirst $1;
2392        } elsif ($colName eq 'orgName') {
2393            $retVal = "Organism and Gene ID";
2394        } elsif ($colName eq 'protlink') {
2395            $retVal = "NMPDR Protein Page";
2396        } elsif ($colName eq 'viewerlink') {
2397            $retVal = "Annotation Page";
2398        } elsif ($colName eq 'subsystem') {
2399            $retVal = "Subsystems";
2400        }
2401        # Return the result.
2402        return $retVal;
2403    }
2404    
2405    =head3 FeatureColumnDownload
2406    
2407    C<< my $keep = $shelp->FeatureColumnDownload($colName); >>
2408    
2409    Return TRUE if the named feature column is to be kept when downloading, else FALSE.
2410    
2411    =over 4
2412    
2413    =item colName
2414    
2415    Name of the relevant feature column.
2416    
2417    =item RETURN
2418    
2419    Return TRUE if the named column should be kept while downloading, else FALSE. In general,
2420    FALSE is returned if the column generates a button, image, or other purely-HTML value.
2421    
2422    =back
2423    
2424    =cut
2425    
2426    sub FeatureColumnDownload {
2427        # Get the parameters.
2428        my ($self, $colName) = @_;
2429        # Return the determination. We download the column if it's not in the skip-hash.
2430        # Note we return 0 and 1 instead of 1 and undef because it simplifies some tracing.
2431        return (exists $FeatureColumnSkip{$colName} ? 0 : 1);
2432    }
2433    
2434    
2435    =head3 FeatureColumnValue
2436    
2437    C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>
2438    
2439    Return the value to be displayed in the specified feature column.
2440    
2441    =over 4
2442    
2443    =item colName
2444    
2445    Name of the column to be displayed.
2446    
2447    =item record
2448    
2449    ERDBObject record for the feature being displayed in the current row.
2450    
2451    =item extraCols
2452    
2453    Reference to a hash of extra column names to values. If the incoming column name
2454    begins with C<X=>, its value will be taken from this hash.
2455    
2456    =item RETURN
2457    
2458    Returns the HTML to be displayed in the named column for the specified feature.
2459    
2460    =back
2461    
2462    =cut
2463    
2464    sub FeatureColumnValue {
2465        # Get the parameters.
2466        my ($self, $colName, $record, $extraCols) = @_;
2467        # Get the sprout and CGI objects.
2468        my $cgi = $self->Q();
2469        my $sprout = $self->DB();
2470        # Get the feature ID.
2471      my ($fid) = $record->Value('Feature(id)');      my ($fid) = $record->Value('Feature(id)');
2472      # Declare the return variable. Denote that we default to a non-breaking space,      # Declare the return variable. Denote that we default to a non-breaking space,
2473      # which will translate to an empty table cell (rather than a table cell with no      # which will translate to an empty table cell (rather than a table cell with no
# Line 1492  Line 2482 
2482          if (defined $extraCols->{$1}) {          if (defined $extraCols->{$1}) {
2483              $retVal = $extraCols->{$1};              $retVal = $extraCols->{$1};
2484          }          }
2485      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'alias') {
2486          # Here we want the formatted organism name and feature number.          # In this case, the user wants a list of external aliases for the feature.
2487          $retVal = $self->FeatureName($fid);          # These are very expensive, so we compute them when the row is displayed.
2488            $retVal = "%%alias=$fid";
2489      } elsif ($colName eq 'fid') {      } elsif ($colName eq 'fid') {
2490          # Here we have the raw feature ID. We hyperlink it to the protein page.          # Here we have the raw feature ID. We hyperlink it to the protein page.
2491          $retVal = HTML::set_prot_links($fid);          $retVal = HTML::set_prot_links($fid);
     } elsif ($colName eq 'alias') {  
         # In this case, the user wants a list of external aliases for the feature.  
         # The complicated part is we have to hyperlink them. First, get the  
         # aliases.  
         my @aliases = $sprout->FeatureAliases($fid);  
         # Only proceed if we found some.  
         if (@aliases) {  
             # Join the aliases into a comma-delimited list.  
             my $aliasList = join(", ", @aliases);  
             # Ask the HTML processor to hyperlink them.  
             $retVal = HTML::set_prot_links($aliasList);  
         }  
2492      } elsif ($colName eq 'function') {      } elsif ($colName eq 'function') {
2493          # The functional assignment is just a matter of getting some text.          # The functional assignment is just a matter of getting some text.
2494          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2495      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2496          # Here we want a link to the GBrowse page using the official GBrowse button.          # Here we want a link to the GBrowse page using the official GBrowse button.
2497          my $gurl = "GetGBrowse.cgi?fid=$fid";          $retVal = FakeButton('GBrowse', "GetGBrowse.cgi", undef,
2498          $retVal = $cgi->a({ href => $gurl, title => "GBrowse for $fid" },                            fid => $fid);
                           $cgi->img({ src => "../images/button-gbrowse.png",  
                                       border => 0 })  
                          );  
     } 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 })  
                          );  
2499      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2500          # Get the NMPDR group name.          # Get the NMPDR group name.
2501          my (undef, $group) = $self->OrganismData($fid);          my (undef, $group) = $self->OrganismData($fid);
# Line 1534  Line 2503 
2503          my $nurl = $sprout->GroupPageName($group);          my $nurl = $sprout->GroupPageName($group);
2504          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },          $retVal = $cgi->a({ href => $nurl, title => "$group summary" },
2505                            $group);                            $group);
2506        } elsif ($colName =~ /^keyword:(.+)$/) {
2507            # Here we want keyword-related values. This is also expensive, so
2508            # we compute them when the row is displayed.
2509            $retVal = "%%$colName=$fid";
2510        } elsif ($colName eq 'orgName') {
2511            # Here we want the formatted organism name and feature number.
2512            $retVal = $self->FeatureName($fid);
2513        } elsif ($colName eq 'protlink') {
2514            # Here we want a link to the protein page using the official NMPDR button.
2515            $retVal = FakeButton('NMPDR', "protein.cgi", undef,
2516                              prot => $fid, SPROUT => 1, new_framework => 0,
2517                              user => '');
2518        } elsif ($colName eq 'viewerlink') {
2519            # Here we want a link to the SEED viewer page using the official viewer button.
2520            $retVal = FakeButton('Annotation', "index.cgi", undef,
2521                                 action => 'ShowAnnotation', prot => $fid);
2522        } elsif ($colName eq 'subsystem') {
2523            # Another run-time column: subsystem list.
2524            $retVal = "%%subsystem=$fid";
2525      }      }
2526      # Return the result.      # Return the result.
2527      return $retVal;      return $retVal;
2528  }  }
2529    
2530    =head3 RunTimeColumns
2531    
2532    C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>
2533    
2534    Return the HTML text for a run-time column. Run-time columns are evaluated when the
2535    list is displayed, rather than when it is generated.
2536    
2537    =over 4
2538    
2539    =item type
2540    
2541    Type of column.
2542    
2543    =item text
2544    
2545    Data relevant to this row of the column.
2546    
2547    =item RETURN
2548    
2549    Returns the fully-formatted HTML text to go in the specified column.
2550    
2551    =back
2552    
2553    =cut
2554    
2555    sub RunTimeColumns {
2556        # Get the parameters.
2557        my ($self, $type, $text) = @_;
2558        # Declare the return variable.
2559        my $retVal = "";
2560        # Get the Sprout and CGI objects.
2561        my $sprout = $self->DB();
2562        my $cgi = $self->Q();
2563        Trace("Runtime column $type with text \"$text\" found.") if T(4);
2564        # Separate the text into a type and data.
2565        if ($type eq 'alias') {
2566            # Here the caller wants external alias links for a feature. The text
2567            # is the feature ID.
2568            my $fid = $text;
2569            # The complicated part is we have to hyperlink them. First, get the
2570            # aliases.
2571            Trace("Generating aliases for feature $fid.") if T(4);
2572            my @aliases = $sprout->FeatureAliases($fid);
2573            # Only proceed if we found some.
2574            if (@aliases) {
2575                # Join the aliases into a comma-delimited list.
2576                my $aliasList = join(", ", @aliases);
2577                # Ask the HTML processor to hyperlink them.
2578                $retVal = HTML::set_prot_links($cgi, $aliasList);
2579            }
2580        } elsif ($type eq 'subsystem') {
2581            # Here the caller wants the subsystems in which this feature participates.
2582            # The text is the feature ID. We will list the subsystem names with links
2583            # to the subsystem's summary page.
2584            my $fid = $text;
2585            # Get the subsystems.
2586            Trace("Generating subsystems for feature $fid.") if T(4);
2587            my %subs = $sprout->SubsystemsOf($fid);
2588            # Extract the subsystem names.
2589            my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2590            # String them into a list.
2591            $retVal = join(", ", @names);
2592        } elsif ($type =~ /^keyword:(.+)$/) {
2593            # Here the caller wants the value of the named keyword. The text is the
2594            # feature ID.
2595            my $keywordName = $1;
2596            my $fid = $text;
2597            # Get the attribute values.
2598            Trace("Getting $keywordName values for feature $fid.") if T(4);
2599            my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],
2600                                          "Feature($keywordName)");
2601            # String them into a list.
2602            $retVal = join(", ", @values);
2603        }
2604        # Return the result.
2605        return $retVal;
2606    }
2607    
2608    =head3 SaveOrganismData
2609    
2610    C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>
2611    
2612    Format the name of an organism and the display version of its group name. The incoming
2613    data should be the relevant fields from the B<Genome> record in the database. The
2614    data will also be stored in the genome cache for later use in posting search results.
2615    
2616    =over 4
2617    
2618    =item group
2619    
2620    Name of the genome's group as it appears in the database.
2621    
2622    =item genomeID
2623    
2624    ID of the relevant genome.
2625    
2626    =item genus
2627    
2628    Genus of the genome's organism. If undefined or null, it will be assumed the genome is not
2629    in the database. In this case, the organism name is derived from the genomeID and the group
2630    is automatically the supporting-genomes group.
2631    
2632    =item species
2633    
2634    Species of the genome's organism.
2635    
2636    =item strain
2637    
2638    Strain of the species represented by the genome.
2639    
2640    =item RETURN
2641    
2642    Returns a two-element list. The first element is the formatted genome name. The second
2643    element is the display name of the genome's group.
2644    
2645    =back
2646    
2647    =cut
2648    
2649    sub SaveOrganismData {
2650        # Get the parameters.
2651        my ($self, $group, $genomeID, $genus, $species, $strain) = @_;
2652        # Declare the return values.
2653        my ($name, $displayGroup);
2654        # If the organism does not exist, format an unknown name and a blank group.
2655        if (! defined($genus)) {
2656            $name = "Unknown Genome $genomeID";
2657            $displayGroup = "";
2658        } else {
2659            # It does exist, so format the organism name.
2660            $name = "$genus $species";
2661            if ($strain) {
2662                $name .= " $strain";
2663            }
2664            # Compute the display group. This is currently the same as the incoming group
2665            # name unless it's the supporting group, which is nulled out.
2666            $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2667        }
2668        # Cache the group and organism data.
2669        my $cache = $self->{orgs};
2670        $cache->{$genomeID} = [$name, $displayGroup];
2671        # Return the result.
2672        return ($name, $displayGroup);
2673    }
2674    
2675    =head3 ValidateKeywords
2676    
2677    C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>
2678    
2679    Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2680    set.
2681    
2682    =over 4
2683    
2684    =item keywordString
2685    
2686    Keyword string specified as a parameter to the current search.
2687    
2688    =item required
2689    
2690    TRUE if there must be at least one keyword specified, else FALSE.
2691    
2692    =item RETURN
2693    
2694    Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
2695    is acceptable if the I<$required> parameter is not specified.
2696    
2697    =back
2698    
2699    =cut
2700    
2701    sub ValidateKeywords {
2702        # Get the parameters.
2703        my ($self, $keywordString, $required) = @_;
2704        # Declare the return variable.
2705        my $retVal = 0;
2706        my @wordList = split /\s+/, $keywordString;
2707        # Right now our only real worry is a list of all minus words. The problem with it is that
2708        # it will return an incorrect result.
2709        my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
2710        if (! @wordList) {
2711            if ($required) {
2712                $self->SetMessage("No search words specified.");
2713            } else {
2714                $retVal = 1;
2715            }
2716        } elsif (! @plusWords) {
2717            $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
2718        } else {
2719            $retVal = 1;
2720        }
2721        # Return the result.
2722        return $retVal;
2723    }
2724    
2725    =head3 FakeButton
2726    
2727    C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>
2728    
2729    Create a fake button that hyperlinks to the specified URL with the specified parameters.
2730    Unlike a real button, this one won't visibly click, but it will take the user to the
2731    correct place.
2732    
2733    The parameters of this method are deliberately identical to L</Formlet> so that we
2734    can switch easily from real buttons to fake ones in the code.
2735    
2736    =over 4
2737    
2738    =item caption
2739    
2740    Caption to be put on the button.
2741    
2742    =item url
2743    
2744    URL for the target page or script.
2745    
2746    =item target
2747    
2748    Frame or target in which the new page should appear. If C<undef> is specified,
2749    the default target will be used.
2750    
2751    =item parms
2752    
2753    Hash containing the parameter names as keys and the parameter values as values.
2754    These will be appended to the URL.
2755    
2756    =back
2757    
2758    =cut
2759    
2760    sub FakeButton {
2761        # Get the parameters.
2762        my ($caption, $url, $target, %parms) = @_;
2763        # Declare the return variable.
2764        my $retVal;
2765        # Compute the target URL.
2766        my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
2767        # Compute the target-frame HTML.
2768        my $targetHtml = ($target ? " target=\"$target\"" : "");
2769        # Assemble the result.
2770        return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";
2771    }
2772    
2773    =head3 Formlet
2774    
2775    C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>
2776    
2777    Create a mini-form that posts to the specified URL with the specified parameters. The
2778    parameters will be stored in hidden fields, and the form's only visible control will
2779    be a submit button with the specified caption.
2780    
2781    Note that we don't use B<CGI.pm> services here because they generate forms with extra characters
2782    and tags that we don't want to deal with.
2783    
2784    =over 4
2785    
2786    =item caption
2787    
2788    Caption to be put on the form button.
2789    
2790    =item url
2791    
2792    URL to be put in the form's action parameter.
2793    
2794    =item target
2795    
2796    Frame or target in which the form results should appear. If C<undef> is specified,
2797    the default target will be used.
2798    
2799    =item parms
2800    
2801    Hash containing the parameter names as keys and the parameter values as values.
2802    
2803    =back
2804    
2805    =cut
2806    
2807    sub Formlet {
2808        # Get the parameters.
2809        my ($caption, $url, $target, %parms) = @_;
2810        # Compute the target HTML.
2811        my $targetHtml = ($target ? " target=\"$target\"" : "");
2812        # Start the form.
2813        my $retVal = "<form method=\"POST\" action=\"$url\"$target>";
2814        # Add the parameters.
2815        for my $parm (keys %parms) {
2816            $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";
2817        }
2818        # Put in the button.
2819        $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";
2820        # Close the form.
2821        $retVal .= "</form>";
2822        # Return the result.
2823        return $retVal;
2824    }
2825    
2826    =head2 Virtual Methods
2827    
2828    =head3 Form
2829    
2830    C<< my $html = $shelp->Form(); >>
2831    
2832    Generate the HTML for a form to request a new search.
2833    
2834    =head3 Find
2835    
2836    C<< my $resultCount = $shelp->Find(); >>
2837    
2838    Conduct a search based on the current CGI query parameters. The search results will
2839    be written to the session cache file and the number of results will be
2840    returned. If the search parameters are invalid, a result count of C<undef> will be
2841    returned and a result message will be stored in this object describing the problem.
2842    
2843    =head3 Description
2844    
2845    C<< my $htmlText = $shelp->Description(); >>
2846    
2847    Return a description of this search. The description is used for the table of contents
2848    on the main search tools page. It may contain HTML, but it should be character-level,
2849    not block-level, since the description is going to appear in a list.
2850    
2851    =head3 SortKey
2852    
2853    C<< my $key = $shelp->SortKey($fdata); >>
2854    
2855    Return the sort key for the specified feature data. The default is to sort by feature name,
2856    floating NMPDR organisms to the top. If a full-text search is used, then the default
2857    sort is by relevance followed by feature name. This sort may be overridden by the
2858    search class to provide fancier functionality. This method is called by
2859    B<PutFeature>, so it is only used for feature searches. A non-feature search
2860    would presumably have its own sort logic.
2861    
2862    =over 4
2863    
2864    =item record
2865    
2866    The C<FeatureData> containing the current feature.
2867    
2868    =item RETURN
2869    
2870    Returns a key field that can be used to sort this row in among the results.
2871    
2872    =back
2873    
2874    =cut
2875    
2876    sub SortKey {
2877        # Get the parameters.
2878        my ($self, $fdata) = @_;
2879        # Get the feature ID from the record.
2880        my $fid = $fdata->FID();
2881        # Get the group from the feature ID.
2882        my $group = $self->FeatureGroup($fid);
2883        # Ask the feature query object to form the sort key.
2884        my $retVal = $fdata->SortKey($self, $group);
2885        # Return the result.
2886        return $retVal;
2887    }
2888    
2889    =head3 PrintLine
2890    
2891    C<< $shelp->PrintLine($message); >>
2892    
2893    Print a line of CGI output. This is used during the operation of the B<Find> method while
2894    searching, so the user sees progress in real-time.
2895    
2896    =over 4
2897    
2898    =item message
2899    
2900    HTML text to display.
2901    
2902    =back
2903    
2904    =cut
2905    
2906    sub PrintLine {
2907        # Get the parameters.
2908        my ($self, $message) = @_;
2909        # Send them to the output.
2910        print "$message\n";
2911    }
2912    
2913    
2914  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3