[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.34, Mon Jul 16 20:04:51 2007 UTC revision 1.48, Thu Apr 2 01:45:05 2009 UTC
# Line 16  Line 16 
16      use FIGRules;      use FIGRules;
17      use HTML;      use HTML;
18      use BasicLocation;      use BasicLocation;
     use FeatureQuery;  
19      use URI::Escape;      use URI::Escape;
20      use PageBuilder;      use PageBuilder;
21      use AliasAnalysis;      use AliasAnalysis;
22        use CGI::Cookie;
23      use FreezeThaw qw(freeze thaw);      use FreezeThaw qw(freeze thaw);
24    
25  =head1 Search Helper Base Class  =head1 Search Helper Base Class
# Line 86  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    
89    =item notices
90    
91    A list of messages to be put in the notice file.
92    
93  =back  =back
94    
95  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 242  Line 246 
246    
247  =head3 new  =head3 new
248    
249  C<< my $shelp = SearchHelper->new($cgi); >>      my $shelp = SearchHelper->new($cgi);
250    
251  Construct a new SearchHelper object.  Construct a new SearchHelper object.
252    
# Line 259  Line 263 
263  sub new {  sub new {
264      # Get the parameters.      # Get the parameters.
265      my ($class, $cgi) = @_;      my ($class, $cgi) = @_;
266      # Check for a session ID.      # Check for a session ID. First we look in the CGI parameters.
267      my $session_id = $cgi->param("SessionID");      my $session_id = $cgi->param("SessionID");
268      my $type = "old";      my $type = "old";
269      if (! $session_id) {      if (! $session_id) {
270            # We need a session ID. Try to get it from the cookies.
271            my %cookies = fetch CGI::Cookie;
272            my $session_cookie = $cookies{$class};
273            if (! $session_cookie) {
274          Trace("No session ID found.") if T(3);          Trace("No session ID found.") if T(3);
275          # 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
276          # store it in the query object.              # store it in a cookie.
277          $session_id = FIGRules::NewSessionID();          $session_id = FIGRules::NewSessionID();
278          Trace("New session ID is $session_id.") if T(3);          Trace("New session ID is $session_id.") if T(3);
279                $session_cookie = new CGI::Cookie(-name => $class,
280                                                  -value => $session_id);
281                $session_cookie->bake();
282            } else {
283                # Here we're recovering an old session. The session ID is
284                # used to find any old search options lying around, but we're
285                # still considered a new session.
286                $session_id = $session_cookie->value();
287                Trace("Session $session_id recovered from cookie.") if T(3);
288            }
289            # Denote this is a new session.
290          $type = "new";          $type = "new";
291            # Put the session ID in the parameters.
292          $cgi->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
293      } else {      } else {
294          Trace("Session ID is $session_id.") if T(3);          Trace("Session ID is $session_id.") if T(3);
# Line 304  Line 324 
324                    scriptQueue => [],                    scriptQueue => [],
325                    genomeList => undef,                    genomeList => undef,
326                    genomeParms => [],                    genomeParms => [],
327                      notices => [],
328                   };                   };
329      # Bless and return it.      # Bless and return it.
330      bless $retVal, $class;      bless $retVal, $class;
# Line 312  Line 333 
333    
334  =head3 Q  =head3 Q
335    
336  C<< my $query = $shelp->Q(); >>      my $query = $shelp->Q();
337    
338  Return the CGI query object.  Return the CGI query object.
339    
# Line 326  Line 347 
347  }  }
348    
349    
   
350  =head3 DB  =head3 DB
351    
352  C<< my $sprout = $shelp->DB(); >>      my $sprout = $shelp->DB();
353    
354  Return the Sprout database object.  Return the Sprout database object.
355    
# Line 350  Line 370 
370    
371  =head3 IsNew  =head3 IsNew
372    
373  C<< my $flag = $shelp->IsNew(); >>      my $flag = $shelp->IsNew();
374    
375  Return TRUE if this is a new session, FALSE if this is an old session. An old  Return TRUE if this is a new session, FALSE if this is an old session. An old
376  session already has search results ready to process.  session already has search results ready to process.
# Line 366  Line 386 
386    
387  =head3 ID  =head3 ID
388    
389  C<< my $sessionID = $shelp->ID(); >>      my $sessionID = $shelp->ID();
390    
391  Return the current session ID.  Return the current session ID.
392    
# Line 381  Line 401 
401    
402  =head3 FormName  =head3 FormName
403    
404  C<< my $name = $shelp->FormName(); >>      my $name = $shelp->FormName();
405    
406  Return the name of the form this helper object will generate.  Return the name of the form this helper object will generate.
407    
# Line 396  Line 416 
416    
417  =head3 QueueFormScript  =head3 QueueFormScript
418    
419  C<< $shelp->QueueFormScript($statement); >>      $shelp->QueueFormScript($statement);
420    
421  Add the specified statement to the queue of JavaScript statements that are to be  Add the specified statement to the queue of JavaScript statements that are to be
422  executed when the form has been fully defined. This is necessary because until  executed when the form has been fully defined. This is necessary because until
# Line 431  Line 451 
451    
452  =head3 FormStart  =head3 FormStart
453    
454  C<< my $html = $shelp->FormStart($title); >>      my $html = $shelp->FormStart($title);
455    
456  Return the initial section of a form designed to perform another search of the  Return the initial section of a form designed to perform another search of the
457  same type. The form header is included along with hidden fields to persist the  same type. The form header is included along with hidden fields to persist the
# Line 461  Line 481 
481      # Start the form. Note we use the override option on the Class value, in      # Start the form. Note we use the override option on the Class value, in
482      # case the Advanced button was used.      # case the Advanced button was used.
483      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
484                   $cgi->start_form(-method => 'POST',                   CGI::start_form(-method => 'POST',
485                                    -action => $cgi->url(-relative => 1),                                    -action => "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/search",
486                                    -name => $self->FormName()) .                                    -name => $self->FormName(),
487                   $cgi->hidden(-name => 'Class',                                    -id => $self->FormName()) .
488                                -value => $self->{class},                   CGI::hidden(-name => 'Class',
489                                -override => 1) .                                -value => $self->{class}) .
490                   $cgi->hidden(-name => 'SPROUT',                   CGI::hidden(-name => 'SPROUT',
491                                -value => 1) .                                -value => 1) .
492                   $cgi->h3($title);                   CGI::h3("$title" . Hint($self->{class}));
     # If tracing is on, add it to the form.  
     if ($cgi->param('Trace')) {  
         $retVal .= $cgi->hidden(-name => 'Trace',  
                                 -value => $cgi->param('Trace')) .  
                    $cgi->hidden(-name => 'TF',  
                                 -value => ($cgi->param('TF') ? 1 : 0));  
     }  
493      # Put in an anchor tag in case there's a table of contents.      # Put in an anchor tag in case there's a table of contents.
494      my $anchorName = $self->FormName();      my $anchorName = $self->FormName();
495      $retVal .= "<a name=\"$anchorName\"></a>\n";      $retVal .= "<a name=\"$anchorName\"></a>\n";
# Line 486  Line 499 
499    
500  =head3 FormEnd  =head3 FormEnd
501    
502  C<< my $htmlText = $shelp->FormEnd(); >>      my $htmlText = $shelp->FormEnd();
503    
504  Return the HTML text for closing a search form. This closes both the C<form> and  Return the HTML text for closing a search form. This closes both the C<form> and
505  C<div> tags.  C<div> tags.
# Line 518  Line 531 
531    
532  =head3 SetMessage  =head3 SetMessage
533    
534  C<< $shelp->SetMessage($msg); >>      $shelp->SetMessage($msg);
535    
536  Store the specified text as the result message. The result message is displayed  Store the specified text as the result message. The result message is displayed
537  if an invalid parameter value is specified.  if an invalid parameter value is specified.
# Line 542  Line 555 
555    
556  =head3 Message  =head3 Message
557    
558  C<< my $text = $shelp->Message(); >>      my $text = $shelp->Message();
559    
560  Return the result message. The result message is displayed if an invalid parameter  Return the result message. The result message is displayed if an invalid parameter
561  value is specified.  value is specified.
# Line 558  Line 571 
571    
572  =head3 OpenSession  =head3 OpenSession
573    
574  C<< $shelp->OpenSession($rhelp); >>      $shelp->OpenSession($rhelp);
575    
576  Set up the session cache file and write out the column headers.  Set up the session cache file and write out the column headers.
577  This method should not be called until all the columns have  This method should not be called until all the columns have
# Line 593  Line 606 
606    
607  =head3 GetCacheFileName  =head3 GetCacheFileName
608    
609  C<< my $fileName = $shelp->GetCacheFileName(); >>      my $fileName = $shelp->GetCacheFileName();
610    
611  Return the name to be used for this session's cache file.  Return the name to be used for this session's cache file.
612    
# Line 608  Line 621 
621    
622  =head3 GetTempFileName  =head3 GetTempFileName
623    
624  C<< my $fileName = $shelp->GetTempFileName($type); >>      my $fileName = $shelp->GetTempFileName($type);
625    
626  Return the name to be used for a temporary file of the specified type. The  Return the name to be used for a temporary file of the specified type. The
627  name is computed from the session name with the type as a suffix.  name is computed from the session name with the type as a suffix.
# Line 639  Line 652 
652    
653  =head3 WriteColumnHeaders  =head3 WriteColumnHeaders
654    
655  C<< $shelp->WriteColumnHeaders(@colNames); >>      $shelp->WriteColumnHeaders(@colNames);
656    
657  Write out the column headers for the current search session. The column headers  Write out the column headers for the current search session. The column headers
658  are sent to the cache file, and then the cache is re-opened as a sort pipe and  are sent to the cache file, and then the cache is re-opened as a sort pipe and
# Line 674  Line 687 
687      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
688  }  }
689    
690    =head3 SetNotice
691    
692        $shelp->SetNotice($message);
693    
694    This method creates a notice that will be displayed on the search results
695    page. After the search is complete, notices are placed in a small temporary
696    file that is checked by the results display engine.
697    
698    =over 4
699    
700    =item message
701    
702    Message to write to the notice file.
703    
704    =back
705    
706    =cut
707    
708    sub SetNotice {
709        # Get the parameters.
710        my ($self, $message) = @_;
711        # Save the message.
712        push @{$self->{notices}}, $message;
713    }
714    
715    
716  =head3 ReadColumnHeaders  =head3 ReadColumnHeaders
717    
718  C<< my @colHdrs = $shelp->ReadColumnHeaders($fh); >>      my @colHdrs = $shelp->ReadColumnHeaders($fh);
719    
720  Read the column headers from the specified file handle. The column headers are  Read the column headers from the specified file handle. The column headers are
721  frozen strings intermixed with frozen hash references. The strings represent  frozen strings intermixed with frozen hash references. The strings represent
# Line 708  Line 747 
747    
748  =head3 WriteColumnData  =head3 WriteColumnData
749    
750  C<< $shelp->WriteColumnData($key, @colValues); >>      $shelp->WriteColumnData($key, @colValues);
751    
752  Write a row of column values to the current search session. It is assumed that  Write a row of column values to the current search session. It is assumed that
753  the session file is already open for output.  the session file is already open for output.
# Line 737  Line 776 
776    
777  =head3 CloseSession  =head3 CloseSession
778    
779  C<< $shelp->CloseSession(); >>      $shelp->CloseSession();
780    
781  Close the session file.  Close the session file.
782    
# Line 755  Line 794 
794          my $cgi = $self->Q();          my $cgi = $self->Q();
795          $self->PrintLine("Output formatting complete.<br />");          $self->PrintLine("Output formatting complete.<br />");
796      }      }
797        # Check for notices.
798        my @notices = @{$self->{notices}};
799        if (scalar @notices) {
800            # We have some, so put then in a notice file.
801            my $noticeFile = $self->GetTempFileName('notices');
802            my $nh = Open(undef, ">$noticeFile");
803            print $nh join("\n", @notices, "");
804            close $nh;
805            $self->PrintLine(scalar(@notices) . " notices saved.<br />");
806        }
807  }  }
808    
809  =head3 OrganismData  =head3 OrganismData
810    
811  C<< my ($orgName, $group) = $shelp->Organism($genomeID); >>      my ($orgName, $group) = $shelp->Organism($genomeID);
812    
813  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.
814  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 790  Line 839 
839      my $cache = $self->{orgs};      my $cache = $self->{orgs};
840      if (exists $cache->{$genomeID}) {      if (exists $cache->{$genomeID}) {
841          ($orgName, $group, $domain) = @{$cache->{$genomeID}};          ($orgName, $group, $domain) = @{$cache->{$genomeID}};
842            Trace("Cached organism $genomeID has group \"$group\".") if T(4);
843      } else {      } else {
844          # Here we have to use the database.          # Here we have to use the database.
845          my $sprout = $self->DB();          my $sprout = $self->DB();
846          my ($genus, $species, $strain, $group, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,          my ($genus, $species, $strain, $newGroup, $taxonomy) = $sprout->GetEntityValues('Genome', $genomeID,
847                                                                  ['Genome(genus)', 'Genome(species)',                                                                  ['Genome(genus)', 'Genome(species)',
848                                                                   'Genome(unique-characterization)',                                                                   'Genome(unique-characterization)',
849                                                                   'Genome(primary-group)',                                                                   'Genome(primary-group)',
850                                                                   'Genome(taxonomy)']);                                                                   'Genome(taxonomy)']);
851          # Format and cache the name and display group.          # Format and cache the name and display group.
852          ($orgName, $group, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,          Trace("Caching organism $genomeID with group \"$newGroup\".") if T(4);
853            ($orgName, $group, $domain) = $self->SaveOrganismData($newGroup, $genomeID, $genus, $species,
854                                                                $strain, $taxonomy);                                                                $strain, $taxonomy);
855            Trace("Returning group $group.") if T(4);
856      }      }
857      # Return the result.      # Return the result.
858      return ($orgName, $group, $domain);      return ($orgName, $group, $domain);
# Line 808  Line 860 
860    
861  =head3 Organism  =head3 Organism
862    
863  C<< my $orgName = $shelp->Organism($genomeID); >>      my $orgName = $shelp->Organism($genomeID);
864    
865  Return the name of the relevant organism. The name is computed from the genus,  Return the name of the relevant organism. The name is computed from the genus,
866  species, and unique characterization. A cache is used to improve performance.  species, and unique characterization. A cache is used to improve performance.
# Line 838  Line 890 
890    
891  =head3 ComputeFASTA  =head3 ComputeFASTA
892    
893  C<< my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth); >>      my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth, $comments);
894    
895  Parse a sequence input and convert it into a FASTA string of the desired type with  Parse a sequence input and convert it into a FASTA string of the desired type with
896  the desired flanking width.  the desired flanking width.
# Line 865  Line 917 
917  protein translation of a feature doesn't always match the DNA and is taken directly  protein translation of a feature doesn't always match the DNA and is taken directly
918  from the database.  from the database.
919    
920    =item comments
921    
922    Comment string to be added to the FASTA header.
923    
924  =item RETURN  =item RETURN
925    
926  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 877  Line 933 
933    
934  sub ComputeFASTA {  sub ComputeFASTA {
935      # Get the parameters.      # Get the parameters.
936      my ($self, $desiredType, $sequence, $flankingWidth) = @_;      my ($self, $desiredType, $sequence, $flankingWidth, $comment) = @_;
937      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
938      my $retVal;      my $retVal;
939      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 887  Line 943 
943      Trace("FASTA desired type is $desiredType.") if T(4);      Trace("FASTA desired type is $desiredType.") if T(4);
944      # Check for a feature specification. The smoking gun for that is a vertical bar.      # Check for a feature specification. The smoking gun for that is a vertical bar.
945      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {      if ($sequence =~ /^\s*(\w+\|\S+)\s*$/) {
946          # Here we have a feature ID in $1. We'll need the Sprout object to process          # Here we have a feature ID in $1. We'll need a Sprout object to process it.
         # it.  
947          my $fid = $1;          my $fid = $1;
948          Trace("Feature ID for fasta is $fid.") if T(3);          Trace("Feature ID for fasta is $fid.") if T(3);
949          my $sprout = $self->DB();          my $sprout = $self->DB();
# Line 908  Line 963 
963                  # In an emergency, fall back to the original ID.                  # In an emergency, fall back to the original ID.
964                  $fastaLabel = $fid;                  $fastaLabel = $fid;
965              }              }
966                # Add any specified comments.
967                if ($comment) {
968                    $fastaLabel .= " $comment";
969                }
970              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
971              if ($desiredType =~ /prot/) {              if ($desiredType =~ /prot/) {
972                  # We want protein, so get the translation.                  # We want protein, so get the translation.
# Line 970  Line 1029 
1029          if ($desiredType !~ /pattern/i) {          if ($desiredType !~ /pattern/i) {
1030              $fastaData =~ s/\n//g;              $fastaData =~ s/\n//g;
1031              $fastaData =~ s/\s+//g;              $fastaData =~ s/\s+//g;
1032                $fastaData =~ s/\d+//g;
1033          }          }
1034          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
1035          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn-]/i) {
# Line 999  Line 1059 
1059    
1060  =head3 SubsystemTree  =head3 SubsystemTree
1061    
1062  C<< my $tree = SearchHelper::SubsystemTree($sprout, %options); >>      my $tree = SearchHelper::SubsystemTree($sprout, %options);
1063    
1064  This method creates a subsystem selection tree suitable for passing to  This method creates a subsystem selection tree suitable for passing to
1065  L</SelectionTree>. Each leaf node in the tree will have a link to the  L</SelectionTree>. Each leaf node in the tree will have a link to the
# Line 1057  Line 1117 
1117              push @subs, $classLess;              push @subs, $classLess;
1118          }          }
1119      }      }
1120        # Get the seedviewer URL.
1121        my $svURL = $FIG_Config::linkinSV || "$FIG_Config::cgi_url/seedviewer.cgi";
1122        Trace("Seed Viewer URL is $svURL.") if T(3);
1123      # Declare the return variable.      # Declare the return variable.
1124      my @retVal = ();      my @retVal = ();
1125      # Each element in @subs represents a leaf node, so as we loop through it we will be      # Each element in @subs represents a leaf node, so as we loop through it we will be
# Line 1131  Line 1194 
1194              if ($optionThing->{links}) {              if ($optionThing->{links}) {
1195                  # Compute the link value.                  # Compute the link value.
1196                  my $linkable = uri_escape($id);                  my $linkable = uri_escape($id);
1197                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;show_clusters=1;SPROUT=1";                  $nodeContent->{link} = "$svURL?page=Subsystems;subsystem=$linkable";
1198              }              }
1199              if ($optionThing->{radio}) {              if ($optionThing->{radio}) {
1200                  # Compute the radio value.                  # Compute the radio value.
# Line 1149  Line 1212 
1212    
1213  =head3 NmpdrGenomeMenu  =head3 NmpdrGenomeMenu
1214    
1215  C<< my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows); >>      my $htmlText = $shelp->NmpdrGenomeMenu($menuName, $multiple, \@selected, $rows);
1216    
1217  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The  This method creates a hierarchical HTML menu for NMPDR genomes organized by category. The
1218  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it  category indicates the low-level NMPDR group. Organizing the genomes in this way makes it
# Line 1178  Line 1241 
1241    
1242  =item crossMenu (optional)  =item crossMenu (optional)
1243    
1244  If specified, is presumed to be the name of another genome menu whose contents  This is currently not supported.
 are to be mutually exclusive with the contents of this menu. As a result, instead  
 of the standard onChange event, the onChange event will deselect any entries in  
 the other menu.  
1245    
1246  =item RETURN  =item RETURN
1247    
# Line 1201  Line 1261 
1261      if (! defined $rows) {      if (! defined $rows) {
1262          $rows = ($multiple ? 10 : 1);          $rows = ($multiple ? 10 : 1);
1263      }      }
1264      # Create the multiple tag.      # Get a comma-delimited list of the preselected genomes.
1265      my $multipleTag = ($multiple ? " multiple" : "");      my $preselected = "";
1266      # Get the form name.      if ($selected) {
1267      my $formName = $self->FormName();          $preselected = join(", ", @$selected);
1268      # Check to see if we already have a genome list in memory.      }
1269      my $groupHash;      # Ask Sprout for a genome menu.
1270      my @groups;      my $retVal = $sprout->GenomeMenu(name => $menuName,
1271      my $nmpdrGroupCount;                                       multiSelect => $multiple,
1272      my $genomes = $self->{genomeList};                                       selected => $preselected,
1273      if (defined $genomes) {                                       size => $rows);
         # We have a list ready to use.  
         $groupHash = $genomes;  
         @groups = @{$self->{groupList}};  
         $nmpdrGroupCount = $self->{groupCount};  
     } else {  
         # Get a list of all the genomes in group order. In fact, we only need them ordered  
         # by name (genus,species,strain), but putting primary-group in front enables us to  
         # take advantage of an existing index.  
         my @genomeList = $sprout->GetAll(['Genome'],  
                                          "ORDER BY Genome(primary-group), Genome(genus), Genome(species), Genome(unique-characterization)",  
                                          [], ['Genome(primary-group)', 'Genome(id)',  
                                               'Genome(genus)', 'Genome(species)',  
                                               'Genome(unique-characterization)',  
                                               'Genome(taxonomy)']);  
         # Create a hash to organize the genomes by group. Each group will contain a list of  
         # 2-tuples, the first element being the genome ID and the second being the genome  
         # name.  
         my %gHash = ();  
         for my $genome (@genomeList) {  
             # Get the genome data.  
             my ($group, $genomeID, $genus, $species, $strain, $taxonomy) = @{$genome};  
             # Compute and cache its name and display group.  
             my ($name, $displayGroup, $domain) = $self->SaveOrganismData($group, $genomeID, $genus, $species,  
                                                                          $strain, $taxonomy);  
             # Push the genome into the group's list. Note that we use the real group  
             # name here, not the display group name.  
             push @{$gHash{$group}}, [$genomeID, $name, $domain];  
         }  
         # We are almost ready to unroll the menu out of the group hash. The final step is to separate  
         # the supporting genomes by domain. First, we sort the NMPDR groups.  
         @groups = sort grep { $_ ne $FIG_Config::otherGroup } keys %gHash;  
         # Remember the number of NMPDR groups.  
         $nmpdrGroupCount = scalar @groups;  
         # Loop through the supporting genomes, classifying them by domain. We'll also keep a list  
         # of the domains found.  
         my @otherGenomes = @{$gHash{$FIG_Config::otherGroup}};  
         my @domains = ();  
         for my $genomeData (@otherGenomes) {  
             my ($genomeID, $name, $domain) = @{$genomeData};  
             if (exists $gHash{$domain}) {  
                 push @{$gHash{$domain}}, $genomeData;  
             } else {  
                 $gHash{$domain} = [$genomeData];  
                 push @domains, $domain;  
             }  
         }  
         # Add the domain groups at the end of the main group list. The main group list will now  
         # contain all the categories we need to display the genomes.  
         push @groups, sort @domains;  
         # Delete the supporting group.  
         delete $gHash{$FIG_Config::otherGroup};  
         # Save the genome list for future use.  
         $self->{genomeList} = \%gHash;  
         $self->{groupList} = \@groups;  
         $self->{groupCount} = $nmpdrGroupCount;  
         $groupHash = \%gHash;  
     }  
     # Next, create a hash that specifies the pre-selected entries. Note that we need to deal  
     # with the possibility of undefined values in the incoming list.  
     my %selectedHash = ();  
     if (defined $selected) {  
         %selectedHash = map { $_ => 1 } grep { defined($_) } @{$selected};  
     }  
     # Now it gets complicated. We need a way to mark all the NMPDR genomes. We take advantage  
     # of the fact they come first in the list. We'll accumulate a count of the NMPDR genomes  
     # and use that to make the selections.  
     my $nmpdrCount = 0;  
     # Create the type counters.  
     my $groupCount = 1;  
     # Compute the ID for the status display.  
     my $divID = "${formName}_${menuName}_status";  
     # Compute the JavaScript call for updating the status.  
     my $showSelect = "showSelected($menuName, '$divID', 1000);";  
     # If multiple selection is supported, create an onChange event.  
     my $onChange = "";  
     if ($cross) {  
         # Here we have a paired menu. Selecting something in our menu unselects it in the  
         # other and redisplays the status of both.  
         $onChange = " onChange=\"crossUnSelect($menuName, '$divID', $cross, '${formName}_${cross}_status', 1000)\"";  
     } elsif ($multiple) {  
         # This is an unpaired menu, so all we do is redisplay our status.  
         $onChange = " onChange=\"$showSelect\"";  
     }  
     # Create the SELECT tag and stuff it into the output array.  
     my @lines = ("<SELECT name=\"$menuName\"$onChange$multipleTag size=\"$rows\">");  
     # Loop through the groups.  
     for my $group (@groups) {  
         # Create the option group tag.  
         my $tag = "<OPTGROUP label=\"$group\">";  
         push @lines, "  $tag";  
         # Get the genomes in the group.  
         for my $genome (@{$groupHash->{$group}}) {  
             # Count this organism if it's NMPDR.  
             if ($nmpdrGroupCount > 0) {  
                 $nmpdrCount++;  
             }  
             # Get the organism ID, name, and domain.  
             my ($genomeID, $name, $domain) = @{$genome};  
             # See if it's selected.  
             my $select = ($selectedHash{$genomeID} ? " selected" : "");  
             # Generate the option tag.  
             my $optionTag = "<OPTION class=\"$domain\" value=\"$genomeID\"$select>$name <em>($genomeID)</em></OPTION>";  
             push @lines, "    $optionTag";  
         }  
         # Close the option group.  
         push @lines, "  </OPTGROUP>";  
         # Record this group in the nmpdrGroup count. When that gets to 0, we've finished the NMPDR  
         # groups.  
         $nmpdrGroupCount--;  
     }  
     # Close the SELECT tag.  
     push @lines, "</SELECT>";  
     # Check for multiple selection.  
     if ($multiple) {  
         # Multi-select is on, so we need to add some selection helpers. First is  
         # the search box. This allows the user to type text and have all genomes containing  
         # the text selected automatically.  
         my $searchThingName = "${menuName}_SearchThing";  
         push @lines, "<br />" .  
                      "<INPUT type=\"button\" name=\"MacroSearch\" class=\"button\" value=\"Select genomes containing\" onClick=\"selectViaSearch($menuName, $searchThingName); $showSelect\" />&nbsp;" .  
                      "<INPUT type=\"text\" name=\"$searchThingName\" size=\"30\" />" . Hint("Enter a genome number click the button to the left " .  
                                                                                             "in order to select the genome with that number. " .  
                                                                                             "Enter a genus, species, or strain and click the " .  
                                                                                             "button to select all genomes with that genus, species, " .  
                                                                                             "or strain name.");  
         # Next are the buttons to set and clear selections.  
         push @lines, "<br />";  
         push @lines, "<INPUT type=\"button\" name=\"ClearAll\" class=\"bigButton\"  value=\"Clear All\" onClick=\"clearAll($menuName); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"SelectAll\" class=\"bigButton\" value=\"Select All\" onClick=\"selectAll($menuName); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"NMPDROnly\" class=\"bigButton\"  value=\"Select NMPDR\" onClick=\"selectSome($menuName, $nmpdrCount, true); $showSelect\" />";  
         push @lines, "<INPUT type=\"button\" name=\"OtherOnly\" class=\"bigButton\" value=\"Select Supporting\" onClick=\"selectSome($menuName, $nmpdrCount, false); $showSelect\" />";  
         # Add the status display, too.  
         push @lines, "<DIV id=\"$divID\" class=\"selectStatus\"></DIV>";  
         # Queue to update the status display when the form loads. We need to modify the show statement  
         # slightly because the queued statements are executed outside the form. This may seem like a lot of  
         # trouble, but we want all of the show statement calls to be generated from a single line of code,  
         # in case we decide to twiddle the parameters.  
         $showSelect =~ s/showSelected\(/showSelected\(thisForm\./;  
         $self->QueueFormScript($showSelect);  
         # Finally, add this parameter to the list of genome parameters. This enables us to  
         # easily find all the parameters used to select one or more genomes.  
         push @{$self->{genomeParms}}, $menuName;  
     }  
     # Assemble all the lines into a string.  
     my $retVal = join("\n", @lines, "");  
     # Return the result.  
     return $retVal;  
 }  
   
 =head3 PropertyMenu  
   
 C<< my $htmlText = $shelp->PropertyMenu($menuName, $selected, $force); >>  
   
 Generate a property name dropdown menu.  
   
 =over 4  
   
 =item menuName  
   
 Name to give to the menu.  
   
 =item selected  
   
 Value of the property name to pre-select.  
   
 =item force (optional)  
   
 If TRUE, then the user will be forced to choose a property name. If FALSE,  
 then an additional menu choice will be provided to select nothing.  
   
 =item RETURN  
   
 Returns a dropdown menu box that allows the user to select a property name. An additional  
 selection entry will be provided for selecting no property name  
   
 =back  
   
 =cut  
   
 sub PropertyMenu {  
     # Get the parameters.  
     my ($self, $menuName, $selected, $force) = @_;  
     # Get the CGI and Sprout objects.  
     my $sprout = $self->DB();  
     my $cgi = $self->Q();  
     # Create the property name list.  
     my @propNames = ();  
     if (! $force) {  
         push @propNames, "";  
     }  
     # Get all the property names, putting them after the null choice if one exists.  
     push @propNames, $sprout->GetChoices('Property', 'property-name');  
     # Create a menu from them.  
     my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,  
                                   -default => $selected);  
1274      # Return the result.      # Return the result.
1275      return $retVal;      return $retVal;
1276  }  }
1277    
1278  =head3 MakeTable  =head3 MakeTable
1279    
1280  C<< my $htmlText = $shelp->MakeTable(\@rows); >>      my $htmlText = $shelp->MakeTable(\@rows);
1281    
1282  Create a table from a group of table rows. The table rows must be fully pre-formatted: in  Create a table from a group of table rows. The table rows must be fully pre-formatted: in
1283  other words, each must have the TR and TD tags included.  other words, each must have the TR and TD tags included.
# Line 1466  Line 1331 
1331          }          }
1332      }      }
1333      # Create the table.      # Create the table.
1334      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = CGI::table({border => 2, cellspacing => 2,
1335                                width => 700, class => 'search'},                                width => 700, class => 'search'},
1336                               @{$rows});                               @{$rows});
1337      # Return the result.      # Return the result.
# Line 1475  Line 1340 
1340    
1341  =head3 SubmitRow  =head3 SubmitRow
1342    
1343  C<< my $htmlText = $shelp->SubmitRow($caption); >>      my $htmlText = $shelp->SubmitRow($caption);
1344    
1345  Returns the HTML text for the row containing the page size control  Returns the HTML text for the row containing the page size control
1346  and the submit button. All searches should have this row somewhere  and the submit button. All searches should have this row somewhere
# Line 1504  Line 1369 
1369      my $realCaption = (defined $caption ? $caption : 'Go');      my $realCaption = (defined $caption ? $caption : 'Go');
1370      # Get the current page size.      # Get the current page size.
1371      my $pageSize = $cgi->param('PageSize');      my $pageSize = $cgi->param('PageSize');
1372        # Get the form name.
1373        my $formName = $self->FormName();
1374      # Get the current feature ID type.      # Get the current feature ID type.
1375      my $aliasType = $self->GetPreferredAliasType();      my $aliasType = $self->GetPreferredAliasType();
1376      # Create the rows.      # Create the rows.
1377      my $retVal = $cgi->Tr($cgi->td("ID Type"), $cgi->td({ colspan => 2 },      my $retVal = CGI::Tr(CGI::td("Identifier Type "),
1378                                                          $cgi->popup_menu(-name => 'AliasType',                            CGI::td({ colspan => 2 },
1379                                       CGI::popup_menu(-name => 'AliasType',
1380                                                                           -values => ['FIG', AliasAnalysis::AliasTypes() ],                                                                           -values => ['FIG', AliasAnalysis::AliasTypes() ],
1381                                                                           -default => $aliasType) .                                                                           -default => $aliasType) .
1382                                                          Hint("Specify how you want gene names to be displayed."))) .                                     Hint("Identifier Type", 27))) .
1383                   "\n" .                   "\n" .
1384                   $cgi->Tr($cgi->td("Results/Page"),                   CGI::Tr(CGI::td("Results/Page"),
1385                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            CGI::td(CGI::popup_menu(-name => 'PageSize',
1386                                                      -values => [10, 25, 50, 100, 1000],                                                    -values => [50, 10, 25, 100, 1000],
1387                                                      -default => $pageSize)),                                                      -default => $pageSize)),
1388                            $cgi->td($cgi->submit(-class => 'goButton',                            CGI::td(CGI::submit(-class => 'goButton',
1389                                                  -name => 'Search',                                                  -name => 'Search',
1390                                                  -value => $realCaption)));                                                  -value => $realCaption)));
1391      # Return the result.      # Return the result.
# Line 1526  Line 1394 
1394    
1395  =head3 GetGenomes  =head3 GetGenomes
1396    
1397  C<< my @genomeList = $shelp->GetGenomes($parmName); >>      my @genomeList = $shelp->GetGenomes($parmName);
1398    
1399  Return the list of genomes specified by the specified CGI query parameter.  Return the list of genomes specified by the specified CGI query parameter.
1400  If the request method is POST, then the list of genome IDs is returned  If the request method is POST, then the list of genome IDs is returned
# Line 1568  Line 1436 
1436      return @retVal;      return @retVal;
1437  }  }
1438    
 =head3 GetHelpText  
   
 C<< my $htmlText = $shelp->GetHelpText(); >>  
   
 Get the help text for this search. The help text is stored in files on the template  
 server. The help text for a specific search is taken from a file named  
 C<SearchHelp_>I<class>C<.inc> in the template directory C<$FIG_Config::template_url>.  
 There are also three standard help files: C<SearchHelp1_Filtering.inc> describes the  
 feature filtering performed by the B<FeatureQuery> object, C<SearchHelp1_GenomeControl.inc>  
 describes how to use a multiple-selection genome control, and C<SearchHelp1_Standard.inc>  
 describes the standard controls for a search, such as page size, URL display, and  
 external alias display.  
   
 =cut  
   
 sub GetHelpText {  
     # Get the parameters.  
     my ($self) = @_;  
     # Create a list to hold the pieces of the help.  
     my @helps = ();  
     # Get the template directory URL.  
     my $urlBase = $FIG_Config::template_url;  
     # Start with the specific help.  
     my $class = $self->{class};  
     push @helps, PageBuilder::GetPage("$urlBase/SearchHelp_$class.inc");  
     # Add the genome control help if needed.  
     if (scalar @{$self->{genomeParms}}) {  
         push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_GenomeControl.inc");  
     }  
     # Next the filter help.  
     if ($self->{filtered}) {  
         push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Filtering.inc");  
     }  
     # Finally, the standard help.  
     push @helps, PageBuilder::GetPage("$urlBase/SearchHelp1_Standard.inc");  
     # Assemble the pieces.  
     my $retVal = join("\n<p>&nbsp;</p>\n", @helps);  
     # Return the result.  
     return $retVal;  
 }  
   
1439  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1440    
1441  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>      my $url = $shelp->ComputeSearchURL(%overrides);
1442    
1443  Compute the GET-style URL for the current search. In order for this to work, there  Compute the GET-style URL for the current search. In order for this to work, there
1444  must be a copy of the search form on the current page. This will always be the  must be a copy of the search form on the current page. This will always be the
# Line 1644  Line 1471 
1471      my $cgi = $self->Q();      my $cgi = $self->Q();
1472      my $sprout = $self->DB();      my $sprout = $self->DB();
1473      # Start with the full URL.      # Start with the full URL.
1474      my $retVal = $cgi->url(-full => 1);      my $retVal = "$FIG_Config::cgi_url/SearchSkeleton.cgi";
1475      # Get all the query parameters in a hash.      # Get all the query parameters in a hash.
1476      my %parms = $cgi->Vars();      my %parms = $cgi->Vars();
1477      # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null      # Now we need to do some fixing. Each multi-valued parameter is encoded as a string with null
# Line 1704  Line 1531 
1531    
1532  =head3 AdvancedClassList  =head3 AdvancedClassList
1533    
1534  C<< my @classes = SearchHelper::AdvancedClassList(); >>      my @classes = SearchHelper::AdvancedClassList();
1535    
1536  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
1537  of available searches on the search page.  of available searches on the search page.
# Line 1727  Line 1554 
1554    
1555  =head3 SelectionTree  =head3 SelectionTree
1556    
1557  C<< my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options); >>      my $htmlText = SearchHelper::SelectionTree($cgi, \%tree, %options);
1558    
1559  Display a selection tree.  Display a selection tree.
1560    
# Line 1836  Line 1663 
1663  =item nodeImageClosed  =item nodeImageClosed
1664    
1665  URL of the image to display next to the tree nodes when they are collapsed. Clicking  URL of the image to display next to the tree nodes when they are collapsed. Clicking
1666  on the image will expand a section of the tree. The default is C<../FIG/Html/plus.gif>.  on the image will expand a section of the tree. The default is C<plus.gif>.
1667    
1668  =item nodeImageOpen  =item nodeImageOpen
1669    
1670  URL of the image to display next to the tree nodes when they are expanded. Clicking  URL of the image to display next to the tree nodes when they are expanded. Clicking
1671  on the image will collapse a section of the tree. The default is C<../FIG/Html/minus.gif>.  on the image will collapse a section of the tree. The default is C<minus.gif>.
1672    
1673  =item style  =item style
1674    
# Line 1881  Line 1708 
1708      my ($cgi, $tree, %options) = @_;      my ($cgi, $tree, %options) = @_;
1709      # Get the options.      # Get the options.
1710      my $optionThing = Tracer::GetOptions({ name => 'selection',      my $optionThing = Tracer::GetOptions({ name => 'selection',
1711                                             nodeImageClosed => '../FIG/Html/plus.gif',                                             nodeImageClosed => "$FIG_Config::cgi_url/Html/plus.gif",
1712                                             nodeImageOpen => '../FIG/Html/minus.gif',                                             nodeImageOpen => "$FIG_Config::cgi_url/Html/minus.gif",
1713                                             style => 'tree',                                             style => 'tree',
1714                                             target => '_self',                                             target => '_self',
1715                                             selected => undef},                                             selected => undef},
# Line 1901  Line 1728 
1728              Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");              Confess("Hash reference found at start of selection tree. The tree as a whole cannot have attributes, only tree nodes.");
1729          } else {          } else {
1730              # Here we have a real tree. Apply the tree style.              # Here we have a real tree. Apply the tree style.
1731              push @retVal, $cgi->start_div({ class => $optionThing->{style} });              push @retVal, CGI::start_div({ class => $optionThing->{style} });
1732              # Give us a DIV ID.              # Give us a DIV ID.
1733              my $divID = GetDivID($optionThing->{name});              my $divID = GetDivID($optionThing->{name});
1734              # Show the tree.              # Show the tree.
1735              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
1736              # Close the DIV block.              # Close the DIV block.
1737              push @retVal, $cgi->end_div();              push @retVal, CGI::end_div();
1738          }          }
1739      }      }
1740      # Return the result.      # Return the result.
# Line 1916  Line 1743 
1743    
1744  =head3 ShowBranch  =head3 ShowBranch
1745    
1746  C<< my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType); >>      my @htmlLines = SearchHelper::ShowBranch($cgi, $label, $id, $branch, $options, $displayType);
1747    
1748  This is a recursive method that displays a branch of the tree.  This is a recursive method that displays a branch of the tree.
1749    
# Line 1965  Line 1792 
1792      # Declare the return variable.      # Declare the return variable.
1793      my @retVal = ();      my @retVal = ();
1794      # Start the branch.      # Start the branch.
1795      push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });      push @retVal, CGI::start_ul({ id => $id, style => "display:$displayType" });
1796      # Check for the hash and choose the start location accordingly.      # Check for the hash and choose the start location accordingly.
1797      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
1798      # Get the list length.      # Get the list length.
# Line 2011  Line 1838 
1838                      # If we have children, create the child list with a recursive call.                      # If we have children, create the child list with a recursive call.
1839                      if ($hasChildren) {                      if ($hasChildren) {
1840                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
1841                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'block');
1842                          Trace("Children of $myLabel finished.") if T(4);                          Trace("Children of $myLabel finished.") if T(4);
1843                      }                      }
1844                  }                  }
# Line 2023  Line 1850 
1850              # closed images.              # closed images.
1851              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
1852              my $image = $images[$hasChildren];              my $image = $images[$hasChildren];
1853              my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});              my $prefixHtml = CGI::img({src => $image, id => "${myID}img"});
1854              if ($hasChildren) {              if ($hasChildren) {
1855                  # If there are children, we wrap the image in a toggle hyperlink.                  # If there are children, we wrap the image in a toggle hyperlink.
1856                  $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },                  $prefixHtml = CGI::a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
1857                                        $prefixHtml);                                        $prefixHtml);
1858              }              }
1859              # Now the radio button, if any. Note we use "defined" in case the user wants the              # Now the radio button, if any. Note we use "defined" in case the user wants the
# Line 2043  Line 1870 
1870                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
1871                      $radioParms->{checked} = undef;                      $radioParms->{checked} = undef;
1872                  }                  }
1873                  $prefixHtml .= $cgi->input($radioParms);                  $prefixHtml .= CGI::input($radioParms);
1874              }              }
1875              # Next, we format the label.              # Next, we format the label.
1876              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
1877              Trace("Formatting tree node for \"$myLabel\".") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
1878              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
1879              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
1880                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = CGI::a({ href => $attrHash->{link}, target => $options->{target} },
1881                                       $labelHtml);                                       $labelHtml);
1882              }              }
1883              # Finally, roll up the child HTML. If there are no children, we'll get a null string              # Finally, roll up the child HTML. If there are no children, we'll get a null string
1884              # here.              # here.
1885              my $childHtml = join("\n", @childHtml);              my $childHtml = join("\n", @childHtml);
1886              # Now we have all the pieces, so we can put them together.              # Now we have all the pieces, so we can put them together.
1887              push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");              push @retVal, CGI::li("$prefixHtml$labelHtml$childHtml");
1888          }          }
1889      }      }
1890      # Close the tree branch.      # Close the tree branch.
1891      push @retVal, $cgi->end_ul();      push @retVal, CGI::end_ul();
1892      # Return the result.      # Return the result.
1893      return @retVal;      return @retVal;
1894  }  }
1895    
1896  =head3 GetDivID  =head3 GetDivID
1897    
1898  C<< my $idString = SearchHelper::GetDivID($name); >>      my $idString = SearchHelper::GetDivID($name);
1899    
1900  Return a new HTML ID string.  Return a new HTML ID string.
1901    
# Line 2099  Line 1926 
1926    
1927  =head3 PrintLine  =head3 PrintLine
1928    
1929  C<< $shelp->PrintLine($message); >>      $shelp->PrintLine($message);
1930    
1931  Print a line of CGI output. This is used during the operation of the B<Find> method while  Print a line of CGI output. This is used during the operation of the B<Find> method while
1932  searching, so the user sees progress in real-time.  searching, so the user sees progress in real-time.
# Line 2117  Line 1944 
1944  sub PrintLine {  sub PrintLine {
1945      # Get the parameters.      # Get the parameters.
1946      my ($self, $message) = @_;      my ($self, $message) = @_;
1947      # Send them to the output.      # Send the message to the output.
1948      print "$message\n";      print "$message\n";
1949  }  }
1950    
1951  =head3 GetHelper  =head3 GetHelper
1952    
1953  C<< my $shelp = SearchHelper::GetHelper($parm, $type => $className); >>      my $shelp = SearchHelper::GetHelper($parm, $type => $className);
1954    
1955  Return a helper object with the given class name. If no such class exists, an  Return a helper object with the given class name. If no such class exists, an
1956  error will be thrown.  error will be thrown.
# Line 2169  Line 1996 
1996          # Commit suicide if it didn't work.          # Commit suicide if it didn't work.
1997          if (! defined $retVal) {          if (! defined $retVal) {
1998              die "Could not find a $type handler of type $className.";              die "Could not find a $type handler of type $className.";
1999            } else {
2000                # Perform any necessary subclass initialization.
2001                $retVal->Initialize();
2002          }          }
2003      };      };
2004      # Check for errors.      # Check for errors.
# Line 2181  Line 2011 
2011    
2012  =head3 SaveOrganismData  =head3 SaveOrganismData
2013    
2014  C<< my ($name, $displayGroup) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy); >>      my ($name, $displayGroup, $domain) = $shelp->SaveOrganismData($group, $genomeID, $genus, $species, $strain, $taxonomy);
2015    
2016  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
2017  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 2242  Line 2072 
2072          # 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
2073          # name unless it's the supporting group, which is nulled out.          # name unless it's the supporting group, which is nulled out.
2074          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);          $displayGroup = ($group eq $FIG_Config::otherGroup ? "" : $group);
2075            Trace("Group = $displayGroup, translated from \"$group\".") if T(4);
2076      }      }
2077      # Compute the domain from the taxonomy.      # Compute the domain from the taxonomy.
2078      my ($domain) = split /\s*;\s*/, $taxonomy, 2;      my ($domain) = split /\s*;\s*/, $taxonomy, 2;
# Line 2254  Line 2085 
2085    
2086  =head3 ValidateKeywords  =head3 ValidateKeywords
2087    
2088  C<< my $okFlag = $shelp->ValidateKeywords($keywordString, $required); >>      my $okFlag = $shelp->ValidateKeywords($keywordString, $required);
2089    
2090  Insure that a keyword string is reasonably valid. If it is invalid, a message will be  Insure that a keyword string is reasonably valid. If it is invalid, a message will be
2091  set.  set.
# Line 2304  Line 2135 
2135    
2136  =head3 TuningParameters  =head3 TuningParameters
2137    
2138  C<< my $options = $shelp->TuningParameters(%parmHash); >>      my $options = $shelp->TuningParameters(%parmHash);
2139    
2140  Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names  Retrieve tuning parameters from the CGI query object. The parameter is a hash that maps parameter names
2141  to their default values. The parameters and their values will be returned as a hash reference.  to their default values. The parameters and their values will be returned as a hash reference.
# Line 2345  Line 2176 
2176      return $retVal;      return $retVal;
2177  }  }
2178    
2179    =head3 ParseIDList
2180    
2181        my @idList = $sh->ParseIDList($string);
2182    
2183    Compute the list of IDs found in the specified string. In the string, any
2184    comma, quote, or white space character is considered a delimiter.
2185    Everything else is considered an ID.
2186    
2187    =over 4
2188    
2189    =item string
2190    
2191    Input string containing the IDs.
2192    
2193    =item RETURN
2194    
2195    Returns a list of the IDs found.
2196    
2197    =back
2198    
2199    =cut
2200    
2201    sub ParseIDList {
2202        # Get the parameters.
2203        my ($self, $string) = @_;
2204        # Declare the return variable.
2205        my $retVal;
2206        # Get a safety copy of the string.
2207        my $line = $string;
2208        # Convert all delimiter sequences to spaces.
2209        $line =~ s/[\s"',]+/ /gs;
2210        # Split the result and remove empty entries.
2211        my @retVal = grep { $_ } split / /, $line;
2212        # Return the result.
2213        return @retVal;
2214    }
2215    
2216    
2217    
2218    
2219  =head3 GetPreferredAliasType  =head3 GetPreferredAliasType
2220    
2221  C<< my $type = $shelp->GetPreferredAliasType(); >>      my $type = $shelp->GetPreferredAliasType();
2222    
2223  Return the preferred alias type for the current session. This information is stored  Return the preferred alias type for the current session. This information is stored
2224  in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>  in the C<AliasType> parameter of the CGI query object, and the default is C<FIG>
# Line 2365  Line 2236 
2236      return $retVal;      return $retVal;
2237  }  }
2238    
2239    =head3 Hint
2240    
2241        my $htmlText = SearchHelper::Hint($wikiPage, $hintID);
2242    
2243    Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2244    This HTML can be put in forms to provide a useful hinting mechanism.
2245    
2246    =over 4
2247    
2248    =item wikiPage
2249    
2250    Name of the wiki page to be popped up when the hint mark is clicked.
2251    
2252    =item hintID
2253    
2254    ID of the text to display for the hint. This is the ID number for a tip-of-the-day.
2255    
2256    =item RETURN
2257    
2258    Returns the html for the hint facility. The resulting html shows a small button-like thing that
2259    uses the standard FIG popup technology.
2260    
2261    =back
2262    
2263    =cut
2264    
2265    sub Hint {
2266        # Get the parameters.
2267        my ($wikiPage, $hintID) = @_;
2268        # Ask Sprout to draw the hint button for us.
2269        return Sprout::Hint($wikiPage, $hintID);
2270    }
2271    
2272    
2273    
2274  =head2 Virtual Methods  =head2 Virtual Methods
2275    
2276    =head3 HeaderHtml
2277    
2278        my $html = $shelp->HeaderHtml();
2279    
2280    Generate HTML for the HTML header. If extra styles or javascript are required,
2281    they should go in here.
2282    
2283    =cut
2284    
2285    sub HeaderHtml {
2286        return "";
2287    }
2288    
2289  =head3 Form  =head3 Form
2290    
2291  C<< my $html = $shelp->Form(); >>      my $html = $shelp->Form($mode);
2292    
2293    Generate the HTML for a form to request a new search. If the subclass does not
2294    override this method, then the search is formless, and must be started from an
2295    external page.
2296    
2297  Generate the HTML for a form to request a new search.  =cut
2298    
2299    sub Form {
2300        # Get the parameters.
2301        my ($self) = @_;
2302        return "";
2303    }
2304    
2305  =head3 Find  =head3 Find
2306    
2307  C<< my $resultCount = $shelp->Find(); >>      my $resultCount = $shelp->Find();
2308    
2309  Conduct a search based on the current CGI query parameters. The search results will  Conduct a search based on the current CGI query parameters. The search results will
2310  be written to the session cache file and the number of results will be  be written to the session cache file and the number of results will be
# Line 2393  Line 2322 
2322    
2323  =head3 Description  =head3 Description
2324    
2325  C<< my $htmlText = $shelp->Description(); >>      my $htmlText = $shelp->Description();
2326    
2327  Return a description of this search. The description is used for the table of contents  Return a description of this search. The description is used for the table of contents
2328  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,
# Line 2410  Line 2339 
2339    
2340  =head3 SearchTitle  =head3 SearchTitle
2341    
2342  C<< my $titleHtml = $shelp->SearchTitle(); >>      my $titleHtml = $shelp->SearchTitle();
2343    
2344  Return the display title for this search. The display title appears above the search results.  Return the display title for this search. The display title appears above the search results.
2345  If no result is returned, no title will be displayed. The result should be an html string  If no result is returned, no title will be displayed. The result should be an html string
# Line 2429  Line 2358 
2358    
2359  =head3 DefaultColumns  =head3 DefaultColumns
2360    
2361  C<< $shelp->DefaultColumns($rhelp); >>      $shelp->DefaultColumns($rhelp);
2362    
2363  Store the default columns in the result helper. The default action is just to ask  Store the default columns in the result helper. The default action is just to ask
2364  the result helper for its default columns, but this may be changed by overriding  the result helper for its default columns, but this may be changed by overriding
# Line 2454  Line 2383 
2383      $rhelp->SetColumns(@cols);      $rhelp->SetColumns(@cols);
2384  }  }
2385    
 =head3 Hint  
2386    
2387  C<< my $htmlText = SearchHelper::Hint($hintText); >>  =head3 Initialize
2388    
2389  Return the HTML for a small question mark that displays the specified hint text when it is clicked.      $shelp->Initialize();
2390  This HTML can be put in forms to provide a useful hinting mechanism.  
2391    Perform any initialization required after construction of the helper.
2392    
2393    =cut
2394    
2395    sub Initialize {
2396        # The default is to do nothing.
2397    }
2398    
2399    =head3 GetResultHelper
2400    
2401        my $rhelp = $shelp->GetResultHelper($className);
2402    
2403    Return a result helper for this search helper. The default action is to create
2404    a result helper from scratch; however, if the subclass has an internal result
2405    helper it can override this method to return it without having to create a new
2406    one.
2407    
2408  =over 4  =over 4
2409    
2410  =item hintText  =item className
2411    
2412  Text to display for the hint. It is raw html, but may not contain any double quotes.  Result helper class name.
2413    
2414  =item RETURN  =item RETURN
2415    
2416  Returns the html for the hint facility. The resulting html shows a small button-like thing that  Returns a result helper of the specified class connected to this search helper.
 uses the standard FIG popup technology.  
2417    
2418  =back  =back
2419    
2420  =cut  =cut
2421    
2422  sub Hint {  sub GetResultHelper {
2423      # Get the parameters.      # Get the parameters.
2424      my ($hintText) = @_;      my ($self, $className) = @_;
2425      # Escape the single quotes.      # Create the helper.
2426      my $quotedText = $hintText;      my $retVal = GetHelper($self, RH => $className);
2427      $quotedText =~ s/'/\\'/g;      # return it.
     # Create the html.  
     my $retVal = "&nbsp;<input type=\"button\" class=\"hintbutton\" onMouseOver=\"javascript:if (!this.tooltip) { " .  
                  "this.tooltip = new Popup_Tooltip(this, 'Search Hint', '$quotedText', '', 1); this.tooltip.addHandler(); } " .  
                  "return false;\" value=\"?\" />";  
     # Return it.  
2428      return $retVal;      return $retVal;
2429  }  }
2430    
   
2431  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3