[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.18, Sat Nov 18 20:36:49 2006 UTC revision 1.26, Sun Feb 4 13:07:24 2007 UTC
# Line 257  Line 257 
257    
258  =over 4  =over 4
259    
260  =item query  =item cgi
261    
262  The CGI query object for the current script.  The CGI query object for the current script.
263    
# Line 267  Line 267 
267    
268  sub new {  sub new {
269      # Get the parameters.      # Get the parameters.
270      my ($class, $query) = @_;      my ($class, $cgi) = @_;
271      # Check for a session ID.      # Check for a session ID.
272      my $session_id = $query->param("SessionID");      my $session_id = $cgi->param("SessionID");
273      my $type = "old";      my $type = "old";
274      if (! $session_id) {      if (! $session_id) {
275            Trace("No session ID found.") if T(3);
276          # 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
277          # store it in the query object.          # store it in the query object.
278          $session_id = NewSessionID();          $session_id = NewSessionID();
279          $type = "new";          $type = "new";
280          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
281        } else {
282            Trace("Session ID is $session_id.") if T(3);
283      }      }
284      # Compute the subclass name.      # Compute the subclass name.
285      $class =~ /SH(.+)$/;      my $subClass;
286      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
287            # Here we have a real search class.
288            $subClass = $1;
289        } else {
290            # Here we have a bare class. The bare class cannot search, but it can
291            # process search results.
292            $subClass = 'SearchHelper';
293        }
294      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
295      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
296      # Generate the form name.      # Generate the form name.
297      my $formName = "$class$formCount";      my $formName = "$class$formCount";
298      $formCount++;      $formCount++;
# Line 290  Line 300 
300      # as well as an indicator as to whether or not the session is new, plus the      # as well as an indicator as to whether or not the session is new, plus the
301      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
302      my $retVal = {      my $retVal = {
303                    query => $query,                    query => $cgi,
304                    type => $type,                    type => $type,
305                    class => $subClass,                    class => $subClass,
306                    sprout => undef,                    sprout => undef,
# Line 672  Line 682 
682          push @colNames, $self->DefaultFeatureColumns();          push @colNames, $self->DefaultFeatureColumns();
683          # Add any additional columns requested by the feature filter.          # Add any additional columns requested by the feature filter.
684          push @colNames, FeatureQuery::AdditionalColumns($self);          push @colNames, FeatureQuery::AdditionalColumns($self);
685            Trace("Full column list determined.") if T(3);
686          # Save the full list.          # Save the full list.
687          $self->{cols} = \@colNames;          $self->{cols} = \@colNames;
688          # Write out the column headers. This also prepares the cache file to receive          # Write out the column headers. This also prepares the cache file to receive
689          # output.          # output.
690            Trace("Writing column headers.") if T(3);
691          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
692            Trace("Column headers written.") if T(3);
693      }      }
694      # Get the feature ID.      # Get the feature ID.
695      my $fid = $fd->FID();      my $fid = $fd->FID();
# Line 979  Line 992 
992    
993  sub ComputeFASTA {  sub ComputeFASTA {
994      # Get the parameters.      # Get the parameters.
995      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence) = @_;
996      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
997      my $retVal;      my $retVal;
998      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 1035  Line 1048 
1048          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1049          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1050          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
1051          if ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {
1052              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
1053              $okFlag = 0;              $okFlag = 0;
1054          }          }
1055      }      }
# Line 1107  Line 1120 
1120      # Read in the subsystems.      # Read in the subsystems.
1121      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1122                                 ['Subsystem(classification)', 'Subsystem(id)']);                                 ['Subsystem(classification)', 'Subsystem(id)']);
1123        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1124        # is at the end, ALL subsystems are unclassified and we don't bother.
1125        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1126            while ($subs[0]->[0] eq '') {
1127                my $classLess = shift @subs;
1128                push @subs, $classLess;
1129            }
1130        }
1131      # Declare the return variable.      # Declare the return variable.
1132      my @retVal = ();      my @retVal = ();
1133      # 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 1512  Line 1533 
1533      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1534                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1535                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1536                                                      -default => $pageSize) . " " .                                                      -default => $pageSize)),
                                    $cgi->checkbox(-name => 'ShowURL',  
                                                   -value => 1,  
                                                   -label => 'Show URL')),  
1537                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1538                                                  -name => 'Search',                                                  -name => 'Search',
1539                                                  -value => $realCaption)));                                                  -value => $realCaption)));
# Line 1705  Line 1723 
1723    
1724  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1725    
1726  C<< my $url = $shelp->ComputeSearchURL(); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1727    
1728  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
1729  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 1715  Line 1733 
1733  main complication is that if the user specified all genomes, we'll want to  main complication is that if the user specified all genomes, we'll want to
1734  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1735    
1736    =over 4
1737    
1738    =item overrides
1739    
1740    Hash containing override values for the parameters, where the parameter name is
1741    the key and the parameter value is the override value. If the override value is
1742    C<undef>, the parameter will be deleted from the result.
1743    
1744    =item RETURN
1745    
1746    Returns a GET-style URL for invoking the search with the specified overrides.
1747    
1748    =back
1749    
1750  =cut  =cut
1751    
1752  sub ComputeSearchURL {  sub ComputeSearchURL {
1753      # Get the parameters.      # Get the parameters.
1754      my ($self) = @_;      my ($self, %overrides) = @_;
1755      # Get the database and CGI query object.      # Get the database and CGI query object.
1756      my $cgi = $self->Q();      my $cgi = $self->Q();
1757      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1746  Line 1778 
1778          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1779          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1780          # Check for special cases.          # Check for special cases.
1781          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1782              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1783              @values = ();              @values = ();
1784          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1760  Line 1792 
1792              if ($allFlag) {              if ($allFlag) {
1793                  @values = ();                  @values = ();
1794              }              }
1795            } elsif (exists $overrides{$parmKey}) {
1796                # Here the value is being overridden, so we skip it for now.
1797                @values = ();
1798          }          }
1799          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1800          if (@values) {          if (@values) {
1801              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1802          }          }
1803      }      }
1804        # Now do the overrides.
1805        for my $overKey (keys %overrides) {
1806            # Only use this override if it's not a delete marker.
1807            if (defined $overrides{$overKey}) {
1808                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1809            }
1810        }
1811      # Add the parameters to the URL.      # Add the parameters to the URL.
1812      $retVal .= "?" . join(";", @urlList);      $retVal .= "?" . join(";", @urlList);
1813      # Return the result.      # Return the result.
# Line 2197  Line 2239 
2239    
2240  =head2 Feature Column Methods  =head2 Feature Column Methods
2241    
2242  The methods in this column manage feature column data. If you want to provide the  The methods in this section manage feature column data. If you want to provide the
2243  capability to include new types of data in feature columns, then all the changes  capability to include new types of data in feature columns, then all the changes
2244  are made to this section of the source file. Technically, this should be implemented  are made to this section of the source file. Technically, this should be implemented
2245  using object-oriented methods, but this is simpler for non-programmers to maintain.  using object-oriented methods, but this is simpler for non-programmers to maintain.
# Line 2272  Line 2314 
2314      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2315          $retVal = ucfirst $1;          $retVal = ucfirst $1;
2316      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2317          $retVal = "Gene Name";          $retVal = "Organism and Gene ID";
2318      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2319          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2320      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
# Line 2345  Line 2387 
2387          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2388      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2389          # Here we want a link to the GBrowse page using the official GBrowse button.          # Here we want a link to the GBrowse page using the official GBrowse button.
2390          $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef,          $retVal = FakeButton('GBrowse', "GetGBrowse.cgi", undef,
2391                            fid => $fid);                            fid => $fid);
2392      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2393          # Get the NMPDR group name.          # Get the NMPDR group name.
# Line 2363  Line 2405 
2405          $retVal = $self->FeatureName($fid);          $retVal = $self->FeatureName($fid);
2406      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2407          # Here we want a link to the protein page using the official NMPDR button.          # Here we want a link to the protein page using the official NMPDR button.
2408          $retVal = Formlet('NMPDR', "protein.cgi", undef,          $retVal = FakeButton('NMPDR', "protein.cgi", undef,
2409                            prot => $fid, SPROUT => 1, new_framework => 0,                            prot => $fid, SPROUT => 1, new_framework => 0,
2410                            user => '');                            user => '');
2411      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
# Line 2432  Line 2474 
2474          # Get the subsystems.          # Get the subsystems.
2475          Trace("Generating subsystems for feature $fid.") if T(4);          Trace("Generating subsystems for feature $fid.") if T(4);
2476          my %subs = $sprout->SubsystemsOf($fid);          my %subs = $sprout->SubsystemsOf($fid);
2477          # Convert them to links.          # Extract the subsystem names.
2478          my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;          my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2479          # String them into a list.          # String them into a list.
2480          $retVal = join(", ", @links);          $retVal = join(", ", @names);
2481      } elsif ($type =~ /^keyword:(.+)$/) {      } elsif ($type =~ /^keyword:(.+)$/) {
2482          # Here the caller wants the value of the named keyword. The text is the          # Here the caller wants the value of the named keyword. The text is the
2483          # feature ID.          # feature ID.
# Line 2557  Line 2599 
2599      if (! @wordList) {      if (! @wordList) {
2600          if ($required) {          if ($required) {
2601              $self->SetMessage("No search words specified.");              $self->SetMessage("No search words specified.");
2602            } else {
2603                $retVal = 1;
2604          }          }
2605      } elsif (! @plusWords) {      } elsif (! @plusWords) {
2606          $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");          $self->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
# Line 2567  Line 2611 
2611      return $retVal;      return $retVal;
2612  }  }
2613    
2614    =head3 FakeButton
2615    
2616    C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>
2617    
2618    Create a fake button that hyperlinks to the specified URL with the specified parameters.
2619    Unlike a real button, this one won't visibly click, but it will take the user to the
2620    correct place.
2621    
2622    The parameters of this method are deliberately identical to L</Formlet> so that we
2623    can switch easily from real buttons to fake ones in the code.
2624    
2625    =over 4
2626    
2627    =item caption
2628    
2629    Caption to be put on the button.
2630    
2631    =item url
2632    
2633    URL for the target page or script.
2634    
2635    =item target
2636    
2637    Frame or target in which the new page should appear. If C<undef> is specified,
2638    the default target will be used.
2639    
2640    =item parms
2641    
2642    Hash containing the parameter names as keys and the parameter values as values.
2643    These will be appended to the URL.
2644    
2645    =back
2646    
2647    =cut
2648    
2649    sub FakeButton {
2650        # Get the parameters.
2651        my ($caption, $url, $target, %parms) = @_;
2652        # Declare the return variable.
2653        my $retVal;
2654        # Compute the target URL.
2655        my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
2656        # Compute the target-frame HTML.
2657        my $targetHtml = ($target ? " target=\"$target\"" : "");
2658        # Assemble the result.
2659        return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";
2660    }
2661    
2662  =head3 Formlet  =head3 Formlet
2663    
2664  C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>  C<< my $html = SearchHelper::Formlet($caption, $url, $target, %parms); >>

Legend:
Removed from v.1.18  
changed lines
  Added in v.1.26

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3