[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.40, Tue Apr 29 20:52:05 2008 UTC revision 1.43, Mon Jan 19 21:56:19 2009 UTC
# Line 19  Line 19 
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 85  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 258  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                                                  -expires => '+7d');
282                $session_cookie->bake();
283            } else {
284                # Here we're recovering an old session. The session ID is
285                # used to find any old search options lying around, but we're
286                # still considered a new session.
287                $session_id = $session_cookie->value();
288                Trace("Session $session_id recovered from cookie.") if T(3);
289            }
290            # Denote this is a new session.
291          $type = "new";          $type = "new";
292            # Put the session IS in the parameters.
293          $cgi->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
294      } else {      } else {
295          Trace("Session ID is $session_id.") if T(3);          Trace("Session ID is $session_id.") if T(3);
# Line 303  Line 325 
325                    scriptQueue => [],                    scriptQueue => [],
326                    genomeList => undef,                    genomeList => undef,
327                    genomeParms => [],                    genomeParms => [],
328                      notices => [],
329                   };                   };
330      # Bless and return it.      # Bless and return it.
331      bless $retVal, $class;      bless $retVal, $class;
# Line 325  Line 348 
348  }  }
349    
350    
   
351  =head3 DB  =head3 DB
352    
353      my $sprout = $shelp->DB();      my $sprout = $shelp->DB();
# Line 460  Line 482 
482      # 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
483      # case the Advanced button was used.      # case the Advanced button was used.
484      my $retVal = "<div class=\"search\">\n" .      my $retVal = "<div class=\"search\">\n" .
485                   $cgi->start_form(-method => 'POST',                   CGI::start_form(-method => 'POST',
486                                    -action => $cgi->url(-relative => 1),                                    -action => "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/search",
487                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
488                   $cgi->hidden(-name => 'Class',                   CGI::hidden(-name => 'Class',
489                                -value => $self->{class},                                -value => $self->{class}) .
490                                -override => 1) .                   CGI::hidden(-name => 'SPROUT',
                  $cgi->hidden(-name => 'SPROUT',  
491                                -value => 1) .                                -value => 1) .
492                   $cgi->h3("$title" . Hint($self->{class}, "Click here for more information."));                   CGI::h3("$title" . Hint($self->{class}, "Click here for more information."));
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 666  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      my @colHdrs = $shelp->ReadColumnHeaders($fh);      my @colHdrs = $shelp->ReadColumnHeaders($fh);
# Line 747  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
# Line 833  Line 890 
890    
891  =head3 ComputeFASTA  =head3 ComputeFASTA
892    
893      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 860  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 872  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 903  Line 964 
964                  # In an emergency, fall back to the original ID.                  # In an emergency, fall back to the original ID.
965                  $fastaLabel = $fid;                  $fastaLabel = $fid;
966              }              }
967                # Add any specified comments.
968                if ($comment) {
969                    $fastaLabel .= " $comment";
970                }
971              # Now proceed according to the sequence type.              # Now proceed according to the sequence type.
972              if ($desiredType =~ /prot/) {              if ($desiredType =~ /prot/) {
973                  # We want protein, so get the translation.                  # We want protein, so get the translation.
# Line 1052  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 1126  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/seedviewer.cgi?page=Subsystems;subsystem=$linkable";                  $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 1173  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 1196  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 extract the NMPDR groups and sort them. They  
         # are sorted by the first capitalized word. Groups with "other" are sorted after groups  
         # that aren't "other". At some point, we will want to make this less complicated.  
         my %sortGroups = map { $_ =~ /(other)?(.*)([A-Z].+)/; "$3$1$2" => $_ }  
                              grep { $_ ne $FIG_Config::otherGroup } keys %gHash;  
         @groups = map { $sortGroups{$_} } sort keys %sortGroups;  
         # 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("Genome Control",  
                                                                                             "Enter a genome number, then 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, "");  
1274      # Return the result.      # Return the result.
1275      return $retVal;      return $retVal;
1276  }  }
# Line 1404  Line 1319 
1319      # Get all the property names, putting them after the null choice if one exists.      # Get all the property names, putting them after the null choice if one exists.
1320      push @propNames, $sprout->GetChoices('Property', 'property-name');      push @propNames, $sprout->GetChoices('Property', 'property-name');
1321      # Create a menu from them.      # Create a menu from them.
1322      my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,      my $retVal = CGI::popup_menu(-name=> $menuName, -values => \@propNames,
1323                                    -default => $selected);                                    -default => $selected);
1324      # Return the result.      # Return the result.
1325      return $retVal;      return $retVal;
# Line 1466  Line 1381 
1381          }          }
1382      }      }
1383      # Create the table.      # Create the table.
1384      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = CGI::table({border => 2, cellspacing => 2,
1385                                width => 700, class => 'search'},                                width => 700, class => 'search'},
1386                               @{$rows});                               @{$rows});
1387      # Return the result.      # Return the result.
# Line 1507  Line 1422 
1422      # Get the current feature ID type.      # Get the current feature ID type.
1423      my $aliasType = $self->GetPreferredAliasType();      my $aliasType = $self->GetPreferredAliasType();
1424      # Create the rows.      # Create the rows.
1425      my $retVal = $cgi->Tr($cgi->td("Identifier Type "),      my $retVal = CGI::Tr(CGI::td("Identifier Type "),
1426                            $cgi->td({ colspan => 2 },                            CGI::td({ colspan => 2 },
1427                                     $cgi->popup_menu(-name => 'AliasType',                                     CGI::popup_menu(-name => 'AliasType',
1428                                                      -values => ['FIG', AliasAnalysis::AliasTypes() ],                                                      -values => ['FIG', AliasAnalysis::AliasTypes() ],
1429                                                      -default => $aliasType) .                                                      -default => $aliasType) .
1430                                     Hint("Identifier Type", "Specify how you want gene names to be displayed."))) .                                     Hint("Identifier Type", "Specify how you want gene names to be displayed."))) .
1431                   "\n" .                   "\n" .
1432                   $cgi->Tr($cgi->td("Results/Page"),                   CGI::Tr(CGI::td("Results/Page"),
1433                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            CGI::td(CGI::popup_menu(-name => 'PageSize',
1434                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1435                                                      -default => $pageSize)),                                                      -default => $pageSize)),
1436                            $cgi->td($cgi->submit(-class => 'goButton',                            CGI::td(CGI::submit(-class => 'goButton',
1437                                                  -name => 'Search',                                                  -name => 'Search',
1438                                                  -value => $realCaption)));                                                  -value => $realCaption)));
1439      # Return the result.      # Return the result.
# Line 1569  Line 1484 
1484      return @retVal;      return @retVal;
1485  }  }
1486    
 =head3 GetHelpText  
   
     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<RHFeatures> 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;  
 }  
   
1487  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1488    
1489      my $url = $shelp->ComputeSearchURL(%overrides);      my $url = $shelp->ComputeSearchURL(%overrides);
# Line 1645  Line 1519 
1519      my $cgi = $self->Q();      my $cgi = $self->Q();
1520      my $sprout = $self->DB();      my $sprout = $self->DB();
1521      # Start with the full URL.      # Start with the full URL.
1522      my $retVal = $cgi->url(-full => 1);      my $retVal = "$FIG_Config::cgi_url/SearchSkeleton.cgi";
1523      # Get all the query parameters in a hash.      # Get all the query parameters in a hash.
1524      my %parms = $cgi->Vars();      my %parms = $cgi->Vars();
1525      # 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 1837  Line 1711 
1711  =item nodeImageClosed  =item nodeImageClosed
1712    
1713  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
1714  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>.
1715    
1716  =item nodeImageOpen  =item nodeImageOpen
1717    
1718  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
1719  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>.
1720    
1721  =item style  =item style
1722    
# Line 1882  Line 1756 
1756      my ($cgi, $tree, %options) = @_;      my ($cgi, $tree, %options) = @_;
1757      # Get the options.      # Get the options.
1758      my $optionThing = Tracer::GetOptions({ name => 'selection',      my $optionThing = Tracer::GetOptions({ name => 'selection',
1759                                             nodeImageClosed => '../FIG/Html/plus.gif',                                             nodeImageClosed => "$FIG_Config::cgi_url/Html/plus.gif",
1760                                             nodeImageOpen => '../FIG/Html/minus.gif',                                             nodeImageOpen => "$FIG_Config::cgi_url/Html/minus.gif",
1761                                             style => 'tree',                                             style => 'tree',
1762                                             target => '_self',                                             target => '_self',
1763                                             selected => undef},                                             selected => undef},
# Line 1902  Line 1776 
1776              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.");
1777          } else {          } else {
1778              # Here we have a real tree. Apply the tree style.              # Here we have a real tree. Apply the tree style.
1779              push @retVal, $cgi->start_div({ class => $optionThing->{style} });              push @retVal, CGI::start_div({ class => $optionThing->{style} });
1780              # Give us a DIV ID.              # Give us a DIV ID.
1781              my $divID = GetDivID($optionThing->{name});              my $divID = GetDivID($optionThing->{name});
1782              # Show the tree.              # Show the tree.
1783              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
1784              # Close the DIV block.              # Close the DIV block.
1785              push @retVal, $cgi->end_div();              push @retVal, CGI::end_div();
1786          }          }
1787      }      }
1788      # Return the result.      # Return the result.
# Line 1966  Line 1840 
1840      # Declare the return variable.      # Declare the return variable.
1841      my @retVal = ();      my @retVal = ();
1842      # Start the branch.      # Start the branch.
1843      push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });      push @retVal, CGI::start_ul({ id => $id, style => "display:$displayType" });
1844      # Check for the hash and choose the start location accordingly.      # Check for the hash and choose the start location accordingly.
1845      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
1846      # Get the list length.      # Get the list length.
# Line 2012  Line 1886 
1886                      # If we have children, create the child list with a recursive call.                      # If we have children, create the child list with a recursive call.
1887                      if ($hasChildren) {                      if ($hasChildren) {
1888                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
1889                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'block');
1890                          Trace("Children of $myLabel finished.") if T(4);                          Trace("Children of $myLabel finished.") if T(4);
1891                      }                      }
1892                  }                  }
# Line 2024  Line 1898 
1898              # closed images.              # closed images.
1899              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
1900              my $image = $images[$hasChildren];              my $image = $images[$hasChildren];
1901              my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});              my $prefixHtml = CGI::img({src => $image, id => "${myID}img"});
1902              if ($hasChildren) {              if ($hasChildren) {
1903                  # If there are children, we wrap the image in a toggle hyperlink.                  # If there are children, we wrap the image in a toggle hyperlink.
1904                  $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },                  $prefixHtml = CGI::a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
1905                                        $prefixHtml);                                        $prefixHtml);
1906              }              }
1907              # 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 2044  Line 1918 
1918                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
1919                      $radioParms->{checked} = undef;                      $radioParms->{checked} = undef;
1920                  }                  }
1921                  $prefixHtml .= $cgi->input($radioParms);                  $prefixHtml .= CGI::input($radioParms);
1922              }              }
1923              # Next, we format the label.              # Next, we format the label.
1924              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
1925              Trace("Formatting tree node for \"$myLabel\".") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
1926              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
1927              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
1928                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = CGI::a({ href => $attrHash->{link}, target => $options->{target} },
1929                                       $labelHtml);                                       $labelHtml);
1930              }              }
1931              # 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
1932              # here.              # here.
1933              my $childHtml = join("\n", @childHtml);              my $childHtml = join("\n", @childHtml);
1934              # Now we have all the pieces, so we can put them together.              # Now we have all the pieces, so we can put them together.
1935              push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");              push @retVal, CGI::li("$prefixHtml$labelHtml$childHtml");
1936          }          }
1937      }      }
1938      # Close the tree branch.      # Close the tree branch.
1939      push @retVal, $cgi->end_ul();      push @retVal, CGI::end_ul();
1940      # Return the result.      # Return the result.
1941      return @retVal;      return @retVal;
1942  }  }
# Line 2118  Line 1992 
1992  sub PrintLine {  sub PrintLine {
1993      # Get the parameters.      # Get the parameters.
1994      my ($self, $message) = @_;      my ($self, $message) = @_;
1995      # Send them to the output.      # Send the message to the output.
1996      print "$message\n";      print "$message\n";
1997  }  }
1998    
# Line 2170  Line 2044 
2044          # Commit suicide if it didn't work.          # Commit suicide if it didn't work.
2045          if (! defined $retVal) {          if (! defined $retVal) {
2046              die "Could not find a $type handler of type $className.";              die "Could not find a $type handler of type $className.";
2047            } else {
2048                # Perform any necessary subclass initialization.
2049                $retVal->Initialize();
2050          }          }
2051      };      };
2052      # Check for errors.      # Check for errors.
# Line 2367  Line 2244 
2244      return $retVal;      return $retVal;
2245  }  }
2246    
2247    =head3 Hint
2248    
2249        my $htmlText = SearchHelper::Hint($wikiPage, $hintText);
2250    
2251    Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2252    This HTML can be put in forms to provide a useful hinting mechanism.
2253    
2254    =over 4
2255    
2256    =item wikiPage
2257    
2258    Name of the wiki page to be popped up when the hint mark is clicked.
2259    
2260    =item hintText
2261    
2262    Text to display for the hint. It is raw html, but may not contain any double quotes.
2263    
2264    =item RETURN
2265    
2266    Returns the html for the hint facility. The resulting html shows a small button-like thing that
2267    uses the standard FIG popup technology.
2268    
2269    =back
2270    
2271    =cut
2272    
2273    sub Hint {
2274        # Get the parameters.
2275        my ($wikiPage, $hintText) = @_;
2276        # Ask Sprout to draw the hint button for us.
2277        return Sprout::Hint($wikiPage, $hintText);
2278    }
2279    
2280    
2281    
2282  =head2 Virtual Methods  =head2 Virtual Methods
2283    
2284    =head3 HeaderHtml
2285    
2286        my $html = $shelp->HeaderHtml();
2287    
2288    Generate HTML for the HTML header. If extra styles or javascript are required,
2289    they should go in here.
2290    
2291    =cut
2292    
2293    sub HeaderHtml {
2294        return "";
2295    }
2296    
2297  =head3 Form  =head3 Form
2298    
2299      my $html = $shelp->Form();      my $html = $shelp->Form($mode);
2300    
2301    Generate the HTML for a form to request a new search. If the subclass does not
2302    override this method, then the search is formless, and must be started from an
2303    external page.
2304    
2305  Generate the HTML for a form to request a new search.  =cut
2306    
2307    sub Form {
2308        # Get the parameters.
2309        my ($self) = @_;
2310        return "";
2311    }
2312    
2313  =head3 Find  =head3 Find
2314    
# Line 2456  Line 2391 
2391      $rhelp->SetColumns(@cols);      $rhelp->SetColumns(@cols);
2392  }  }
2393    
 =head3 Hint  
2394    
2395      my $htmlText = SearchHelper::Hint($wikiPage, $hintText);  =head3 Initialize
2396    
2397  Return the HTML for a small question mark that displays the specified hint text when it is clicked.      $shelp->Initialize();
 This HTML can be put in forms to provide a useful hinting mechanism.  
2398    
2399  =over 4  Perform any initialization required after construction of the helper.
2400    
2401  =item wikiPage  =cut
2402    
2403  Name of the wiki page to be popped up when the hint mark is clicked.  sub Initialize {
2404        # The default is to do nothing.
2405    }
2406    
2407  =item hintText  =head3 GetResultHelper
2408    
2409  Text to display for the hint. It is raw html, but may not contain any double quotes.      my $rhelp = $shelp->GetResultHelper($className);
2410    
2411    Return a result helper for this search helper. The default action is to create
2412    a result helper from scratch; however, if the subclass has an internal result
2413    helper it can override this method to return it without having to create a new
2414    one.
2415    
2416    =over 4
2417    
2418    =item className
2419    
2420    Result helper class name.
2421    
2422  =item RETURN  =item RETURN
2423    
2424  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.  
2425    
2426  =back  =back
2427    
2428  =cut  =cut
2429    
2430  sub Hint {  sub GetResultHelper {
2431      # Get the parameters.      # Get the parameters.
2432      my ($wikiPage, $hintText) = @_;      my ($self, $className) = @_;
2433      # Escape the single quotes in the hint text.      # Create the helper.
2434      my $quotedText = $hintText;      my $retVal = GetHelper($self, RH => $className);
2435      $quotedText =~ s/'/\\'/g;      # return it.
     # Convert the wiki page name to a URL.  
     my $wikiURL = join("", map { ucfirst $_ } split /\s+/, $wikiPage);  
     $wikiURL = "wiki/view.cgi/FIG/$wikiURL";  
     # 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=\"?\" onClick=\"javascript:window.open('$wikiURL', 'nmpdrHelp');\" />";  
     # Return it.  
2436      return $retVal;      return $retVal;
2437  }  }
2438    
   
2439  1;  1;

Legend:
Removed from v.1.40  
changed lines
  Added in v.1.43

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3