[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.33, Tue Jun 19 21:28:21 2007 UTC revision 1.36, Wed Jul 25 16:21:21 2007 UTC
# Line 10  Line 10 
10      use File::Path;      use File::Path;
11      use File::stat;      use File::stat;
12      use LWP::UserAgent;      use LWP::UserAgent;
13      use Time::HiRes 'gettimeofday';      use FIGRules;
14      use Sprout;      use Sprout;
15      use SFXlate;      use SFXlate;
16      use FIGRules;      use FIGRules;
17      use HTML;      use HTML;
18      use BasicLocation;      use BasicLocation;
     use FeatureQuery;  
19      use URI::Escape;      use URI::Escape;
20      use PageBuilder;      use PageBuilder;
21      use POSIX;      use AliasAnalysis;
22        use FreezeThaw qw(freeze thaw);
23    
24  =head1 Search Helper Base Class  =head1 Search Helper Base Class
25    
# Line 66  Line 66 
66    
67  =item orgs  =item orgs
68    
69  Reference to a hash mapping genome IDs to organism names.  Reference to a hash mapping genome IDs to organism data. (Used to
70    improve performance.)
71    
72  =item name  =item name
73    
# Line 84  Line 85 
85    
86  List of the parameters that are used to select multiple genomes.  List of the parameters that are used to select multiple genomes.
87    
 =item filtered  
   
 TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this  
 field is updated by the B<FeatureQuery> object.  
   
 =item extraPos  
   
 Hash indicating which extra columns should be put at the end. Extra columns  
 not mentioned in this hash are put at the beginning. Use the L</SetExtraPos>  
 method to change this option.  
   
88  =back  =back
89    
90  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 110  Line 100 
100  =item 2  =item 2
101    
102  Create a new subclass of this object and implement each of the virtual methods. The  Create a new subclass of this object and implement each of the virtual methods. The
103  name of the subclass must be C<SH>I<className>.  name of the subclass must be C<SH>I<className>, where I<className> is the
104    type of search.
105    
106  =item 3  =item 3
107    
# Line 120  Line 111 
111    
112  =item 4  =item 4
113    
114  In the C<SearchSkeleton.cgi> script and add a C<use> statement for your search tool.  If your search produces a result for which a helper does not exist, you
115    must create a new subclass of B<ResultHelper>. Its name must be
116    C<RH>I<className>, where I<className> is the type of result.
117    
118  =back  =back
119    
# Line 156  Line 149 
149    
150  Several helper methods are provided for particular purposes.  Several helper methods are provided for particular purposes.
151    
 =over 4  
   
 =item 1  
   
152  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use  L</NmpdrGenomeMenu> generates a control for selecting one or more genomes. Use
153  L</GetGenomes> to retrieve all the genomes passed in for a specified parameter  L</GetGenomes> to retrieve all the genomes passed in for a specified parameter
154  name. Note that as an assist to people working with GET-style links, if no  name. Note that as an assist to people working with GET-style links, if no
155  genomes are specified and the incoming request style is GET, all genomes will  genomes are specified and the incoming request style is GET, all genomes will
156  be returned.  be returned.
157    
 =item 2  
   
 L</FeatureFilterRow> formats several rows of controls for filtering features.  
 When you start building the code for the L</Find> method, you can use a  
 B<FeatureQuery> object to automatically filter each genome's features using  
 the values from the filter controls.  
   
 =item 3  
   
158  L</QueueFormScript> allows you to queue JavaScript statements for execution  L</QueueFormScript> allows you to queue JavaScript statements for execution
159  after the form is fully generated. If you are using very complicated  after the form is fully generated. If you are using very complicated
160  form controls, the L</QueueFormScript> method allows you to perform  form controls, the L</QueueFormScript> method allows you to perform
161  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this  JavaScript initialization. The L</NmpdrGenomeMenu> control uses this
162  facility to display a list of the pre-selected genomes.  facility to display a list of the pre-selected genomes.
163    
 =back  
   
 If you are doing a feature search, you can also change the list of feature  
 columns displayed and their display order by overriding  
 L</DefaultFeatureColumns>.  
   
164  Finally, when generating the code for your controls, be sure to use any incoming  Finally, when generating the code for your controls, be sure to use any incoming
165  query parameters as default values so that the search request is persistent.  query parameters as default values so that the search request is persistent.
166    
167  =head3 Finding Search Results  =head3 Finding Search Results
168    
169  The L</Find> method is used to create the search results. For a search that  The L</Find> method is used to create the search results. The basic code
170  wants to return features (which is most of them), the basic code structure  structure would work as follows.
 would work as follows. It is assumed that the L</FeatureFilterRows> method  
 has been used to create feature filtering parameters.  
171    
172      sub Find {      sub Find {
173          my ($self) = @_;          my ($self) = @_;
# Line 208  Line 180 
180          ... validate the parameters ...          ... validate the parameters ...
181          if (... invalid parameters...) {          if (... invalid parameters...) {
182              $self->SetMessage(...appropriate message...);              $self->SetMessage(...appropriate message...);
183          } elsif (FeatureQuery::Valid($self)) {          } else {
184                # Determine the result type.
185                my $rhelp = SearchHelper::GetHelper($self, RH => $resultType);
186                # Specify the columns.
187                $self->DefaultColumns($rhelp);
188                # You may want to add extra columns. $name is the column name and
189                # $loc is its location. The other parameters take their names from the
190                # corresponding column methods.
191                $rhelp->AddExtraColumn($name => $loc, style => $style, download => $flag,
192                    title => $title);
193                # Some searches require optional columns that are configured by the
194                # user or by the search query itself. There are some special methods
195                # for this in the result helpers, but there's also the direct approach
196                # shown below.
197                $rhelp->AddOptionalColumn($name => $loc);
198              # Initialize the session file.              # Initialize the session file.
199              $self->OpenSession();              $self->OpenSession($rhelp);
200              # Initialize the result counter.              # Initialize the result counter.
201              $retVal = 0;              $retVal = 0;
202              ... get a list of genomes ...              ... set up to loop through the results ...
203              for my $genomeID (... each genome ...) {              while (...more results...) {
204                  my $fq = FeatureQuery->new($self, $genomeID);                  ...compute extra columns and call PutExtraColumns...
205                  while (my $feature = $fq->Fetch()) {                  $rhelp->PutData($sortKey, $objectID, $record);
                     ... examine the feature ...  
                     if (... we want to keep it ...) {  
                         $self->PutFeature($fq);  
206                          $retVal++;                          $retVal++;
207                      }                      }
                 }  
             }  
208              # Close the session file.              # Close the session file.
209              $self->CloseSession();              $self->CloseSession();
210          }          }
# Line 232  Line 213 
213      }      }
214    
215  A Find method is of course much more complicated than generating a form, and there  A Find method is of course much more complicated than generating a form, and there
216  are variations on the above theme. For example, you could eschew feature filtering  are variations on the above theme.
 entirely in favor of your own custom filtering, you could include extra columns  
 in the output, or you could search for something that's not a feature at all. The  
 above code is just a loose framework.  
217    
218  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
219  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 247  Line 225 
225  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
226  have been started so that everything is XHTML-compliant.  have been started so that everything is XHTML-compliant.
227    
 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);  
   
228  The L</Find> method must return C<undef> if the search parameters are invalid. If this  The L</Find> method must return C<undef> if the search parameters are invalid. If this
229  is the case, then a message describing the problem should be passed to the framework  is the case, then a message describing the problem should be passed to the framework
230  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 292  Line 265 
265          Trace("No session ID found.") if T(3);          Trace("No session ID found.") if T(3);
266          # Here we're starting a new session. We create the session ID and          # Here we're starting a new session. We create the session ID and
267          # store it in the query object.          # store it in the query object.
268          $session_id = NewSessionID();          $session_id = FIGRules::NewSessionID();
269            Trace("New session ID is $session_id.") if T(3);
270          $type = "new";          $type = "new";
271          $cgi->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
272      } else {      } else {
273          Trace("Session ID is $session_id.") if T(3);          Trace("Session ID is $session_id.") if T(3);
274      }      }
275        Trace("Computing subclass.") if T(3);
276      # Compute the subclass name.      # Compute the subclass name.
277      my $subClass;      my $subClass;
278      if ($class =~ /SH(.+)$/) {      if ($class =~ /SH(.+)$/) {
# Line 308  Line 283 
283          # process search results.          # process search results.
284          $subClass = 'SearchHelper';          $subClass = 'SearchHelper';
285      }      }
286        Trace("Subclass name is $subClass.") if T(3);
287      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
288      $cgi->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
289      # Generate the form name.      # Generate the form name.
290      my $formName = "$class$formCount";      my $formName = "$class$formCount";
291      $formCount++;      $formCount++;
292        Trace("Creating helper.") if T(3);
293      # Create the shelp object. It contains the query object (with the session ID)      # Create the shelp object. It contains the query object (with the session ID)
294      # as well as an indicator as to whether or not the session is new, plus the      # as well as an indicator as to whether or not the session is new, plus the
295      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
# Line 326  Line 303 
303                    scriptQueue => [],                    scriptQueue => [],
304                    genomeList => undef,                    genomeList => undef,
305                    genomeParms => [],                    genomeParms => [],
                   filtered => 0,  
                   extraPos => {},  
306                   };                   };
307      # Bless and return it.      # Bless and return it.
308      bless $retVal, $class;      bless $retVal, $class;
# Line 388  Line 363 
363      return ($self->{type} eq 'new');      return ($self->{type} eq 'new');
364  }  }
365    
 =head3 SetExtraPos  
   
 C<< $shelp->SetExtraPos(@columnMap); >>  
   
 Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.  
   
 =over 4  
   
 =item columnMap  
   
 A list of extra columns to display at the end.  
   
 =back  
   
 =cut  
   
 sub SetExtraPos {  
     # Get the parameters.  
     my ($self, @columnMap) = @_;  
     # Convert the column map to a hash.  
     my %map = map { $_ => 1 } @columnMap;  
     # Save a reference to it.  
     $self->{extraPos} = \%map;  
 }  
   
366  =head3 ID  =head3 ID
367    
368  C<< my $sessionID = $shelp->ID(); >>  C<< my $sessionID = $shelp->ID(); >>
# Line 607  Line 557 
557    
558  =head3 OpenSession  =head3 OpenSession
559    
560  C<< $shelp->OpenSession(); >>  C<< $shelp->OpenSession($rhelp); >>
561    
562    Set up the session cache file and write out the column headers.
563    This method should not be called until all the columns have
564    been configured, including the extra columns.
565    
566    =over 4
567    
568  Set up to open the session cache file for writing. Note we don't actually  =item rhelp
569  open the file until after we know the column headers.  
570    Result helper for formatting the output. This has the column
571    headers stored in it.
572    
573    =back
574    
575  =cut  =cut
576    
577  sub OpenSession {  sub OpenSession {
578      # Get the parameters.      # Get the parameters.
579      my ($self) = @_;      my ($self, $rhelp) = @_;
580      # Denote we have not yet written out the column headers.      # Insure the result helper is valid.
581      $self->{cols} = undef;      if (! defined($rhelp)) {
582            Confess("No result type specified for $self->{class}.");
583        } elsif(! $rhelp->isa('ResultHelper')) {
584            Confess("Invalid result type specified for $self->{class}.");
585        } else {
586            # Get the column headers and write them out.
587            my $colHdrs = $rhelp->GetColumnHeaders();
588            Trace(scalar(@{$colHdrs}) . " column headers written to output.") if T(3);
589            $self->WriteColumnHeaders(@{$colHdrs});
590        }
591  }  }
592    
593  =head3 GetCacheFileName  =head3 GetCacheFileName
# Line 662  Line 631 
631      my ($self, $type) = @_;      my ($self, $type) = @_;
632      # Compute the file name. Note it gets stuffed in the FIG temporary      # Compute the file name. Note it gets stuffed in the FIG temporary
633      # directory.      # directory.
634      my $retVal = "$FIG_Config::temp/tmp_" . $self->ID() . ".$type";      my $retVal = FIGRules::GetTempFileName(sessionID => $self->ID(), extension => $type);
635      # Return the result.      # Return the result.
636      return $retVal;      return $retVal;
637  }  }
638    
 =head3 PutFeature  
   
 C<< $shelp->PutFeature($fdata); >>  
   
 Store a feature in the result cache. This is the workhorse method for most  
 searches, since the primary data item in the database is features.  
   
 For each feature, there are certain columns that are standard: the feature name, the  
 GBrowse and protein page links, the functional assignment, and so forth. If additional  
 columns are required by a particular search subclass, they should be stored in  
 the feature query object using the B<AddExtraColumns> method. For example, the following  
 code adds columns for essentiality and virulence.  
   
     $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
     $shelp->PutFeature($fd);  
   
 For correct results, all values should be specified for all extra columns in all calls to  
 B<PutFeature>. (In particular, the column header names are computed on the first  
 call.) If a column is to be blank for the current feature, its value can be given  
 as C<undef>.  
   
     if (! $essentialFlag) {  
         $essentialFlag = undef;  
     }  
     $fd->AddExtraColumns(essential => $essentialFlag, virulence => $vfactor);  
     $shelp->PutFeature($fd);  
   
 =over 4  
   
 =item fdata  
   
 B<FeatureData> object containing the current feature data.  
   
 =back  
   
 =cut  
   
 sub PutFeature {  
     # Get the parameters.  
     my ($self, $fd) = @_;  
     # Get the CGI query object.  
     my $cgi = $self->Q();  
     # Get the feature data.  
     my $record = $fd->Feature();  
     my $extraCols = $fd->ExtraCols();  
     # Check for a first-call situation.  
     if (! defined $self->{cols}) {  
         Trace("Setting up the columns.") if T(3);  
         # 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 and separate by whether they go in the beginning or the  
         # end.  
         my @xtraNamesFront = ();  
         my @xtraNamesEnd = ();  
         my $xtraPosMap = $self->{extraPos};  
         for my $col (sort keys %{$extraCols}) {  
             if ($xtraPosMap->{$col}) {  
                 push @xtraNamesEnd, "X=$col";  
             } else {  
                 push @xtraNamesFront, "X=$col";  
             }  
         }  
         # Set up the column name array.  
         my @colNames = ();  
         # Put in the extra columns that go in the beginning.  
         push @colNames, @xtraNamesFront;  
         # 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.  
         push @colNames, @xtraNamesEnd;  
         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);  
 }  
   
639  =head3 WriteColumnHeaders  =head3 WriteColumnHeaders
640    
641  C<< $shelp->WriteColumnHeaders(@colNames); >>  C<< $shelp->WriteColumnHeaders(@colNames); >>
# Line 777  Line 648 
648    
649  =item colNames  =item colNames
650    
651  A list of column names in the desired presentation order.  A list of column names in the desired presentation order. For extra columns,
652    the column name is the hash supplied as the column definition.
653    
654  =back  =back
655    
# Line 789  Line 661 
661      # Get the cache file name and open it for output.      # Get the cache file name and open it for output.
662      my $fileName = $self->GetCacheFileName();      my $fileName = $self->GetCacheFileName();
663      my $handle1 = Open(undef, ">$fileName");      my $handle1 = Open(undef, ">$fileName");
664        # Freeze the column headers.
665        my @colHdrs = map { freeze($_) } @colNames;
666      # Write the column headers and close the file.      # Write the column headers and close the file.
667      Tracer::PutLine($handle1, \@colNames);      Tracer::PutLine($handle1, \@colHdrs);
668      close $handle1;      close $handle1;
     Trace("Column headers are: " . join("; ", @colNames) . ".") if T(3);  
669      # Now open the sort pipe and save the file handle. Note how we append the      # Now open the sort pipe and save the file handle. Note how we append the
670      # sorted data to the column header row already in place. The output will      # sorted data to the column header row already in place. The output will
671      # contain a sort key followed by the real columns. The sort key is      # contain a sort key followed by the real columns. The sort key is
# Line 800  Line 673 
673      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
674  }  }
675    
676    =head3 ReadColumnHeaders
677    
678    C<< my @colHdrs = $shelp->ReadColumnHeaders($fh); >>
679    
680    Read the column headers from the specified file handle. The column headers are
681    frozen strings intermixed with frozen hash references. The strings represent
682    column names defined in the result helper. The hash references represent the
683    definitions of the extra columns.
684    
685    =over 4
686    
687    =item fh
688    
689    File handle from which the column headers are to be read.
690    
691    =item RETURN
692    
693    Returns a list of the column headers pulled from the specified file's first line.
694    
695    =back
696    
697    =cut
698    
699    sub ReadColumnHeaders {
700        # Get the parameters.
701        my ($self, $fh) = @_;
702        # Read and thaw the columns.
703        my @retVal = map { thaw($_) } Tracer::GetLine($fh);
704        # Return them to the caller.
705        return @retVal;
706    }
707    
708  =head3 WriteColumnData  =head3 WriteColumnData
709    
710  C<< $shelp->WriteColumnData($key, @colValues); >>  C<< $shelp->WriteColumnData($key, @colValues); >>
# Line 851  Line 756 
756      }      }
757  }  }
758    
 =head3 NewSessionID  
   
 C<< my $id = SearchHelpers::NewSessionID(); >>  
   
 Generate a new session ID for the current user.  
   
 =cut  
   
 sub NewSessionID {  
     # Declare the return variable.  
     my $retVal;  
     # Get a digest encoder.  
     my $md5 = Digest::MD5->new();  
     # Add the PID, the IP, and the time stamp. Note that the time stamp is  
     # actually two numbers, and we get them both because we're in list  
     # context.  
     $md5->add($$, $ENV{REMOTE_ADDR}, $ENV{REMOTE_PORT}, gettimeofday());  
     # Hash up all this identifying data.  
     $retVal = $md5->hexdigest();  
     # Return the result.  
     return $retVal;  
 }  
   
759  =head3 OrganismData  =head3 OrganismData
760    
761  C<< my ($orgName, $group, $domain) = $shelp->Organism($genomeID); >>  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>
762    
763  Return the name and status of the organism corresponding to the specified genome ID.  Return the name and status of the organism corresponding to the specified genome ID.
764  For performance reasons, this information is cached in a special hash table, so we  For performance reasons, this information is cached in a special hash table, so we
# Line 907  Line 789 
789      my $cache = $self->{orgs};      my $cache = $self->{orgs};
790      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
791          ($orgName, $group, $domain) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
792            Trace("Cached organism $genomeID has group \"$group\".") if T(4);
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, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $newGroup, $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)']);                                                                   'Genome(taxonomy)']);
801          # Format and cache the name and display group.          # Format and cache the name and display group.
802          ($orgName, $group, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          Trace("Caching organism $genomeID with group \"$newGroup\".") if T(4);
803            ($orgName, $group, $domain) = $self->SaveOrganismData($newGroup, $genomeID, $genus, $species,
804                                                                $strain, $taxonomy);                                                                $strain, $taxonomy);
805            Trace("Returning group $group.") if T(4);
806      }      }
807      # Return the result.      # Return the result.
808      return ($orgName, $group, $domain);      return ($orgName, $group, $domain);
# Line 953  Line 838 
838      return $retVal;      return $retVal;
839  }  }
840    
 =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]";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
841  =head3 ComputeFASTA  =head3 ComputeFASTA
842    
843  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth); >>  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth); >>
# Line 1037  Line 849 
849    
850  =item desiredType  =item desiredType
851    
852  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>
853    to return a DNA search pattern, C<protPattern> to return a protein search pattern.
854    
855  =item sequence  =item sequence
856    
# Line 1102  Line 915 
915                  # We want protein, so get the translation.                  # We want protein, so get the translation.
916                  $fastaData = $sprout->FeatureTranslation($figID);                  $fastaData = $sprout->FeatureTranslation($figID);
917                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);                  Trace(length $fastaData . " characters returned for translation of $fastaLabel.") if T(3);
918              } else {              } elsif ($desiredType =~ /dna/) {
919                  # We want DNA, so get the DNA sequence. This is a two-step process. First, we get the                  # We want DNA, so get the DNA sequence. This is a two-step process. First, we get the
920                  # locations.                  # locations.
921                  my @locList = $sprout->FeatureLocation($figID);                  my @locList = $sprout->FeatureLocation($figID);
# Line 1152  Line 965 
965              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);
966              # 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
967              # as data.              # as data.
968              $fastaLabel = "User-specified $desiredType sequence";              $fastaLabel = "$desiredType sequence specified by user";
969              $fastaData = $sequence;              $fastaData = $sequence;
970          }          }
971          # 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.
972            if ($desiredType !~ /pattern/i) {
973          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
974          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
975            }
976          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
977          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {
978              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
979              $okFlag = 0;              $okFlag = 0;
980          }          }
# Line 1168  Line 983 
983      # Only proceed if no error was detected.      # Only proceed if no error was detected.
984      if ($okFlag) {      if ($okFlag) {
985          if ($desiredType =~ /pattern/i) {          if ($desiredType =~ /pattern/i) {
986              # We're doing a scan, so only the data is passed in.              # For a scan, there is no label and no breakup.
987              $retVal = $fastaData;              $retVal = $fastaData;
988          } else {          } else {
989              # 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
# Line 1517  Line 1332 
1332          # the text selected automatically.          # the text selected automatically.
1333          my $searchThingName = "${menuName}_SearchThing";          my $searchThingName = "${menuName}_SearchThing";
1334          push @lines, "<br />" .          push @lines, "<br />" .
1335                       "<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;" .
1336                       "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />";                       "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />" . Hint("Enter a genome number, then click the button to the left " .
1337                                                                                                "in order to select the genome with that number. " .
1338                                                                                                "Enter a genus, species, or strain and click the " .
1339                                                                                                "button to select all genomes with that genus, species, " .
1340                                                                                                "or strain name.");
1341          # Next are the buttons to set and clear selections.          # Next are the buttons to set and clear selections.
1342          push @lines, "<br />";          push @lines, "<br />";
1343          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 1687  Line 1506 
1506      my $realCaption = (defined $caption ? $caption : 'Go');      my $realCaption = (defined $caption ? $caption : 'Go');
1507      # Get the current page size.      # Get the current page size.
1508      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1509      # Get the incoming external-link flag.      # Get the current feature ID type.
1510      my $aliases = ($cgi->param('ShowAliases') ? 1 : 0);      my $aliasType = $self->GetPreferredAliasType();
1511      # Create the row.      # Create the rows.
1512      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("ID Type"), $cgi->td({ colspan => 2 },
1513                                                            $cgi->popup_menu(-name => 'AliasType',
1514                                                                             -values => ['FIG', AliasAnalysis::AliasTypes() ],
1515                                                                             -default => $aliasType) .
1516                                                            Hint("Specify how you want gene names to be displayed."))) .
1517                     "\n" .
1518                     $cgi->Tr($cgi->td("Results/Page"),
1519                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1520                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1521                                                      -default => $pageSize)),                                                      -default => $pageSize)),
# Line 1701  Line 1526 
1526      return $retVal;      return $retVal;
1527  }  }
1528    
 =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;  
 }  
   
1529  =head3 GetGenomes  =head3 GetGenomes
1530    
1531  C<< my @genomeList = $shelp->GetGenomes($parmName); >>  C<< my @genomeList = $shelp->GetGenomes($parmName); >>
# Line 1865  Line 1578 
1578  server. The help text for a specific search is taken from a file named  server. The help text for a specific search is taken from a file named
1579  C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.  C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.
1580  There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the  There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the
1581  feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>  feature filtering performed by the B<RHFeatures> object, C<SearchHelp1_GenomeControl.inc>
1582  describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>  describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>
1583  describes the standard controls for a search, such as page size, URL display, and  describes the standard controls for a search, such as page size, URL display, and
1584  external alias display.  external alias display.
# Line 1991  Line 1704 
1704      return $retVal;      return $retVal;
1705  }  }
1706    
 =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;  
 }  
   
1707  =head3 AdvancedClassList  =head3 AdvancedClassList
1708    
1709  C<< my @classes = SearchHelper::AdvancedClassList(); >>  C<< my @classes = SearchHelper::AdvancedClassList(); >>
# Line 2034  Line 1711 
1711  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
1712  of available searches on the search page.  of available searches on the search page.
1713    
1714  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.
1715    
1716  =cut  =cut
1717    
1718  sub AdvancedClassList {  sub AdvancedClassList {
1719      my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } grep { $_ =~ /^SH/ } keys %INC;      # Determine the search helper module directory.
1720        my $libDirectory = $INC{'SearchHelper.pm'};
1721        $libDirectory =~ s/SearchHelper\.pm//;
1722        # Read it, keeping only the helper modules.
1723        my @modules = grep { /^SH\w+\.pm/ } Tracer::OpenDir($libDirectory, 0);
1724        # Convert the file names to search types.
1725        my @retVal = map { $_ =~ /^SH(\w+)\.pm/; $1 } @modules;
1726        # Return the result in alphabetical order.
1727      return sort @retVal;      return sort @retVal;
1728  }  }
1729    
# Line 2415  Line 2099 
2099      return $retVal;      return $retVal;
2100  }  }
2101    
   
2102  =head3 PrintLine  =head3 PrintLine
2103    
2104  C<< $shelp->PrintLine($message); >>  C<< $shelp->PrintLine($message); >>
# Line 2440  Line 2123 
2123      print "$message\n";      print "$message\n";
2124  }  }
2125    
2126  =head2 Feature Column Methods  =head3 GetHelper
   
 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";  
     } elsif ($colName eq 'pdb') {  
         $retVal = "Best PDB Match";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 FeatureColumnDownload  
   
 C<< my $keep = $shelp->FeatureColumnDownload($colName); >>  
   
 Return TRUE if the named feature column is to be kept when downloading, else FALSE.  
   
 =over 4  
   
 =item colName  
   
 Name of the relevant feature column.  
   
 =item RETURN  
   
 Return TRUE if the named column should be kept while downloading, else FALSE. In general,  
 FALSE is returned if the column generates a button, image, or other purely-HTML value.  
   
 =back  
   
 =cut  
   
 sub FeatureColumnDownload {  
     # Get the parameters.  
     my ($self, $colName) = @_;  
     # Return the determination. We download the column if it's not in the skip-hash.  
     # Note we return 0 and 1 instead of 1 and undef because it simplifies some tracing.  
     return (exists $FeatureColumnSkip{$colName} ? 0 : 1);  
 }  
   
2127    
2128  =head3 FeatureColumnValue  C<< my $shelp = SearchHelper::GetHelper($parm, $type => $className); >>
2129    
2130  C<< my $value = $shelp->FeatureColumnValue($colName, $fid, \%extraCols); >>  Return a helper object with the given class name. If no such class exists, an
2131    error will be thrown.
 Return the value to be displayed in the specified feature column.  
2132    
2133  =over 4  =over 4
2134    
2135  =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  
2136    
2137  Reference to a hash of extra column names to values. If the incoming column name  Parameter to pass to the constructor. This is a CGI object for a search helper
2138  begins with C<X=>, its value will be taken from this hash.  and a search helper object for the result helper.
   
 =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";  
     } elsif ($colName eq 'pdb') {  
         $retVal = "%%pdb=$fid";  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 RunTimeColumns  
   
 C<< my $htmlText = $shelp->RunTimeColumns($type, $text); >>  
   
 Return the HTML text for a run-time column. Run-time columns are evaluated when the  
 list is displayed, rather than when it is generated.  
   
 =over 4  
2139    
2140  =item type  =item type
2141    
2142  Type of column.  Type of helper: C<RH> for a result helper and C<SH> for a search helper.
2143    
2144  =item text  =item className
2145    
2146  Data relevant to this row of the column.  Class name for the helper object, without the preceding C<SH> or C<RH>. This is
2147    identical to what the script expects for the C<Class> or C<ResultType> parameter.
2148    
2149  =item RETURN  =item RETURN
2150    
2151  Returns the fully-formatted HTML text to go in the specified column.  Returns a helper object for the specified class.
2152    
2153  =back  =back
2154    
2155  =cut  =cut
2156    
2157  sub RunTimeColumns {  sub GetHelper {
2158      # Get the parameters.      # Get the parameters.
2159      my ($self, $type, $text) = @_;      my ($parm, $type, $className) = @_;
2160      # Declare the return variable.      # Declare the return variable.
2161      my $retVal = "";      my $retVal;
2162      # Get the Sprout and CGI objects.      # Try to create the helper.
2163      my $sprout = $self->DB();      eval {
2164      my $cgi = $self->Q();          # Load it into memory. If it's already there nothing will happen here.
2165      Trace("Runtime column $type with text \"$text\" found.") if T(4);          my $realName = "$type$className";
2166      # Separate the text into a type and data.          Trace("Requiring helper $realName.") if T(3);
2167      if ($type eq 'alias') {          require "$realName.pm";
2168          # Here the caller wants external alias links for a feature. The text          Trace("Constructing helper object.") if T(3);
2169          # parameter for computing the alias is the feature ID followed by          # Construct the object.
2170          # the favored alias type.          $retVal = eval("$realName->new(\$parm)");
2171          my ($fid, $favored) = split /\s*,\s*/, $text;          # Commit suicide if it didn't work.
2172          # The complicated part is we have to hyperlink them and handle the          if (! defined $retVal) {
2173          # 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;  
                 }  
             }  
             # Rejoin the aliases into a comma-delimited list, with the favored ones first.  
             my $aliasList = join(", ", @favored, @unfavored);  
             # Ask the HTML processor to hyperlink them.  
             $retVal = HTML::set_prot_links($cgi, $aliasList);  
         }  
     } elsif ($type eq 'subsystem') {  
         # Here the caller wants the subsystems in which this feature participates.  
         # The text is the feature ID. We will list the subsystem names with links  
         # to the subsystem's summary page.  
         my $fid = $text;  
         # Get the subsystems.  
         Trace("Generating subsystems for feature $fid.") if T(4);  
         my %subs = $sprout->SubsystemsOf($fid);  
         # 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);  
     } elsif ($type eq 'pdb') {  
         # Here the caller wants the best PDB match to this feature. The text  
         # is the feature ID. We will display the PDB with a link to the  
         # PDB page along with the match score. If there are docking results we  
         # will display a link to the docking result search.  
         my $fid = $text;  
         # Ask for the best PDB.  
         my ($bestPDB) = $sprout->GetAll(['IsProteinForFeature', 'PDB'],  
                                         "IsProteinForFeature(from-link) = ? ORDER BY IsProteinForFeature(score) LIMIT 1",  
                                         [$fid], ['PDB(id)', 'PDB(docking-count)', 'IsProteinForFeature(score)']);  
         # Only proceed if there is a PDB.  
         if ($bestPDB) {  
             my ($pdbID, $dockingCount, $score) = @{$bestPDB};  
             # Convert the PDB ID to a hyperlink.  
             my $pdbLink = SHDrugSearch::PDBLink($cgi, $pdbID);  
             # Append the score.  
             $retVal = "$pdbLink ($score)";  
             # If there are docking results, append a docking results link.  
             if ($dockingCount > 0) {  
                 my $dockString = "$dockingCount docking results";  
                 my $dockLink = $cgi->a({ href =>  $cgi->url() . "?Class=DrugSearch;PDB=$pdbID;NoForm=1",  
                                          alt =>   "View computed docking results for $pdbID",  
                                          title => "View computed docking results for $pdbID",  
                                          target => "_blank"},  
                                        $dockString);  
             }  
         }  
     } elsif ($type eq 'role') {  
         # Here the caller wants a functional role assignment. The key is the feature ID.  
         $retVal = $sprout->FunctionOf($text);  
     } elsif ($type eq 'loc') {  
         # This is a tough one. We need to find the nearest feature in the appropriate direction  
         # on the contig, and then output its id, functional role, and link button.  
         if ($text =~ /^(.)\/(.+)/) {  
             my ($direction, $locString) = ($1, $2);  
             Trace("Location request of type $direction for $locString.") if T(3);  
             # Convert the location string into a location object.  
             my $loc = BasicLocation->new($locString);  
             # Get the contig ID.  
             my $contigID = $loc->Contig;  
             # Compute the contig length.  
             my $contigLen = $sprout->ContigLength($contigID);  
             # Widen by the area to search in both directions.  
             $loc->Widen(5000);  
             # Now, if we're doing a before (-) search, we set the end point to the area's mid point.  
             # If we're doing an after (+) search, we set the begin point to the area's mid point.  
             my $mid = ($loc->Left + $loc->Right) / 2;  
             # Compute the search direction.  
             my $searchDir = ($direction eq $loc->Dir ? 1 : -1);  
             # Adjust the midpoint so that it is different in the before direction from what it would  
             # be in the after direction.  
             if ($mid != int($mid)) {  
                 # Here we need to round. The thing here is we want to round in a way that separates  
                 # the after-search choice from the before-search choice.  
                 if ($direction eq $loc->Dir) {  
                     $mid = ceil($mid);  
                 } else {  
                     $mid = floor($mid);  
                 }  
             } elsif ($direction eq '+') {  
                 # Here the midpoint is on a nucleotide and we are doing the after search. We bump the  
                 # midpoint toward the end point.  
                 $mid += $loc->NumDirection;  
             }  
             # Now put the midpoint on the proper end of the region.  
             if ($direction eq '+') {  
                 $loc->SetBegin($mid);  
             } else {  
                 $loc->SetEnd($mid);  
             }  
             Trace("Search region is " . $loc->String . ".") if T(3);  
             # Find all the genes in the region.  
             my ($fidList, $beg, $end) = $sprout->GenesInRegion($loc->Contig, $loc->Left, $loc->Right);  
             Trace(scalar(@{$fidList}) . " features found.") if T(3);  
             # Look for the best match.  
             my $distance = 5000;  
             my $chosenFid = undef;  
             for my $fid (@{$fidList}) {  
                 # Get the feature's location.  
                 my ($locString) = $sprout->FeatureLocation($fid);  
                 my $locObject = BasicLocation->new($locString);  
                 # Check its begin point to see if we should keep it.  
                 my $newDistance = ($mid - $locObject->Begin) * $searchDir;  
                 Trace("Distance from $mid to $locString is $newDistance.") if T(4);  
                 if ($newDistance > 0 && $newDistance < $distance) {  
                     $distance = $newDistance;  
                     $chosenFid = $fid;  
                 }  
             }  
             # Only proceed if we found something.  
             if (defined $chosenFid) {  
                 my $role = $sprout->FunctionOf($chosenFid);  
                 my $linkButton = SearchHelper::FakeButton('NMPDR', "protein.cgi", undef,  
                                                            prot => $chosenFid, SPROUT => 1,  
                                                            new_framework => 0, user => '');  
                 $retVal = "$chosenFid&nbsp;$linkButton&nbsp;$role";  
             }  
         } else {  
             Confess("Invalid location request %%loc=$text.");  
2174          }          }
2175        };
2176        # Check for errors.
2177        if ($@) {
2178            Confess("Error retrieving $type$className: $@");
2179      }      }
2180      # Return the result.      # Return the result.
2181      return $retVal;      return $retVal;
# Line 2860  Line 2183 
2183    
2184  =head3 SaveOrganismData  =head3 SaveOrganismData
2185    
2186  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); >>  C<< my ($name, $displayGroup, $domain) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); >>
2187    
2188  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
2189  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 2921  Line 2244 
2244          # Compute the display group. This is currently the same as the incoming group          # Compute the display group. This is currently the same as the incoming group
2245          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2246          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2247            Trace("Group = $displayGroup, translated from \"$group\".") if T(4);
2248      }      }
2249      # Compute the domain from the taxonomy.      # Compute the domain from the taxonomy.
2250      my ($domain) = split /\s*;\s*/, $taxonomy, 2;      my ($domain) = split /\s*;\s*/, $taxonomy, 2;
# Line 2981  Line 2305 
2305      return $retVal;      return $retVal;
2306  }  }
2307    
 =head3 FakeButton  
   
 C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>  
   
 Create a fake button that hyperlinks to the specified URL with the specified parameters.  
 Unlike a real button, this one won't visibly click, but it will take the user to the  
 correct place.  
   
 The parameters of this method are deliberately identical to L</Formlet> so that we  
 can switch easily from real buttons to fake ones in the code.  
   
 =over 4  
   
 =item caption  
   
 Caption to be put on the button.  
   
 =item url  
   
 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  
   
 Hash containing the parameter names as keys and the parameter values as values.  
 These will be appended to the URL.  
   
 =back  
   
 =cut  
   
 sub FakeButton {  
     # Get the parameters.  
     my ($caption, $url, $target, %parms) = @_;  
     # Declare the return variable.  
     my $retVal;  
     # Compute the target URL.  
     my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);  
     # Compute the target-frame HTML.  
     my $targetHtml = ($target ? " target=\"$target\"" : "");  
     # Assemble the result.  
     return "<a href=\"$targetUrl\" $targetHtml><span class=\"button2 button\">$caption</span></a>";  
 }  
   
 =head3 Formlet  
   
 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  
   
 Hash containing the parameter names as keys and the parameter values as values.  
   
 =back  
   
 =cut  
   
 sub Formlet {  
     # Get the parameters.  
     my ($caption, $url, $target, %parms) = @_;  
     # Compute the target HTML.  
     my $targetHtml = ($target ? " target=\"$target\"" : "");  
     # Start the form.  
     my $retVal = "<form method=\"POST\" action=\"$url\"$target>";  
     # 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.  
     return $retVal;  
 }  
   
2308  =head3 TuningParameters  =head3 TuningParameters
2309    
2310  C<< my $options = $shelp->TuningParameters(%parmHash); >>  C<< my $options = $shelp->TuningParameters(%parmHash); >>
# Line 3125  Line 2348 
2348      return $retVal;      return $retVal;
2349  }  }
2350    
2351    =head3 GetPreferredAliasType
2352    
2353    C<< my $type = $shelp->GetPreferredAliasType(); >>
2354    
2355    Return the preferred alias type for the current session. This information is stored
2356    in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>
2357    (which indicates the FIG ID).
2358    
2359    =cut
2360    
2361    sub GetPreferredAliasType {
2362        # Get the parameters.
2363        my ($self) = @_;
2364        # Determine the preferred type.
2365        my $cgi = $self->Q();
2366        my $retVal = $cgi->param('AliasType') || 'FIG';
2367        # Return it.
2368        return $retVal;
2369    }
2370    
2371  =head2 Virtual Methods  =head2 Virtual Methods
2372    
2373  =head3 Form  =head3 Form
# Line 3142  Line 2385 
2385  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
2386  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.
2387    
2388    =cut
2389    
2390    sub Find {
2391        # Get the parameters.
2392        my ($self) = @_;
2393        $self->Message("Call to pure virtual Find method in helper of type " . ref($self) . ".");
2394        return undef;
2395    }
2396    
2397  =head3 Description  =head3 Description
2398    
2399  C<< my $htmlText = $shelp->Description(); >>  C<< my $htmlText = $shelp->Description(); >>
# Line 3150  Line 2402 
2402  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,
2403  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.
2404    
 =head3 SortKey  
   
 C<< my $key = $shelp->SortKey($fdata); >>  
   
 Return the sort key for the specified feature data. The default is to sort by feature name,  
 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.  
   
 =over 4  
   
 =item record  
   
 The C<FeatureData> containing the current feature.  
   
 =item RETURN  
   
 Returns a key field that can be used to sort this row in among the results.  
   
 =back  
   
2405  =cut  =cut
2406    
2407  sub SortKey {  sub Description {
2408      # Get the parameters.      # Get the parameters.
2409      my ($self, $fdata) = @_;      my ($self) = @_;
2410      # Get the feature ID from the record.      $self->Message("Call to pure virtual Description method in helper of type " . ref($self) . ".");
2411      my $fid = $fdata->FID();      return "Unknown search type";
     # Get the group from the feature ID.  
     my $group = $self->FeatureGroup($fid);  
     # Ask the feature query object to form the sort key.  
     my $retVal = $fdata->SortKey($self, $group);  
     # Return the result.  
     return $retVal;  
2412  }  }
2413    
2414  =head3 SearchTitle  =head3 SearchTitle
# Line 3202  Line 2425 
2425      # Get the parameters.      # Get the parameters.
2426      my ($self) = @_;      my ($self) = @_;
2427      # Declare the return variable.      # Declare the return variable.
2428      my $retVal;      my $retVal = "";
2429      # Return it.      # Return it.
2430      return $retVal;      return $retVal;
2431  }  }
2432    
2433  =head3 DownloadFormatAvailable  =head3 DefaultColumns
2434    
2435  C<< my $okFlag = $shelp->DownloadFormatAvailable($format); >>  C<< $shelp->DefaultColumns($rhelp); >>
2436    
2437  This method returns TRUE if a specified download format is legal for this type of search  Store the default columns in the result helper. The default action is just to ask
2438  and FALSE otherwise. For any feature-based search, there is no need to override this  the result helper for its default columns, but this may be changed by overriding
2439  method.  this method.
2440    
2441  =over 4  =over 4
2442    
2443  =item format  =item rhelp
   
 Download format type code.  
   
 =item RETURN  
2444    
2445  Returns TRUE if the download format is legal for this search and FALSE otherwise.  Result helper object in which the column list should be stored.
2446    
2447  =back  =back
2448    
2449  =cut  =cut
2450    
2451  sub DownloadFormatAvailable {  sub DefaultColumns {
2452      # Get the parameters.      # Get the parameters.
2453      my ($self, $format) = @_;      my ($self, $rhelp) = @_;
2454      # Declare the return variable.      # Get the default columns from the result helper.
2455      my $retVal = 1;      my @cols = $rhelp->DefaultResultColumns();
2456      # Return the result.      # Store them back.
2457      return $retVal;      $rhelp->SetColumns(@cols);
2458  }  }
2459    
2460  =head3 ColumnTitle  =head3 Hint
2461    
2462  C<< my $title = $shelp->ColumnTitle($colName); >>  C<< my $htmlText = SearchHelper::Hint($hintText); >>
2463    
2464  Return the column heading title to be used for the specified column name. The  Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2465  default implementation is to simply call L</FeatureColumnTitle>.  This HTML can be put in forms to provide a useful hinting mechanism.
2466    
2467  =over 4  =over 4
2468    
2469  =item colName  =item hintText
2470    
2471  Name of the desired column.  Text to display for the hint. It is raw html, but may not contain any double quotes.
2472    
2473  =item RETURN  =item RETURN
2474    
2475  Returns the title to be used as the column header for the named column.  Returns the html for the hint facility. The resulting html shows a small button-like thing that
2476    uses the standard FIG popup technology.
2477    
2478  =back  =back
2479    
2480  =cut  =cut
2481    
2482  sub ColumnTitle {  sub Hint {
2483      my ($self, $colName) = @_;      # Get the parameters.
2484      return $self->FeatureColumnTitle($colName);      my ($hintText) = @_;
2485        # Escape the single quotes.
2486        my $quotedText = $hintText;
2487        $quotedText =~ s/'/\\'/g;
2488        # Create the html.
2489        my $retVal = "&nbsp;<input type=\"button\" class=\"hintbutton\" onMouseOver=\"javascript:if (!this.tooltip) { " .
2490                     "this.tooltip = new Popup_Tooltip(this, 'Search Hint', '$quotedText', '', 1); this.tooltip.addHandler(); } " .
2491                     "return false;\" value=\"?\" />";
2492        # Return it.
2493        return $retVal;
2494  }  }
2495    
2496    

Legend:
Removed from v.1.33  
changed lines
  Added in v.1.36

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3