[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.29, Sat Apr 14 21:41:25 2007 UTC revision 1.34, Mon Jul 16 20:04:51 2007 UTC
# Line 10  Line 10 
10      use File::Path;      use File::Path;
11      use File::stat;      use File::stat;
12      use LWP::UserAgent;      use LWP::UserAgent;
13      use Time::HiRes 'gettimeofday';      use FIGRules;
14      use Sprout;      use Sprout;
15      use SFXlate;      use SFXlate;
16      use FIGRules;      use FIGRules;
# Line 19  Line 19 
19      use FeatureQuery;      use FeatureQuery;
20      use URI::Escape;      use URI::Escape;
21      use PageBuilder;      use PageBuilder;
22        use AliasAnalysis;
23        use FreezeThaw qw(freeze thaw);
24    
25  =head1 Search Helper Base Class  =head1 Search Helper Base Class
26    
# Line 65  Line 67 
67    
68  =item orgs  =item orgs
69    
70  Reference to a hash mapping genome IDs to organism names.  Reference to a hash mapping genome IDs to organism data. (Used to
71    improve performance.)
72    
73  =item name  =item name
74    
# Line 83  Line 86 
86    
87  List of the parameters that are used to select multiple genomes.  List of the parameters that are used to select multiple genomes.
88    
 =item filtered  
   
 TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this  
 field is updated by the B<FeatureQuery> object.  
   
 =item extraPos  
   
 C<0> if the extra columns are to be at the beginning, else C<1>. The  
 default is zero; use the L</SetExtraPos> method to change this option.  
   
89  =back  =back
90    
91  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 108  Line 101 
101  =item 2  =item 2
102    
103  Create a new subclass of this object and implement each of the virtual methods. The  Create a new subclass of this object and implement each of the virtual methods. The
104  name of the subclass must be C<SH>I<className>.  name of the subclass must be C<SH>I<className>, where I<className> is the
105    type of search.
106    
107  =item 3  =item 3
108    
# Line 118  Line 112 
112    
113  =item 4  =item 4
114    
115  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.  If your search produces a result for which a helper does not exist, you
116    must create a new subclass of B<ResultHelper>. Its name must be
117    C<RH>I<className>, where I<className> is the type of result.
118    
119  =back  =back
120    
# Line 154  Line 150 
150    
151  Several helper methods are provided for particular purposes.  Several helper methods are provided for particular purposes.
152    
 =over 4  
   
 =item 1  
   
153  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
154  L</GetGenomes> to retrieve all the genomes passed in for a specified parameter  L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
155  name. Note that as an assist to people working with GET-style links, if no  name. Note that as an assist to people working with GET-style links, if no
156  genomes are specified and the incoming request style is GET, all genomes will  genomes are specified and the incoming request style is GET, all genomes will
157  be returned.  be returned.
158    
 =item 2  
   
 L</FeatureFilterRow> formats several rows of controls for filtering features.  
 When you start building the code for the L</Find> method, you can use a  
 B<FeatureQuery> object to automatically filter each genome's features using  
 the values from the filter controls.  
   
 =item 3  
   
159  L</QueueFormScript> allows you to queue JavaScript statements for execution  L</QueueFormScript> allows you to queue JavaScript statements for execution
160  after the form is fully generated. If you are using very complicated  after the form is fully generated. If you are using very complicated
161  form controls, the L</QueueFormScript> method allows you to perform  form controls, the L</QueueFormScript> method allows you to perform
162  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this
163  facility to display a list of the pre-selected genomes.  facility to display a list of the pre-selected genomes.
164    
 =back  
   
 If you are doing a feature search, you can also change the list of feature  
 columns displayed and their display order by overriding  
 L</DefaultFeatureColumns>.  
   
165  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
166  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
167    
168  =head3 Finding Search Results  =head3 Finding Search Results
169    
170  The L</Find> method is used to create the search results. For a search that  The L</Find> method is used to create the search results. The basic code
171  wants to return features (which is most of them), the basic code structure  structure would work as follows.
 would work as follows. It is assumed that the L</FeatureFilterRows> method  
 has been used to create feature filtering parameters.  
172    
173      sub Find {      sub Find {
174          my ($self) = @_;          my ($self) = @_;
# Line 206  Line 181 
181          ... validate the parameters ...          ... validate the parameters ...
182          if (... invalid parameters...) {          if (... invalid parameters...) {
183              $self->SetMessage(...appropriate message...);              $self->SetMessage(...appropriate message...);
184          } elsif (FeatureQuery::Valid($self)) {          } else {
185                # Determine the result type.
186                my $rhelp = SearchHelper::GetHelper($self, RH => $resultType);
187                # Specify the columns.
188                $self->DefaultColumns($rhelp);
189                # You may want to add extra columns. $name is the column name and
190                # $loc is its location. The other parameters take their names from the
191                # corresponding column methods.
192                $rhelp->AddExtraColumn($name => $loc, style => $style, download => $flag,
193                    title => $title);
194                # Some searches require optional columns that are configured by the
195                # user or by the search query itself. There are some special methods
196                # for this in the result helpers, but there's also the direct approach
197                # shown below.
198                $rhelp->AddOptionalColumn($name => $loc);
199              # Initialize the session file.              # Initialize the session file.
200              $self->OpenSession();              $self->OpenSession($rhelp);
201              # Initialize the result counter.              # Initialize the result counter.
202              $retVal = 0;              $retVal = 0;
203              ... get a list of genomes ...              ... set up to loop through the results ...
204              for my $genomeID (... each genome ...) {              while (...more results...) {
205                  my $fq = FeatureQuery->new($self, $genomeID);                  ...compute extra columns and call PutExtraColumns...
206                  while (my $feature = $fq->Fetch()) {                  $rhelp->PutData($sortKey, $objectID, $record);
                     ... examine the feature ...  
                     if (... we want to keep it ...) {  
                         $self->PutFeature($fq);  
207                          $retVal++;                          $retVal++;
208                      }                      }
                 }  
             }  
209              # Close the session file.              # Close the session file.
210              $self->CloseSession();              $self->CloseSession();
211          }          }
# Line 230  Line 214 
214      }      }
215    
216  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
217  are variations on the above theme. For example, you could eschew feature filtering  are variations on the above theme.
 entirely in favor of your own custom filtering, you could include extra columns  
 in the output, or you could search for something that's not a feature at all. The  
 above code is just a loose framework.  
218    
219  In addition to the finding and filtering, it is necessary to send status messages  In addition to the finding and filtering, it is necessary to send status messages
220  to the output so that the user does not get bored waiting for results. The L</PrintLine>  to the output so that the user does not get bored waiting for results. The L</PrintLine>
# Line 245  Line 226 
226  The break tag is optional. When the Find method gets control, a paragraph will  The break tag is optional. When the Find method gets control, a paragraph will
227  have been started so that everything is XHTML-compliant.  have been started so that everything is XHTML-compliant.
228    
 If you wish to add your own extra columns to the output, use the B<AddExtraColumns>  
 method of the feature query object.  
   
     $fq->AddExtraColumns(score => $sc);  
   
229  The L</Find> method must return C<undef> if the search parameters are invalid. If this  The L</Find> method must return C<undef> if the search parameters are invalid. If this
230  is the case, then a message describing the problem should be passed to the framework  is the case, then a message describing the problem should be passed to the framework
231  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
# Line 290  Line 266 
266          Trace("No session ID found.") if T(3);          Trace("No session ID found.") if T(3);
267          # 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
268          # store it in the query object.          # store it in the query object.
269          $session_id = NewSessionID();          $session_id = FIGRules::NewSessionID();
270            Trace("New session ID is $session_id.") if T(3);
271          $type = "new";          $type = "new";
272          $cgi->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
273      } else {      } else {
274          Trace("Session ID is $session_id.") if T(3);          Trace("Session ID is $session_id.") if T(3);
275      }      }
276        Trace("Computing subclass.") if T(3);
277      # Compute the subclass name.      # Compute the subclass name.
278      my $subClass;      my $subClass;
279      if ($class =~ /SH(.+)$/) {      if ($class =~ /SH(.+)$/) {
# Line 306  Line 284 
284          # process search results.          # process search results.
285          $subClass = 'SearchHelper';          $subClass = 'SearchHelper';
286      }      }
287        Trace("Subclass name is $subClass.") if T(3);
288      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
289      $cgi->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
290      # Generate the form name.      # Generate the form name.
291      my $formName = "$class$formCount";      my $formName = "$class$formCount";
292      $formCount++;      $formCount++;
293        Trace("Creating helper.") if T(3);
294      # Create the shelp object. It contains the query object (with the session ID)      # Create the shelp object. It contains the query object (with the session ID)
295      # 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
296      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
# Line 324  Line 304 
304                    scriptQueue => [],                    scriptQueue => [],
305                    genomeList => undef,                    genomeList => undef,
306                    genomeParms => [],                    genomeParms => [],
                   filtered => 0,  
                   extraPos => 0,  
307                   };                   };
308      # Bless and return it.      # Bless and return it.
309      bless $retVal, $class;      bless $retVal, $class;
# Line 386  Line 364 
364      return ($self->{type} eq 'new');      return ($self->{type} eq 'new');
365  }  }
366    
 =head3 SetExtraPos  
   
 C<< $shelp->SetExtraPos($newValue); >>  
   
 Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.  
   
 =over 4  
   
 =item newValue  
   
 C<1> if the extra columns should be displayed at the end, else C<0>.  
   
 =back  
   
 =cut  
   
 sub SetExtraPos {  
     my ($self, $newValue) = @_;  
     $self->{extraPos} = $newValue;  
 }  
   
367  =head3 ID  =head3 ID
368    
369  C<< my $sessionID = $shelp->ID(); >>  C<< my $sessionID = $shelp->ID(); >>
# Line 601  Line 558 
558    
559  =head3 OpenSession  =head3 OpenSession
560    
561  C<< $shelp->OpenSession(); >>  C<< $shelp->OpenSession($rhelp); >>
562    
563    Set up the session cache file and write out the column headers.
564    This method should not be called until all the columns have
565    been configured, including the extra columns.
566    
567    =over 4
568    
569    =item rhelp
570    
571    Result helper for formatting the output. This has the column
572    headers stored in it.
573    
574  Set up to open the session cache file for writing. Note we don't actually  =back
 open the file until after we know the column headers.  
575    
576  =cut  =cut
577    
578  sub OpenSession {  sub OpenSession {
579      # Get the parameters.      # Get the parameters.
580      my ($self) = @_;      my ($self, $rhelp) = @_;
581      # Denote we have not yet written out the column headers.      # Insure the result helper is valid.
582      $self->{cols} = undef;      if (! defined($rhelp)) {
583            Confess("No result type specified for $self->{class}.");
584        } elsif(! $rhelp->isa('ResultHelper')) {
585            Confess("Invalid result type specified for $self->{class}.");
586        } else {
587            # Get the column headers and write them out.
588            my $colHdrs = $rhelp->GetColumnHeaders();
589            Trace(scalar(@{$colHdrs}) . " column headers written to output.") if T(3);
590            $self->WriteColumnHeaders(@{$colHdrs});
591        }
592  }  }
593    
594  =head3 GetCacheFileName  =head3 GetCacheFileName
# Line 656  Line 632 
632      my ($self, $type) = @_;      my ($self, $type) = @_;
633      # Compute the file name. Note it gets stuffed in the FIG temporary      # Compute the file name. Note it gets stuffed in the FIG temporary
634      # directory.      # directory.
635      my $retVal = "$FIG_Config::temp/tmp_" . $self->ID() . ".$type";      my $retVal = FIGRules::GetTempFileName(sessionID => $self->ID(), extension => $type);
636      # Return the result.      # Return the result.
637      return $retVal;      return $retVal;
638  }  }
639    
 =head3 PutFeature  
   
 C<< $shelp->PutFeature($fdata); >>  
   
 Store a feature in the result cache. This is the workhorse method for most  
 searches, since the primary data item in the database is features.  
   
 For each feature, there are certain columns that are standard: the feature name, the  
 GBrowse and protein page links, the functional assignment, and so forth. If additional  
 columns are required by a particular search subclass, they should be stored in  
 the feature query object using the B<AddExtraColumns> method. For example, the following  
 code adds columns for essentiality and virulence.  
   
     $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
     $shelp->PutFeature($fd);  
   
 For correct results, all values should be specified for all extra columns in all calls to  
 B<PutFeature>. (In particular, the column header names are computed on the first  
 call.) If a column is to be blank for the current feature, its value can be given  
 as C<undef>.  
   
     if (! $essentialFlag) {  
         $essentialFlag = undef;  
     }  
     $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
     $shelp->PutFeature($fd);  
   
 =over 4  
   
 =item fdata  
   
 B<FeatureData> object containing the current feature data.  
   
 =back  
   
 =cut  
   
 sub PutFeature {  
     # Get the parameters.  
     my ($self, $fd) = @_;  
     # Get the CGI query object.  
     my $cgi = $self->Q();  
     # Get the feature data.  
     my $record = $fd->Feature();  
     my $extraCols = $fd->ExtraCols();  
     # Check for a first-call situation.  
     if (! defined $self->{cols}) {  
         Trace("Setting up the columns.") if T(3);  
         # Tell the user what's happening.  
         $self->PrintLine("Creating output columns.<br />");  
         # Here we need to set up the column information. First we accumulate the extras,  
         # sorted by column name.  
         my @xtraNames = ();  
         for my $col (sort keys %{$extraCols}) {  
             push @xtraNames, "X=$col";  
         }  
         # Set up the column name array.  
         my @colNames = ();  
         # If extras go at the beginning, put them in first.  
         if (! $self->{extraPos}) {  
             push @colNames, @xtraNames;  
         }  
         # Add the default columns.  
         push @colNames, $self->DefaultFeatureColumns();  
         # Add any additional columns requested by the feature filter.  
         push @colNames, FeatureQuery::AdditionalColumns($self);  
         # If extras go at the end, put them in here.  
         if ($self->{extraPos}) {  
             push @colNames, @xtraNames;  
         }  
         Trace("Full column list determined.") if T(3);  
         # Save the full list.  
         $self->{cols} = \@colNames;  
         # Write out the column names. This also prepares the cache file to receive  
         # output.  
         Trace("Writing column headers.") if T(3);  
         $self->WriteColumnHeaders(@{$self->{cols}});  
         Trace("Column headers written.") if T(3);  
     }  
     # Get the feature ID.  
     my $fid = $fd->FID();  
     # Loop through the column headers, producing the desired data. The first column  
     # is the feature ID. The feature ID does not show up in the output: its purpose  
     # is to help the various output formatters.  
     my @output = ($fid);  
     for my $colName (@{$self->{cols}}) {  
         push @output, $self->FeatureColumnValue($colName, $record, $extraCols);  
     }  
     # Compute the sort key. The sort key usually floats NMPDR organism features to the  
     # top of the return list.  
     my $key = $self->SortKey($fd);  
     # Write the feature data.  
     $self->WriteColumnData($key, @output);  
 }  
   
640  =head3 WriteColumnHeaders  =head3 WriteColumnHeaders
641    
642  C<< $shelp->WriteColumnHeaders(@colNames); >>  C<< $shelp->WriteColumnHeaders(@colNames); >>
# Line 768  Line 649 
649    
650  =item colNames  =item colNames
651    
652  A list of column names in the desired presentation order.  A list of column names in the desired presentation order. For extra columns,
653    the column name is the hash supplied as the column definition.
654    
655  =back  =back
656    
# Line 780  Line 662 
662      # Get the cache file name and open it for output.      # Get the cache file name and open it for output.
663      my $fileName = $self->GetCacheFileName();      my $fileName = $self->GetCacheFileName();
664      my $handle1 = Open(undef, ">$fileName");      my $handle1 = Open(undef, ">$fileName");
665        # Freeze the column headers.
666        my @colHdrs = map { freeze($_) } @colNames;
667      # Write the column headers and close the file.      # Write the column headers and close the file.
668      Tracer::PutLine($handle1, \@colNames);      Tracer::PutLine($handle1, \@colHdrs);
669      close $handle1;      close $handle1;
670      # Now open the sort pipe and save the file handle. Note how we append the      # Now open the sort pipe and save the file handle. Note how we append the
671      # sorted data to the column header row already in place. The output will      # sorted data to the column header row already in place. The output will
# Line 790  Line 674 
674      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
675  }  }
676    
677    =head3 ReadColumnHeaders
678    
679    C<< my @colHdrs = $shelp->ReadColumnHeaders($fh); >>
680    
681    Read the column headers from the specified file handle. The column headers are
682    frozen strings intermixed with frozen hash references. The strings represent
683    column names defined in the result helper. The hash references represent the
684    definitions of the extra columns.
685    
686    =over 4
687    
688    =item fh
689    
690    File handle from which the column headers are to be read.
691    
692    =item RETURN
693    
694    Returns a list of the column headers pulled from the specified file's first line.
695    
696    =back
697    
698    =cut
699    
700    sub ReadColumnHeaders {
701        # Get the parameters.
702        my ($self, $fh) = @_;
703        # Read and thaw the columns.
704        my @retVal = map { thaw($_) } Tracer::GetLine($fh);
705        # Return them to the caller.
706        return @retVal;
707    }
708    
709  =head3 WriteColumnData  =head3 WriteColumnData
710    
711  C<< $shelp->WriteColumnData($key, @colValues); >>  C<< $shelp->WriteColumnData($key, @colValues); >>
# Line 816  Line 732 
732      my ($self, $key, @colValues) = @_;      my ($self, $key, @colValues) = @_;
733      # Write them to the cache file.      # Write them to the cache file.
734      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);      Tracer::PutLine($self->{fileHandle}, [$key, @colValues]);
735        Trace("Column data is " . join("; ", $key, @colValues) . ".") if T(4);
736  }  }
737    
738  =head3 CloseSession  =head3 CloseSession
# Line 840  Line 757 
757      }      }
758  }  }
759    
 =head3 NewSessionID  
   
 C<< my $id = SearchHelpers::NewSessionID(); >>  
   
 Generate a new session ID for the current user.  
   
 =cut  
   
 sub NewSessionID {  
     # Declare the return variable.  
     my $retVal;  
     # Get a digest encoder.  
     my $md5 = Digest::MD5->new();  
     # Add the PID, the IP, and the time stamp. Note that the time stamp is  
     # actually two numbers, and we get them both because we're in list  
     # context.  
     $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());  
     # Hash up all this identifying data.  
     $retVal = $md5->hexdigest();  
     # Return the result.  
     return $retVal;  
 }  
   
760  =head3 OrganismData  =head3 OrganismData
761    
762  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>
# Line 879  Line 773 
773    
774  =item RETURN  =item RETURN
775    
776  Returns a list of two items. The first item in the list is the organism name,  Returns a list of three items. The first item in the list is the organism name,
777  and the second is the name of the NMPDR group, or an empty string if the  and the second is the name of the NMPDR group, or an empty string if the
778  organism is not in an NMPDR group.  organism is not in an NMPDR group. The third item is the organism's domain.
779    
780  =back  =back
781    
# Line 891  Line 785 
785      # Get the parameters.      # Get the parameters.
786      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
787      # Declare the return variables.      # Declare the return variables.
788      my ($orgName, $group);      my ($orgName, $group, $domain);
789      # Check the cache.      # Check the cache.
790      my $cache = $self->{orgs};      my $cache = $self->{orgs};
791      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
792          ($orgName, $group) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
793      } else {      } else {
794          # Here we have to use the database.          # Here we have to use the database.
795          my $sprout = $self->DB();          my $sprout = $self->DB();
796          my ($genus, $species, $strain, $group) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $group, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,
797                                                      ['Genome(genus)', 'Genome(species)',                                                      ['Genome(genus)', 'Genome(species)',
798                                                       'Genome(unique-characterization)',                                                       'Genome(unique-characterization)',
799                                                       'Genome(primary-group)']);                                                                   'Genome(primary-group)',
800                                                                     'Genome(taxonomy)']);
801          # Format and cache the name and display group.          # Format and cache the name and display group.
802          ($orgName, $group) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          ($orgName, $group, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
803                                                              $strain);                                                                $strain, $taxonomy);
804      }      }
805      # Return the result.      # Return the result.
806      return ($orgName, $group);      return ($orgName, $group, $domain);
807  }  }
808    
809  =head3 Organism  =head3 Organism
# Line 936  Line 831 
831      # Get the parameters.      # Get the parameters.
832      my ($self, $genomeID) = @_;      my ($self, $genomeID) = @_;
833      # Get the organism data.      # Get the organism data.
834      my ($retVal, $group) = $self->OrganismData($genomeID);      my ($retVal) = $self->OrganismData($genomeID);
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 FeatureGroup  
   
 C<< my $groupName = $shelp->FeatureGroup($fid); >>  
   
 Return the group name for the specified feature.  
   
 =over 4  
   
 =item fid  
   
 ID of the relevant feature.  
   
 =item RETURN  
   
 Returns the name of the NMPDR group to which the feature belongs, or an empty  
 string if it is not part of an NMPDR group.  
   
 =back  
   
 =cut  
   
 sub FeatureGroup {  
     # Get the parameters.  
     my ($self, $fid) = @_;  
     # Parse the feature ID to get the genome ID.  
     my ($genomeID) = FIGRules::ParseFeatureID($fid);  
     # Get the organism data.  
     my (undef, $retVal) = $self->OrganismData($genomeID);  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 FeatureName  
   
 C<< my $fidName = $shelp->FeatureName($fid); >>  
   
 Return the display name of the specified feature.  
   
 =over 4  
   
 =item fid  
   
 ID of the feature whose name is desired.  
   
 =item RETURN  
   
 A displayable feature name, consisting of the organism name plus some feature  
 type and location information.  
   
 =back  
   
 =cut  
   
 sub FeatureName {  
     # Get the parameters.  
     my ($self, $fid) = @_;  
     # Declare the return variable  
     my $retVal;  
     # Parse the feature ID.  
     my ($genomeID, $type, $num) = FIGRules::ParseFeatureID($fid);  
     if (! defined $genomeID) {  
         # Here the feature ID has an invalid format.  
         $retVal = "External: $fid";  
     } else {  
         # Here we can get its genome data.  
         $retVal = $self->Organism($genomeID);  
         # Append the FIG ID.  
         $retVal .= " [$fid]";  
     }  
835      # Return the result.      # Return the result.
836      return $retVal;      return $retVal;
837  }  }
838    
839  =head3 ComputeFASTA  =head3 ComputeFASTA
840    
841  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth); >>
842    
843  Parse a sequence input and convert it into a FASTA string of the desired type.  Parse a sequence input and convert it into a FASTA string of the desired type with
844    the desired flanking width.
845    
846  =over 4  =over 4
847    
848  =item desiredType  =item desiredType
849    
850  C<dna> to return a DNA sequence, C<prot> to return a protein sequence.  C<dna> to return a DNA sequence, C<prot> to return a protein sequence, C<dnaPattern>
851    to return a DNA search pattern, C<protPattern> to return a protein search pattern.
852    
853  =item sequence  =item sequence
854    
# Line 1034  Line 858 
858  if the input does not begin with a greater-than sign (FASTA label line), a default label  if the input does not begin with a greater-than sign (FASTA label line), a default label
859  line will be provided.  line will be provided.
860    
861    =item flankingWidth
862    
863    If the DNA FASTA of a feature is desired, the number of base pairs to either side of the
864    feature that should be included. Currently we can't do this for Proteins because the
865    protein translation of a feature doesn't always match the DNA and is taken directly
866    from the database.
867    
868  =item RETURN  =item RETURN
869    
870  Returns a string in FASTA format representing the content of the desired sequence with  Returns a string in FASTA format representing the content of the desired sequence with
# Line 1046  Line 877 
877    
878  sub ComputeFASTA {  sub ComputeFASTA {
879      # Get the parameters.      # Get the parameters.
880      my ($self, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence, $flankingWidth) = @_;
881      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
882      my $retVal;      my $retVal;
883      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 1078  Line 909 
909                  $fastaLabel = $fid;                  $fastaLabel = $fid;
910              }              }
911              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
912              if ($desiredType eq 'prot') {              if ($desiredType =~ /prot/) {
913                  # We want protein, so get the translation.                  # We want protein, so get the translation.
914                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
915                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
916              } else {              } elsif ($desiredType =~ /dna/) {
917                  # We want DNA, so get the DNA sequence. This is a two-step process.                  # We want DNA, so get the DNA sequence. This is a two-step process. First, we get the
918                    # locations.
919                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
920                    if ($flankingWidth > 0) {
921                        # Here we need to add flanking data. Convert the locations to a list
922                        # of location objects.
923                        my @locObjects = map { BasicLocation->new($_) } @locList;
924                        # Initialize the return variable. We will put the DNA in here segment by segment.
925                        $fastaData = "";
926                        # Now we widen each location by the flanking width and stash the results. This
927                        # requires getting the contig length for each contig so we don't fall off the end.
928                        for my $locObject (@locObjects) {
929                            Trace("Current location is " . $locObject->String . ".") if T(4);
930                            # Remember the current start and length.
931                            my ($start, $len) = ($locObject->Left, $locObject->Length);
932                            # Get the contig length.
933                            my $contigLen = $sprout->ContigLength($locObject->Contig);
934                            # Widen the location and get its DNA.
935                            $locObject->Widen($flankingWidth, $contigLen);
936                            my $fastaSegment = $sprout->DNASeq([$locObject->String()]);
937                            # Now we need to do some case changing. The main DNA is upper case and
938                            # the flanking DNA is lower case.
939                            my $leftFlank = $start - $locObject->Left;
940                            my $rightFlank = $leftFlank + $len;
941                            Trace("Wide location is " . $locObject->String . ". Flanks are $leftFlank and $rightFlank. Contig len is $contigLen.") if T(4);
942                            my $fancyFastaSegment = lc(substr($fastaSegment, 0, $leftFlank)) .
943                                                    uc(substr($fastaSegment, $leftFlank, $rightFlank - $leftFlank)) .
944                                                    lc(substr($fastaSegment, $rightFlank));
945                            $fastaData .= $fancyFastaSegment;
946                        }
947                    } else {
948                        # Here we have just the raw sequence.
949                  $fastaData = $sprout->DNASeq(\@locList);                  $fastaData = $sprout->DNASeq(\@locList);
950                  Trace(length $fastaData . " characters returned for DNA of $fastaLabel.") if T(3);                  }
951                    Trace((length $fastaData) . " characters returned for DNA of $fastaLabel.") if T(3);
952              }              }
953          }          }
954      } else {      } else {
# Line 1101  Line 963 
963              Trace("No label found in match to sequence:\n$sequence") if T(4);              Trace("No label found in match to sequence:\n$sequence") if T(4);
964              # 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
965              # as data.              # as data.
966              $fastaLabel = "User-specified $desiredType sequence";              $fastaLabel = "$desiredType sequence specified by user";
967              $fastaData = $sequence;              $fastaData = $sequence;
968          }          }
969          # The next step is to clean the junk out of the sequence.          # If we are not doing a pattern search, we need to clean the junk out of the sequence.
970            if ($desiredType !~ /pattern/i) {
971          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
972          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
973            }
974          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
975          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {
976              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
977              $okFlag = 0;              $okFlag = 0;
978          }          }
# Line 1116  Line 980 
980      Trace("FASTA data sequence: $fastaData") if T(4);      Trace("FASTA data sequence: $fastaData") if T(4);
981      # Only proceed if no error was detected.      # Only proceed if no error was detected.
982      if ($okFlag) {      if ($okFlag) {
983            if ($desiredType =~ /pattern/i) {
984                # For a scan, there is no label and no breakup.
985                $retVal = $fastaData;
986            } else {
987          # 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
988          # grep-split trick. The split, because of the presence of the parentheses,          # grep-split trick. The split, because of the presence of the parentheses,
989          # includes the matched delimiters in the output list. The grep strips out          # includes the matched delimiters in the output list. The grep strips out
# Line 1124  Line 992 
992          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;          my @chunks = grep { $_ } split /(.{1,60})/, $fastaData;
993          $retVal = join("\n", ">$fastaLabel", @chunks, "");          $retVal = join("\n", ">$fastaLabel", @chunks, "");
994      }      }
995        }
996      # Return the result.      # Return the result.
997      return $retVal;      return $retVal;
998  }  }
# Line 1337  Line 1206 
1206      # Get the form name.      # Get the form name.
1207      my $formName = $self->FormName();      my $formName = $self->FormName();
1208      # Check to see if we already have a genome list in memory.      # Check to see if we already have a genome list in memory.
     my $genomes = $self->{genomeList};  
1209      my $groupHash;      my $groupHash;
1210        my @groups;
1211        my $nmpdrGroupCount;
1212        my $genomes = $self->{genomeList};
1213      if (defined $genomes) {      if (defined $genomes) {
1214          # We have a list ready to use.          # We have a list ready to use.
1215          $groupHash = $genomes;          $groupHash = $genomes;
1216            @groups = @{$self->{groupList}};
1217            $nmpdrGroupCount = $self->{groupCount};
1218      } else {      } else {
1219          # 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
1220          # by name (genus,species,strain), but putting primary-group in front enables us to          # by name (genus,species,strain), but putting primary-group in front enables us to
# Line 1350  Line 1223 
1223                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",                                           "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",
1224                                           [], ['Genome(primary-group)', 'Genome(id)',                                           [], ['Genome(primary-group)', 'Genome(id)',
1225                                                'Genome(genus)', 'Genome(species)',                                                'Genome(genus)', 'Genome(species)',
1226                                                'Genome(unique-characterization)']);                                                'Genome(unique-characterization)',
1227                                                  'Genome(taxonomy)']);
1228          # 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
1229          # 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
1230          # name.          # name.
1231          my %gHash = ();          my %gHash = ();
1232          for my $genome (@genomeList) {          for my $genome (@genomeList) {
1233              # Get the genome data.              # Get the genome data.
1234              my ($group, $genomeID, $genus, $species, $strain) = @{$genome};              my ($group, $genomeID, $genus, $species, $strain, $taxonomy) = @{$genome};
1235              # Compute and cache its name and display group.              # Compute and cache its name and display group.
1236              my ($name, $displayGroup) = $self->SaveOrganismData($group, $genomeID, $genus, $species,              my ($name, $displayGroup, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,
1237                                                                  $strain);                                                                           $strain, $taxonomy);
1238              # Push the genome into the group's list. Note that we use the real group              # Push the genome into the group's list. Note that we use the real group
1239              # name here, not the display group name.              # name here, not the display group name.
1240              push @{$gHash{$group}}, [$genomeID, $name];              push @{$gHash{$group}}, [$genomeID, $name, $domain];
1241            }
1242            # We are almost ready to unroll the menu out of the group hash. The final step is to separate
1243            # the supporting genomes by domain. First, we sort the NMPDR groups.
1244            @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %gHash;
1245            # Remember the number of NMPDR groups.
1246            $nmpdrGroupCount = scalar @groups;
1247            # Loop through the supporting genomes, classifying them by domain. We'll also keep a list
1248            # of the domains found.
1249            my @otherGenomes = @{$gHash{$FIG_Config::otherGroup}};
1250            my @domains = ();
1251            for my $genomeData (@otherGenomes) {
1252                my ($genomeID, $name, $domain) = @{$genomeData};
1253                if (exists $gHash{$domain}) {
1254                    push @{$gHash{$domain}}, $genomeData;
1255                } else {
1256                    $gHash{$domain} = [$genomeData];
1257                    push @domains, $domain;
1258                }
1259          }          }
1260            # Add the domain groups at the end of the main group list. The main group list will now
1261            # contain all the categories we need to display the genomes.
1262            push @groups, sort @domains;
1263            # Delete the supporting group.
1264            delete $gHash{$FIG_Config::otherGroup};
1265          # Save the genome list for future use.          # Save the genome list for future use.
1266          $self->{genomeList} = \%gHash;          $self->{genomeList} = \%gHash;
1267            $self->{groupList} = \@groups;
1268            $self->{groupCount} = $nmpdrGroupCount;
1269          $groupHash = \%gHash;          $groupHash = \%gHash;
1270      }      }
     # Now we are ready to unroll the menu out of the group hash. First, we sort the groups, putting  
     # the supporting-genome group last.  
     my @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %{$groupHash};  
     push @groups, $FIG_Config::otherGroup;  
1271      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal      # Next, create a hash that specifies the pre-selected entries. Note that we need to deal
1272      # with the possibility of undefined values in the incoming list.      # with the possibility of undefined values in the incoming list.
1273      my %selectedHash = ();      my %selectedHash = ();
# Line 1409  Line 1304 
1304          # Get the genomes in the group.          # Get the genomes in the group.
1305          for my $genome (@{$groupHash->{$group}}) {          for my $genome (@{$groupHash->{$group}}) {
1306              # Count this organism if it's NMPDR.              # Count this organism if it's NMPDR.
1307              if ($group ne $FIG_Config::otherGroup) {              if ($nmpdrGroupCount > 0) {
1308                  $nmpdrCount++;                  $nmpdrCount++;
1309              }              }
1310              # Get the organism ID and name.              # Get the organism ID, name, and domain.
1311              my ($genomeID, $name) = @{$genome};              my ($genomeID, $name, $domain) = @{$genome};
1312              # See if it's selected.              # See if it's selected.
1313              my $select = ($selectedHash{$genomeID} ? " selected" : "");              my $select = ($selectedHash{$genomeID} ? " selected" : "");
1314              # Generate the option tag.              # Generate the option tag.
1315              my $optionTag = "<OPTION value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";              my $optionTag = "<OPTION class=\"$domain\" value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";
1316              push @lines, "    $optionTag";              push @lines, "    $optionTag";
1317          }          }
1318          # Close the option group.          # Close the option group.
1319          push @lines, "  </OPTGROUP>";          push @lines, "  </OPTGROUP>";
1320            # Record this group in the nmpdrGroup count. When that gets to 0, we've finished the NMPDR
1321            # groups.
1322            $nmpdrGroupCount--;
1323      }      }
1324      # Close the SELECT tag.      # Close the SELECT tag.
1325      push @lines, "</SELECT>";      push @lines, "</SELECT>";
# Line 1432  Line 1330 
1330          # the text selected automatically.          # the text selected automatically.
1331          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
1332          push @lines, "<br />" .          push @lines, "<br />" .
1333                       "<INPUT type=\"button\" name=\"Search\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .                       "<INPUT type=\"button\" name=\"MacroSearch\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .
1334                       "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";                       "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />" . Hint("Enter a genome number click the button to the left " .
1335                                                                                                "in order to select the genome with that number. " .
1336                                                                                                "Enter a genus, species, or strain and click the " .
1337                                                                                                "button to select all genomes with that genus, species, " .
1338                                                                                                "or strain name.");
1339          # Next are the buttons to set and clear selections.          # Next are the buttons to set and clear selections.
1340          push @lines, "<br />";          push @lines, "<br />";
1341          push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";          push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";
# Line 1602  Line 1504 
1504      my $realCaption = (defined $caption ? $caption : 'Go');      my $realCaption = (defined $caption ? $caption : 'Go');
1505      # Get the current page size.      # Get the current page size.
1506      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1507      # Get the incoming external-link flag.      # Get the current feature ID type.
1508      my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);      my $aliasType = $self->GetPreferredAliasType();
1509      # Create the row.      # Create the rows.
1510      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("ID Type"), $cgi->td({ colspan => 2 },
1511                                                            $cgi->popup_menu(-name => 'AliasType',
1512                                                                             -values => ['FIG', AliasAnalysis::AliasTypes() ],
1513                                                                             -default => $aliasType) .
1514                                                            Hint("Specify how you want gene names to be displayed."))) .
1515                     "\n" .
1516                     $cgi->Tr($cgi->td("Results/Page"),
1517                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1518                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1519                                                      -default => $pageSize)),                                                      -default => $pageSize)),
# Line 1616  Line 1524 
1524      return $retVal;      return $retVal;
1525  }  }
1526    
 =head3 FeatureFilterRows  
   
 C<< my $htmlText = $shelp->FeatureFilterRows(@subset); >>  
   
 This method creates table rows that can be used to filter features. The form  
 values can be used to select features by genome using the B<FeatureQuery>  
 object.  
   
 =over 4  
   
 =item subset  
   
 List of rows to display. The default (C<all>) is to display all rows.  
 C<words> displays the word search box, C<subsys> displays the subsystem  
 selector, and C<options> displays the options row.  
   
 =item RETURN  
   
 Returns the html text for table rows containing the desired feature filtering controls.  
   
 =back  
   
 =cut  
   
 sub FeatureFilterRows {  
     # Get the parameters.  
     my ($self, @subset) = @_;  
     if (@subset == 0 || $subset[0] eq 'all') {  
         @subset = qw(words subsys options);  
     }  
     # Return the result.  
     return FeatureQuery::FilterRows($self, @subset);  
 }  
   
 =head3 GBrowseFeatureURL  
   
 C<< my $url = SearchHelper::GBrowseFeatureURL($sprout, $feat); >>  
   
 Compute the URL required to pull up a Gbrowse page for the the specified feature.  
 In order to do this, we need to pull out the ID of the feature's Genome, its  
 contig ID, and some rough starting and stopping offsets.  
   
 =over 4  
   
 =item sprout  
   
 Sprout object for accessing the database.  
   
 =item feat  
   
 ID of the feature whose Gbrowse URL is desired.  
   
 =item RETURN  
   
 Returns a GET-style URL for the Gbrowse CGI, with parameters specifying the genome  
 ID, contig ID, starting offset, and stopping offset.  
   
 =back  
   
 =cut  
   
 sub GBrowseFeatureURL {  
     # Get the parameters.  
     my ($sprout, $feat) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Compute the genome ID.  
     my ($genomeID) = FIGRules::ParseFeatureID($feat);  
     # Only proceed if the feature ID produces a valid genome.  
     if ($genomeID) {  
         # Get the feature location string.  
         my $loc = $sprout->FeatureLocation($feat);  
         # Compute the contig, start, and stop points.  
         my($contig, $start, $stop) = BasicLocation::Parse($loc);  
         Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);  
         # Now we need to do some goofiness to insure that the location is not too  
         # big and that we get some surrounding stuff.  
         my $mid = int(($start + $stop) / 2);  
         my $chunk_len = 20000;  
         my $max_feature = 40000;  
         my $feat_len = abs($stop - $start);  
         if ($feat_len > $chunk_len) {  
             if ($feat_len > $max_feature) {  
                 $chunk_len = $max_feature;  
             } else {  
                 $chunk_len = $feat_len + 100;  
             }  
         }  
         my($show_start, $show_stop);  
         if ($chunk_len == $max_feature) {  
             $show_start = $start - 300;  
         } else {  
             $show_start = $mid - int($chunk_len / 2);  
         }  
         if ($show_start < 1) {  
             $show_start = 1;  
         }  
         $show_stop = $show_start + $chunk_len - 1;  
         my $clen = $sprout->ContigLength($contig);  
         if ($show_stop > $clen) {  
             $show_stop = $clen;  
         }  
         my $seg_id = $contig;  
         $seg_id =~ s/:/--/g;  
         Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);  
         # Assemble all the pieces.  
         $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id;start=$show_start;stop=$show_stop";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
1527  =head3 GetGenomes  =head3 GetGenomes
1528    
1529  C<< my @genomeList = $shelp->GetGenomes($parmName); >>  C<< my @genomeList = $shelp->GetGenomes($parmName); >>
# Line 1906  Line 1702 
1702      return $retVal;      return $retVal;
1703  }  }
1704    
 =head3 GetRunTimeValue  
   
 C<< my $htmlText = $shelp->GetRunTimeValue($text); >>  
   
 Compute a run-time column value.  
   
 =over 4  
   
 =item text  
   
 The run-time column text. It consists of 2 percent signs, a column type, an equal  
 sign, and the data for the current row.  
   
 =item RETURN  
   
 Returns the fully-formatted HTML text to go into the current column of the current row.  
   
 =back  
   
 =cut  
   
 sub GetRunTimeValue {  
     # Get the parameters.  
     my ($self, $text) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Parse the incoming text.  
     if ($text =~ /^%%([^=]+)=(.*)$/) {  
         $retVal = $self->RunTimeColumns($1, $2);  
     } else {  
         Confess("Invalid run-time column string \"$text\" encountered in session file.");  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
1705  =head3 AdvancedClassList  =head3 AdvancedClassList
1706    
1707  C<< my @classes = SearchHelper::AdvancedClassList(); >>  C<< my @classes = SearchHelper::AdvancedClassList(); >>
# Line 1949  Line 1709 
1709  Return a list of advanced class names. This list is used to generate the directory  Return a list of advanced class names. This list is used to generate the directory
1710  of available searches on the search page.  of available searches on the search page.
1711    
1712  We use the %INC variable to accomplish this.  We do a file search to accomplish this, but to pull it off we need to look at %INC.
1713    
1714  =cut  =cut
1715    
1716  sub AdvancedClassList {  sub AdvancedClassList {
1717      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;      # Determine the search helper module directory.
1718      return @retVal;      my $libDirectory = $INC{'SearchHelper.pm'};
1719        $libDirectory =~ s/SearchHelper\.pm//;
1720        # Read it, keeping only the helper modules.
1721        my @modules = grep { /^SH\w+\.pm/ } Tracer::OpenDir($libDirectory, 0);
1722        # Convert the file names to search types.
1723        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } @modules;
1724        # Return the result in alphabetical order.
1725        return sort @retVal;
1726  }  }
1727    
1728  =head3 SelectionTree  =head3 SelectionTree
# Line 2330  Line 2097 
2097      return $retVal;      return $retVal;
2098  }  }
2099    
2100  =head2 Feature Column Methods  =head3 PrintLine
   
 The methods in this section manage feature column data. If you want to provide the  
 capability to include new types of data in feature columns, then all the changes  
 are made to this section of the source file. Technically, this should be implemented  
 using object-oriented methods, but this is simpler for non-programmers to maintain.  
 To add a new column of feature data, you must first give it a name. For example,  
 the name for the protein page link column is C<protlink>. If the column is to appear  
 in the default list of feature columns, add it to the list returned by  
 L</DefaultFeatureColumns>. Then add code to produce the column title to  
 L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>. If the  
 feature column should be excluded from downloads, add it to the C<FeatureColumnSkip>  
 hash. Everything else will happen automatically.  
   
 There is a special column name syntax for extra columns (that is, nonstandard  
 feature columns). If the column name begins with C<X=>, then it is presumed to be  
 an extra column. The column title is the text after the C<X=>, and its value is  
 pulled from the extra column hash.  
   
 =cut  
   
 # This hash is used to determine which columns should not be included in downloads.  
 my %FeatureColumnSkip = map { $_ => 1 } qw(gblink viewerlink protlink);  
   
 =head3 DefaultFeatureColumns  
   
 C<< my @colNames = $shelp->DefaultFeatureColumns(); >>  
   
 Return a list of the default feature column identifiers. These identifiers can  
 be passed to L</FeatureColumnTitle> and L</FeatureColumnValue> in order to  
 produce the column titles and row values.  
   
 =cut  
   
 sub DefaultFeatureColumns {  
     # Get the parameters.  
     my ($self) = @_;  
     # Return the result.  
     return qw(orgName function gblink protlink);  
 }  
   
 =head3 FeatureColumnTitle  
   
 C<< my $title = $shelp->FeatureColumnTitle($colName); >>  
   
 Return the column heading title to be used for the specified feature column.  
   
 =over 4  
   
 =item name  
   
 Name of the desired feature column.  
   
 =item RETURN  
   
 Returns the title to be used as the column header for the named feature column.  
   
 =back  
   
 =cut  
   
 sub FeatureColumnTitle {  
     # Get the parameters.  
     my ($self, $colName) = @_;  
     # Declare the return variable. We default to a blank column name.  
     my $retVal = "&nbsp;";  
     # Process the column name.  
     if ($colName =~ /^X=(.+)$/) {  
         # Here we have an extra column.  
         $retVal = $1;  
     } elsif ($colName eq 'alias') {  
         $retVal = "External Aliases";  
     } elsif ($colName eq 'fid') {  
         $retVal = "FIG ID";  
     } elsif ($colName eq 'function') {  
         $retVal = "Functional Assignment";  
     } elsif ($colName eq 'gblink') {  
         $retVal = "GBrowse";  
     } elsif ($colName eq 'group') {  
         $retVal = "NMDPR Group";  
     } elsif ($colName =~ /^keyword:(.+)$/) {  
         $retVal = ucfirst $1;  
     } elsif ($colName eq 'orgName') {  
         $retVal = "Organism and Gene ID";  
     } elsif ($colName eq 'protlink') {  
         $retVal = "NMPDR Protein Page";  
     } elsif ($colName eq 'viewerlink') {  
         $retVal = "Annotation Page";  
     } elsif ($colName eq 'subsystem') {  
         $retVal = "Subsystems";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 FeatureColumnDownload  
2101    
2102  C<< my $keep = $shelp->FeatureColumnDownload($colName); >>  C<< $shelp->PrintLine($message); >>
2103    
2104  Return TRUE if the named feature column is to be kept when downloading, else FALSE.  Print a line of CGI output. This is used during the operation of the B<Find> method while
2105    searching, so the user sees progress in real-time.
2106    
2107  =over 4  =over 4
2108    
2109  =item colName  =item message
   
 Name of the relevant feature column.  
   
 =item RETURN  
2110    
2111  Return TRUE if the named column should be kept while downloading, else FALSE. In general,  HTML text to display.
 FALSE is returned if the column generates a button, image, or other purely-HTML value.  
2112    
2113  =back  =back
2114    
2115  =cut  =cut
2116    
2117  sub FeatureColumnDownload {  sub PrintLine {
2118      # Get the parameters.      # Get the parameters.
2119      my ($self, $colName) = @_;      my ($self, $message) = @_;
2120      # Return the determination. We download the column if it's not in the skip-hash.      # Send them to the output.
2121      # Note we return 0 and 1 instead of 1 and undef because it simplifies some tracing.      print "$message\n";
     return (exists $FeatureColumnSkip{$colName} ? 0 : 1);  
2122  }  }
2123    
2124    =head3 GetHelper
2125    
2126  =head3 FeatureColumnValue  C<< my $shelp = SearchHelper::GetHelper($parm, $type => $className); >>
2127    
2128  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  Return a helper object with the given class name. If no such class exists, an
2129    error will be thrown.
 Return the value to be displayed in the specified feature column.  
2130    
2131  =over 4  =over 4
2132    
2133  =item colName  =item parm
   
 Name of the column to be displayed.  
   
 =item record  
   
 ERDBObject record for the feature being displayed in the current row.  
   
 =item extraCols  
   
 Reference to a hash of extra column names to values. If the incoming column name  
 begins with C<X=>, its value will be taken from this hash.  
   
 =item RETURN  
   
 Returns the HTML to be displayed in the named column for the specified feature.  
   
 =back  
   
 =cut  
   
 sub FeatureColumnValue {  
     # Get the parameters.  
     my ($self, $colName, $record, $extraCols) = @_;  
     # Get the sprout and CGI objects.  
     my $cgi = $self->Q();  
     my $sprout = $self->DB();  
     # Get the feature ID.  
     my ($fid) = $record->Value('Feature(id)');  
     # Declare the return variable. Denote that we default to a non-breaking space,  
     # which will translate to an empty table cell (rather than a table cell with no  
     # interior, which is what you get for a null string).  
     my $retVal = "&nbsp;";  
     # Process according to the column name.  
     if ($colName =~ /^X=(.+)$/) {  
         # Here we have an extra column. Only update if the value exists. Note that  
         # a value of C<undef> is treated as a non-existent value, because the  
         # caller may have put "colName => undef" in the "PutFeature" call in order  
         # to insure we know the extra column exists.  
         if (defined $extraCols->{$1}) {  
             $retVal = $extraCols->{$1};  
         }  
     } elsif ($colName eq 'alias') {  
         # In this case, the user wants a list of external aliases for the feature.  
         # These are very expensive, so we compute them when the row is displayed.  
         # To do the computation, we need to know the favored alias type and the  
         # feature ID.  
         my $favored = $cgi->param("FavoredAlias") || "fig";  
         $retVal = "%%alias=$fid,$favored";  
     } elsif ($colName eq 'fid') {  
         # Here we have the raw feature ID. We hyperlink it to the protein page.  
         $retVal = HTML::set_prot_links($fid);  
     } elsif ($colName eq 'function') {  
         # The functional assignment is just a matter of getting some text.  
         ($retVal) = $record->Value('Feature(assignment)');  
     } elsif ($colName eq 'gblink') {  
         # Here we want a link to the GBrowse page using the official GBrowse button.  
         $retVal = FakeButton('GBrowse', "GetGBrowse.cgi", undef,  
                           fid => $fid);  
     } elsif ($colName eq 'group') {  
         # Get the NMPDR group name.  
         my (undef, $group) = $self->OrganismData($fid);  
         # Dress it with a URL to the group's main page.  
         my $nurl = $sprout->GroupPageName($group);  
         $retVal = $cgi->a({ href => $nurl, title => "$group summary" },  
                           $group);  
     } elsif ($colName =~ /^keyword:(.+)$/) {  
         # Here we want keyword-related values. This is also expensive, so  
         # we compute them when the row is displayed.  
         $retVal = "%%$colName=$fid";  
     } elsif ($colName eq 'orgName') {  
         # Here we want the formatted organism name and feature number.  
         $retVal = $self->FeatureName($fid);  
     } elsif ($colName eq 'protlink') {  
         # Here we want a link to the protein page using the official NMPDR button.  
         $retVal = FakeButton('NMPDR', "protein.cgi", undef,  
                           prot => $fid, SPROUT => 1, new_framework => 0,  
                           user => '');  
     } elsif ($colName eq 'viewerlink') {  
         # Here we want a link to the SEED viewer page using the official viewer button.  
         $retVal = FakeButton('Annotation', "index.cgi", undef,  
                              action => 'ShowAnnotation', prot => $fid);  
     } elsif ($colName eq 'subsystem') {  
         # Another run-time column: subsystem list.  
         $retVal = "%%subsystem=$fid";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 RunTimeColumns  
2134    
2135  C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>  Parameter to pass to the constructor. This is a CGI object for a search helper
2136    and a search helper object for the result helper.
 Return the HTML text for a run-time column. Run-time columns are evaluated when the  
 list is displayed, rather than when it is generated.  
   
 =over 4  
2137    
2138  =item type  =item type
2139    
2140  Type of column.  Type of helper: C<RH> for a result helper and C<SH> for a search helper.
2141    
2142  =item text  =item className
2143    
2144  Data relevant to this row of the column.  Class name for the helper object, without the preceding C<SH> or C<RH>. This is
2145    identical to what the script expects for the C<Class> or C<ResultType> parameter.
2146    
2147  =item RETURN  =item RETURN
2148    
2149  Returns the fully-formatted HTML text to go in the specified column.  Returns a helper object for the specified class.
2150    
2151  =back  =back
2152    
2153  =cut  =cut
2154    
2155  sub RunTimeColumns {  sub GetHelper {
2156      # Get the parameters.      # Get the parameters.
2157      my ($self, $type, $text) = @_;      my ($parm, $type, $className) = @_;
2158      # Declare the return variable.      # Declare the return variable.
2159      my $retVal = "";      my $retVal;
2160      # Get the Sprout and CGI objects.      # Try to create the helper.
2161      my $sprout = $self->DB();      eval {
2162      my $cgi = $self->Q();          # Load it into memory. If it's already there nothing will happen here.
2163      Trace("Runtime column $type with text \"$text\" found.") if T(4);          my $realName = "$type$className";
2164      # Separate the text into a type and data.          Trace("Requiring helper $realName.") if T(3);
2165      if ($type eq 'alias') {          require "$realName.pm";
2166          # Here the caller wants external alias links for a feature. The text          Trace("Constructing helper object.") if T(3);
2167          # parameter for computing the alias is the feature ID followed by          # Construct the object.
2168          # the favored alias type.          $retVal = eval("$realName->new(\$parm)");
2169          my ($fid, $favored) = split /\s*,\s*/, $text;          # Commit suicide if it didn't work.
2170          # The complicated part is we have to hyperlink them and handle the          if (! defined $retVal) {
2171          # favorites. First, get the aliases.              die "Could not find a $type handler of type $className.";
         Trace("Generating aliases for feature $fid.") if T(4);  
         my @aliases = sort $sprout->FeatureAliases($fid);  
         # Only proceed if we found some.  
         if (@aliases) {  
             # Split the aliases into favored and unfavored.  
             my @favored = ();  
             my @unfavored = ();  
             for my $alias (@aliases) {  
                 # Use substr instead of pattern match because $favored is specified by the user  
                 # and we don't want him to put funny meta-characters in there.  
                 if (substr($alias, 0, length($favored)) eq $favored) {  
                     push @favored, $alias;  
                 } else {  
                     push @unfavored, $alias;  
                 }  
2172              }              }
2173              # Rejoin the aliases into a comma-delimited list, with the favored ones first.      };
2174              my $aliasList = join(", ", @favored, @unfavored);      # Check for errors.
2175              # Ask the HTML processor to hyperlink them.      if ($@) {
2176              $retVal = HTML::set_prot_links($cgi, $aliasList);          Confess("Error retrieving $type$className: $@");
         }  
     } elsif ($type eq 'subsystem') {  
         # Here the caller wants the subsystems in which this feature participates.  
         # The text is the feature ID. We will list the subsystem names with links  
         # to the subsystem's summary page.  
         my $fid = $text;  
         # Get the subsystems.  
         Trace("Generating subsystems for feature $fid.") if T(4);  
         my %subs = $sprout->SubsystemsOf($fid);  
         # Extract the subsystem names.  
         my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;  
         # String them into a list.  
         $retVal = join(", ", @names);  
     } elsif ($type =~ /^keyword:(.+)$/) {  
         # Here the caller wants the value of the named keyword. The text is the  
         # feature ID.  
         my $keywordName = $1;  
         my $fid = $text;  
         # Get the attribute values.  
         Trace("Getting $keywordName values for feature $fid.") if T(4);  
         my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],  
                                       "Feature($keywordName)");  
         # String them into a list.  
         $retVal = join(", ", @values);  
2177      }      }
2178      # Return the result.      # Return the result.
2179      return $retVal;      return $retVal;
# Line 2646  Line 2181 
2181    
2182  =head3 SaveOrganismData  =head3 SaveOrganismData
2183    
2184  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain); >>  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); >>
2185    
2186  Format the name of an organism and the display version of its group name. The incoming  Format the name of an organism and the display version of its group name. The incoming
2187  data should be the relevant fields from the B<Genome> record in the database. The  data should be the relevant fields from the B<Genome> record in the database. The
# Line 2676  Line 2211 
2211    
2212  Strain of the species represented by the genome.  Strain of the species represented by the genome.
2213    
2214    =item taxonomy
2215    
2216    Taxonomy of the species represented by the genome.
2217    
2218  =item RETURN  =item RETURN
2219    
2220  Returns a two-element list. The first element is the formatted genome name. The second  Returns a three-element list. The first element is the formatted genome name. The second
2221  element is the display name of the genome's group.  element is the display name of the genome's group. The third is the genome's domain.
2222    
2223  =back  =back
2224    
# Line 2687  Line 2226 
2226    
2227  sub SaveOrganismData {  sub SaveOrganismData {
2228      # Get the parameters.      # Get the parameters.
2229      my ($self, $group, $genomeID, $genus, $species, $strain) = @_;      my ($self, $group, $genomeID, $genus, $species, $strain, $taxonomy) = @_;
2230      # Declare the return values.      # Declare the return values.
2231      my ($name, $displayGroup);      my ($name, $displayGroup);
2232      # If the organism does not exist, format an unknown name and a blank group.      # If the organism does not exist, format an unknown name and a blank group.
# Line 2704  Line 2243 
2243          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2244          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2245      }      }
2246        # Compute the domain from the taxonomy.
2247        my ($domain) = split /\s*;\s*/, $taxonomy, 2;
2248      # Cache the group and organism data.      # Cache the group and organism data.
2249      my $cache = $self->{orgs};      my $cache = $self->{orgs};
2250      $cache->{$genomeID} = [$name, $displayGroup];      $cache->{$genomeID} = [$name, $displayGroup, $domain];
2251      # Return the result.      # Return the result.
2252      return ($name, $displayGroup);      return ($name, $displayGroup, $domain);
2253  }  }
2254    
2255  =head3 ValidateKeywords  =head3 ValidateKeywords
# Line 2761  Line 2302 
2302      return $retVal;      return $retVal;
2303  }  }
2304    
2305  =head3 FakeButton  =head3 TuningParameters
   
 C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>  
2306    
2307  Create a fake button that hyperlinks to the specified URL with the specified parameters.  C<< my $options = $shelp->TuningParameters(%parmHash); >>
 Unlike a real button, this one won't visibly click, but it will take the user to the  
 correct place.  
2308    
2309  The parameters of this method are deliberately identical to L</Formlet> so that we  Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names
2310  can switch easily from real buttons to fake ones in the code.  to their default values. The parameters and their values will be returned as a hash reference.
2311    
2312  =over 4  =over 4
2313    
2314  =item caption  =item parmHash
2315    
2316  Caption to be put on the button.  Hash mapping parameter names to their default values.
2317    
2318  =item url  =item RETURN
   
 URL for the target page or script.  
   
 =item target  
   
 Frame or target in which the new page should appear. If C<undef> is specified,  
 the default target will be used.  
   
 =item parms  
2319    
2320  Hash containing the parameter names as keys and the parameter values as values.  Returns a reference to a hash containing the parameter names mapped to their actual values.
 These will be appended to the URL.  
2321    
2322  =back  =back
2323    
2324  =cut  =cut
2325    
2326  sub FakeButton {  sub TuningParameters {
2327      # Get the parameters.      # Get the parameters.
2328      my ($caption, $url, $target, %parms) = @_;      my ($self, %parmHash) = @_;
2329      # Declare the return variable.      # Declare the return variable.
2330      my $retVal;      my $retVal = {};
2331      # Compute the target URL.      # Get the CGI Query Object.
2332      my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);      my $cgi = $self->Q();
2333      # Compute the target-frame HTML.      # Loop through the parameter names.
2334      my $targetHtml = ($target ? " target=\"$target\"" : "");      for my $parm (keys %parmHash) {
2335      # Assemble the result.          # Get the incoming value for this parameter.
2336      return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";          my $value = $cgi->param($parm);
2337            # Zero might be a valid value, so we do an is-defined check rather than an OR.
2338            if (defined($value)) {
2339                $retVal->{$parm} = $value;
2340            } else {
2341                $retVal->{$parm} = $parmHash{$parm};
2342            }
2343        }
2344        # Return the result.
2345        return $retVal;
2346  }  }
2347    
2348  =head3 Formlet  =head3 GetPreferredAliasType
   
 C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>  
   
 Create a mini-form that posts to the specified URL with the specified parameters. The  
 parameters will be stored in hidden fields, and the form's only visible control will  
 be a submit button with the specified caption.  
   
 Note that we don't use B<CGI.pm> services here because they generate forms with extra characters  
 and tags that we don't want to deal with.  
   
 =over 4  
   
 =item caption  
   
 Caption to be put on the form button.  
   
 =item url  
   
 URL to be put in the form's action parameter.  
   
 =item target  
   
 Frame or target in which the form results should appear. If C<undef> is specified,  
 the default target will be used.  
   
 =item parms  
2349    
2350  Hash containing the parameter names as keys and the parameter values as values.  C<< my $type = $shelp->GetPreferredAliasType(); >>
2351    
2352  =back  Return the preferred alias type for the current session. This information is stored
2353    in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>
2354    (which indicates the FIG ID).
2355    
2356  =cut  =cut
2357    
2358  sub Formlet {  sub GetPreferredAliasType {
2359      # Get the parameters.      # Get the parameters.
2360      my ($caption, $url, $target, %parms) = @_;      my ($self) = @_;
2361      # Compute the target HTML.      # Determine the preferred type.
2362      my $targetHtml = ($target ? " target=\"$target\"" : "");      my $cgi = $self->Q();
2363      # Start the form.      my $retVal = $cgi->param('AliasType') || 'FIG';
2364      my $retVal = "<form method=\"POST\" action=\"$url\"$target>";      # Return it.
     # Add the parameters.  
     for my $parm (keys %parms) {  
         $retVal .= "<input type=\"hidden\" name=\"$parm\" value=\"$parms{$parm}\" />";  
     }  
     # Put in the button.  
     $retVal .= "<input type=\"submit\" name=\"submit\" value=\"$caption\" class=\"button\" />";  
     # Close the form.  
     $retVal .= "</form>";  
     # Return the result.  
2365      return $retVal;      return $retVal;
2366  }  }
2367    
# Line 2879  Line 2382 
2382  returned. If the search parameters are invalid, a result count of C<undef> will be  returned. If the search parameters are invalid, a result count of C<undef> will be
2383  returned and a result message will be stored in this object describing the problem.  returned and a result message will be stored in this object describing the problem.
2384    
2385    =cut
2386    
2387    sub Find {
2388        # Get the parameters.
2389        my ($self) = @_;
2390        $self->Message("Call to pure virtual Find method in helper of type " . ref($self) . ".");
2391        return undef;
2392    }
2393    
2394  =head3 Description  =head3 Description
2395    
2396  C<< my $htmlText = $shelp->Description(); >>  C<< my $htmlText = $shelp->Description(); >>
# Line 2887  Line 2399 
2399  on the main search tools page. It may contain HTML, but it should be character-level,  on the main search tools page. It may contain HTML, but it should be character-level,
2400  not block-level, since the description is going to appear in a list.  not block-level, since the description is going to appear in a list.
2401    
2402  =head3 SortKey  =cut
2403    
2404  C<< my $key = $shelp->SortKey($fdata); >>  sub Description {
2405        # Get the parameters.
2406        my ($self) = @_;
2407        $self->Message("Call to pure virtual Description method in helper of type " . ref($self) . ".");
2408        return "Unknown search type";
2409    }
2410    
2411  Return the sort key for the specified feature data. The default is to sort by feature name,  =head3 SearchTitle
 floating NMPDR organisms to the top. If a full-text search is used, then the default  
 sort is by relevance followed by feature name. This sort may be overridden by the  
 search class to provide fancier functionality. This method is called by  
 B<PutFeature>, so it is only used for feature searches. A non-feature search  
 would presumably have its own sort logic.  
2412    
2413  =over 4  C<< my $titleHtml = $shelp->SearchTitle(); >>
2414    
2415  =item record  Return the display title for this search. The display title appears above the search results.
2416    If no result is returned, no title will be displayed. The result should be an html string
2417    that can be legally put inside a block tag such as C<h3> or C<p>.
2418    
2419  The C<FeatureData> containing the current feature.  =cut
2420    
2421  =item RETURN  sub SearchTitle {
2422        # Get the parameters.
2423        my ($self) = @_;
2424        # Declare the return variable.
2425        my $retVal = "";
2426        # Return it.
2427        return $retVal;
2428    }
2429    
2430    =head3 DefaultColumns
2431    
2432    C<< $shelp->DefaultColumns($rhelp); >>
2433    
2434    Store the default columns in the result helper. The default action is just to ask
2435    the result helper for its default columns, but this may be changed by overriding
2436    this method.
2437    
2438    =over 4
2439    
2440    =item rhelp
2441    
2442  Returns a key field that can be used to sort this row in among the results.  Result helper object in which the column list should be stored.
2443    
2444  =back  =back
2445    
2446  =cut  =cut
2447    
2448  sub SortKey {  sub DefaultColumns {
2449      # Get the parameters.      # Get the parameters.
2450      my ($self, $fdata) = @_;      my ($self, $rhelp) = @_;
2451      # Get the feature ID from the record.      # Get the default columns from the result helper.
2452      my $fid = $fdata->FID();      my @cols = $rhelp->DefaultResultColumns();
2453      # Get the group from the feature ID.      # Store them back.
2454      my $group = $self->FeatureGroup($fid);      $rhelp->SetColumns(@cols);
     # Ask the feature query object to form the sort key.  
     my $retVal = $fdata->SortKey($self, $group);  
     # Return the result.  
     return $retVal;  
2455  }  }
2456    
2457  =head3 PrintLine  =head3 Hint
2458    
2459  C<< $shelp->PrintLine($message); >>  C<< my $htmlText = SearchHelper::Hint($hintText); >>
2460    
2461  Print a line of CGI output. This is used during the operation of the B<Find> method while  Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2462  searching, so the user sees progress in real-time.  This HTML can be put in forms to provide a useful hinting mechanism.
2463    
2464  =over 4  =over 4
2465    
2466  =item message  =item hintText
2467    
2468  HTML text to display.  Text to display for the hint. It is raw html, but may not contain any double quotes.
2469    
2470    =item RETURN
2471    
2472    Returns the html for the hint facility. The resulting html shows a small button-like thing that
2473    uses the standard FIG popup technology.
2474    
2475  =back  =back
2476    
2477  =cut  =cut
2478    
2479  sub PrintLine {  sub Hint {
2480      # Get the parameters.      # Get the parameters.
2481      my ($self, $message) = @_;      my ($hintText) = @_;
2482      # Send them to the output.      # Escape the single quotes.
2483      print "$message\n";      my $quotedText = $hintText;
2484        $quotedText =~ s/'/\\'/g;
2485        # Create the html.
2486        my $retVal = "&nbsp;<input type=\"button\" class=\"hintbutton\" onMouseOver=\"javascript:if (!this.tooltip) { " .
2487                     "this.tooltip = new Popup_Tooltip(this, 'Search Hint', '$quotedText', '', 1); this.tooltip.addHandler(); } " .
2488                     "return false;\" value=\"?\" />";
2489        # Return it.
2490        return $retVal;
2491  }  }
2492    
2493    

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.34

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3