[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.41, Wed Sep 3 20:54:47 2008 UTC revision 1.44, Thu Feb 5 07:17:03 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                $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 IS 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 303  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 325  Line 347 
347  }  }
348    
349    
   
350  =head3 DB  =head3 DB
351    
352      my $sprout = $shelp->DB();      my $sprout = $shelp->DB();
# Line 460  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 => "$FIG_Config::cgi_url/SearchSkeleton.cgi",                                    -action => "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/search",
486                                    -name => $self->FormName()) .                                    -name => $self->FormName()) .
487                   $cgi->hidden(-name => 'Class',                   CGI::hidden(-name => 'Class',
488                                -value => $self->{class},                                -value => $self->{class}) .
489                                -override => 1) .                   CGI::hidden(-name => 'SPROUT',
                  $cgi->hidden(-name => 'SPROUT',  
490                                -value => 1) .                                -value => 1) .
491                   $cgi->h3("$title" . Hint($self->{class}, "Click here for more information."));                   CGI::h3("$title" . Hint($self->{class}, "Click here for more information."));
492      # 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.
493      my $anchorName = $self->FormName();      my $anchorName = $self->FormName();
494      $retVal .= "<a name=\"$anchorName\"></a>\n";      $retVal .= "<a name=\"$anchorName\"></a>\n";
# Line 666  Line 686 
686      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");      $self->{fileHandle} = Open(undef, "| sort | cut --fields=2- >>$fileName");
687  }  }
688    
689    =head3 SetNotice
690    
691        $shelp->SetNotice($message);
692    
693    This method creates a notice that will be displayed on the search results
694    page. After the search is complete, notices are placed in a small temporary
695    file that is checked by the results display engine.
696    
697    =over 4
698    
699    =item message
700    
701    Message to write to the notice file.
702    
703    =back
704    
705    =cut
706    
707    sub SetNotice {
708        # Get the parameters.
709        my ($self, $message) = @_;
710        # Save the message.
711        push @{$self->{notices}}, $message;
712    }
713    
714    
715  =head3 ReadColumnHeaders  =head3 ReadColumnHeaders
716    
717      my @colHdrs = $shelp->ReadColumnHeaders($fh);      my @colHdrs = $shelp->ReadColumnHeaders($fh);
# Line 747  Line 793 
793          my $cgi = $self->Q();          my $cgi = $self->Q();
794          $self->PrintLine("Output formatting complete.<br />");          $self->PrintLine("Output formatting complete.<br />");
795      }      }
796        # Check for notices.
797        my @notices = @{$self->{notices}};
798        if (scalar @notices) {
799            # We have some, so put then in a notice file.
800            my $noticeFile = $self->GetTempFileName('notices');
801            my $nh = Open(undef, ">$noticeFile");
802            print $nh join("\n", @notices, "");
803            close $nh;
804            $self->PrintLine(scalar(@notices) . " notices saved.<br />");
805        }
806  }  }
807    
808  =head3 OrganismData  =head3 OrganismData
# Line 833  Line 889 
889    
890  =head3 ComputeFASTA  =head3 ComputeFASTA
891    
892      my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth);      my $fasta = $shelp->ComputeFASTA($desiredType, $sequence, $flankingWidth, $comments);
893    
894  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
895  the desired flanking width.  the desired flanking width.
# Line 860  Line 916 
916  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
917  from the database.  from the database.
918    
919    =item comments
920    
921    Comment string to be added to the FASTA header.
922    
923  =item RETURN  =item RETURN
924    
925  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 932 
932    
933  sub ComputeFASTA {  sub ComputeFASTA {
934      # Get the parameters.      # Get the parameters.
935      my ($self, $desiredType, $sequence, $flankingWidth) = @_;      my ($self, $desiredType, $sequence, $flankingWidth, $comment) = @_;
936      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
937      my $retVal;      my $retVal;
938      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 903  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 1254  Line 1318 
1318      # 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.
1319      push @propNames, $sprout->GetChoices('Property', 'property-name');      push @propNames, $sprout->GetChoices('Property', 'property-name');
1320      # Create a menu from them.      # Create a menu from them.
1321      my $retVal = $cgi->popup_menu(-name=> $menuName, -values => \@propNames,      my $retVal = CGI::popup_menu(-name=> $menuName, -values => \@propNames,
1322                                    -default => $selected);                                    -default => $selected);
1323      # Return the result.      # Return the result.
1324      return $retVal;      return $retVal;
# Line 1316  Line 1380 
1380          }          }
1381      }      }
1382      # Create the table.      # Create the table.
1383      my $retVal = $cgi->table({border => 2, cellspacing => 2,      my $retVal = CGI::table({border => 2, cellspacing => 2,
1384                                width => 700, class => 'search'},                                width => 700, class => 'search'},
1385                               @{$rows});                               @{$rows});
1386      # Return the result.      # Return the result.
# Line 1357  Line 1421 
1421      # Get the current feature ID type.      # Get the current feature ID type.
1422      my $aliasType = $self->GetPreferredAliasType();      my $aliasType = $self->GetPreferredAliasType();
1423      # Create the rows.      # Create the rows.
1424      my $retVal = $cgi->Tr($cgi->td("Identifier Type "),      my $retVal = CGI::Tr(CGI::td("Identifier Type "),
1425                            $cgi->td({ colspan => 2 },                            CGI::td({ colspan => 2 },
1426                                     $cgi->popup_menu(-name => 'AliasType',                                     CGI::popup_menu(-name => 'AliasType',
1427                                                      -values => ['FIG', AliasAnalysis::AliasTypes() ],                                                      -values => ['FIG', AliasAnalysis::AliasTypes() ],
1428                                                      -default => $aliasType) .                                                      -default => $aliasType) .
1429                                     Hint("Identifier Type", "Specify how you want gene names to be displayed."))) .                                     Hint("Identifier Type", "Specify how you want gene names to be displayed."))) .
1430                   "\n" .                   "\n" .
1431                   $cgi->Tr($cgi->td("Results/Page"),                   CGI::Tr(CGI::td("Results/Page"),
1432                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            CGI::td(CGI::popup_menu(-name => 'PageSize',
1433                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1434                                                      -default => $pageSize)),                                                      -default => $pageSize)),
1435                            $cgi->td($cgi->submit(-class => 'goButton',                            CGI::td(CGI::submit(-class => 'goButton',
1436                                                  -name => 'Search',                                                  -name => 'Search',
1437                                                  -value => $realCaption)));                                                  -value => $realCaption)));
1438      # Return the result.      # Return the result.
# Line 1711  Line 1775 
1775              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.");
1776          } else {          } else {
1777              # Here we have a real tree. Apply the tree style.              # Here we have a real tree. Apply the tree style.
1778              push @retVal, $cgi->start_div({ class => $optionThing->{style} });              push @retVal, CGI::start_div({ class => $optionThing->{style} });
1779              # Give us a DIV ID.              # Give us a DIV ID.
1780              my $divID = GetDivID($optionThing->{name});              my $divID = GetDivID($optionThing->{name});
1781              # Show the tree.              # Show the tree.
1782              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');              push @retVal, ShowBranch($cgi, "(root)", $divID, $tree, $optionThing, 'block');
1783              # Close the DIV block.              # Close the DIV block.
1784              push @retVal, $cgi->end_div();              push @retVal, CGI::end_div();
1785          }          }
1786      }      }
1787      # Return the result.      # Return the result.
# Line 1775  Line 1839 
1839      # Declare the return variable.      # Declare the return variable.
1840      my @retVal = ();      my @retVal = ();
1841      # Start the branch.      # Start the branch.
1842      push @retVal, $cgi->start_ul({ id => $id, style => "display:$displayType" });      push @retVal, CGI::start_ul({ id => $id, style => "display:$displayType" });
1843      # Check for the hash and choose the start location accordingly.      # Check for the hash and choose the start location accordingly.
1844      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);      my $i0 = (ref $branch->[0] eq 'HASH' ? 1 : 0);
1845      # Get the list length.      # Get the list length.
# Line 1821  Line 1885 
1885                      # If we have children, create the child list with a recursive call.                      # If we have children, create the child list with a recursive call.
1886                      if ($hasChildren) {                      if ($hasChildren) {
1887                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
1888                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'block');
1889                          Trace("Children of $myLabel finished.") if T(4);                          Trace("Children of $myLabel finished.") if T(4);
1890                      }                      }
1891                  }                  }
# Line 1833  Line 1897 
1897              # closed images.              # closed images.
1898              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});              my @images = ($options->{nodeImageOpen}, $options->{nodeImageClosed});
1899              my $image = $images[$hasChildren];              my $image = $images[$hasChildren];
1900              my $prefixHtml = $cgi->img({src => $image, id => "${myID}img"});              my $prefixHtml = CGI::img({src => $image, id => "${myID}img"});
1901              if ($hasChildren) {              if ($hasChildren) {
1902                  # If there are children, we wrap the image in a toggle hyperlink.                  # If there are children, we wrap the image in a toggle hyperlink.
1903                  $prefixHtml = $cgi->a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },                  $prefixHtml = CGI::a({ onClick => "javascript:treeToggle('$myID','$images[0]', '$images[1]')" },
1904                                        $prefixHtml);                                        $prefixHtml);
1905              }              }
1906              # 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 1853  Line 1917 
1917                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {                  if (defined $options->{selected} && $options->{selected} eq $attrHash->{value}) {
1918                      $radioParms->{checked} = undef;                      $radioParms->{checked} = undef;
1919                  }                  }
1920                  $prefixHtml .= $cgi->input($radioParms);                  $prefixHtml .= CGI::input($radioParms);
1921              }              }
1922              # Next, we format the label.              # Next, we format the label.
1923              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
1924              Trace("Formatting tree node for \"$myLabel\".") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
1925              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
1926              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
1927                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = CGI::a({ href => $attrHash->{link}, target => $options->{target} },
1928                                       $labelHtml);                                       $labelHtml);
1929              }              }
1930              # 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
1931              # here.              # here.
1932              my $childHtml = join("\n", @childHtml);              my $childHtml = join("\n", @childHtml);
1933              # Now we have all the pieces, so we can put them together.              # Now we have all the pieces, so we can put them together.
1934              push @retVal, $cgi->li("$prefixHtml$labelHtml$childHtml");              push @retVal, CGI::li("$prefixHtml$labelHtml$childHtml");
1935          }          }
1936      }      }
1937      # Close the tree branch.      # Close the tree branch.
1938      push @retVal, $cgi->end_ul();      push @retVal, CGI::end_ul();
1939      # Return the result.      # Return the result.
1940      return @retVal;      return @retVal;
1941  }  }
# Line 1927  Line 1991 
1991  sub PrintLine {  sub PrintLine {
1992      # Get the parameters.      # Get the parameters.
1993      my ($self, $message) = @_;      my ($self, $message) = @_;
1994      # Send them to the output.      # Send the message to the output.
1995      print "$message\n";      print "$message\n";
1996  }  }
1997    
# Line 1979  Line 2043 
2043          # Commit suicide if it didn't work.          # Commit suicide if it didn't work.
2044          if (! defined $retVal) {          if (! defined $retVal) {
2045              die "Could not find a $type handler of type $className.";              die "Could not find a $type handler of type $className.";
2046            } else {
2047                # Perform any necessary subclass initialization.
2048                $retVal->Initialize();
2049          }          }
2050      };      };
2051      # Check for errors.      # Check for errors.
# Line 2176  Line 2243 
2243      return $retVal;      return $retVal;
2244  }  }
2245    
2246    =head3 Hint
2247    
2248        my $htmlText = SearchHelper::Hint($wikiPage, $hintText);
2249    
2250    Return the HTML for a small question mark that displays the specified hint text when it is clicked.
2251    This HTML can be put in forms to provide a useful hinting mechanism.
2252    
2253    =over 4
2254    
2255    =item wikiPage
2256    
2257    Name of the wiki page to be popped up when the hint mark is clicked.
2258    
2259    =item hintText
2260    
2261    Text to display for the hint. It is raw html, but may not contain any double quotes.
2262    
2263    =item RETURN
2264    
2265    Returns the html for the hint facility. The resulting html shows a small button-like thing that
2266    uses the standard FIG popup technology.
2267    
2268    =back
2269    
2270    =cut
2271    
2272    sub Hint {
2273        # Get the parameters.
2274        my ($wikiPage, $hintText) = @_;
2275        # Ask Sprout to draw the hint button for us.
2276        return Sprout::Hint($wikiPage, $hintText);
2277    }
2278    
2279    
2280    
2281  =head2 Virtual Methods  =head2 Virtual Methods
2282    
2283    =head3 HeaderHtml
2284    
2285        my $html = $shelp->HeaderHtml();
2286    
2287    Generate HTML for the HTML header. If extra styles or javascript are required,
2288    they should go in here.
2289    
2290    =cut
2291    
2292    sub HeaderHtml {
2293        return "";
2294    }
2295    
2296  =head3 Form  =head3 Form
2297    
2298      my $html = $shelp->Form();      my $html = $shelp->Form($mode);
2299    
2300    Generate the HTML for a form to request a new search. If the subclass does not
2301    override this method, then the search is formless, and must be started from an
2302    external page.
2303    
2304  Generate the HTML for a form to request a new search.  =cut
2305    
2306    sub Form {
2307        # Get the parameters.
2308        my ($self) = @_;
2309        return "";
2310    }
2311    
2312  =head3 Find  =head3 Find
2313    
# Line 2265  Line 2390 
2390      $rhelp->SetColumns(@cols);      $rhelp->SetColumns(@cols);
2391  }  }
2392    
 =head3 Hint  
2393    
2394      my $htmlText = SearchHelper::Hint($wikiPage, $hintText);  =head3 Initialize
2395    
2396  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.  
2397    
2398  =over 4  Perform any initialization required after construction of the helper.
2399    
2400  =item wikiPage  =cut
2401    
2402  Name of the wiki page to be popped up when the hint mark is clicked.  sub Initialize {
2403        # The default is to do nothing.
2404    }
2405    
2406  =item hintText  =head3 GetResultHelper
2407    
2408  Text to display for the hint. It is raw html, but may not contain any double quotes.      my $rhelp = $shelp->GetResultHelper($className);
2409    
2410    Return a result helper for this search helper. The default action is to create
2411    a result helper from scratch; however, if the subclass has an internal result
2412    helper it can override this method to return it without having to create a new
2413    one.
2414    
2415    =over 4
2416    
2417    =item className
2418    
2419    Result helper class name.
2420    
2421  =item RETURN  =item RETURN
2422    
2423  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.  
2424    
2425  =back  =back
2426    
2427  =cut  =cut
2428    
2429  sub Hint {  sub GetResultHelper {
2430      # Get the parameters.      # Get the parameters.
2431      my ($wikiPage, $hintText) = @_;      my ($self, $className) = @_;
2432      # Ask Sprout to draw the hint button for us.      # Create the helper.
2433      return Sprout::Hint($wikiPage, $hintText);      my $retVal = GetHelper($self, RH => $className);
2434        # return it.
2435        return $retVal;
2436  }  }
2437    
   
2438  1;  1;

Legend:
Removed from v.1.41  
changed lines
  Added in v.1.44

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3