[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.27, Wed Feb 21 13:18:27 2007 UTC
# Line 88  Line 88 
88  TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this  TRUE if this is a feature-filtered search, else FALSE. B<NOTE> that this
89  field is updated by the B<FeatureQuery> object.  field is updated by the B<FeatureQuery> object.
90    
91    =item extraPos
92    
93    C<0> if the extra columns are to be at the beginning, else C<1>. The
94    default is zero; use the L</SetExtraPos> method to change this option.
95    
96  =back  =back
97    
98  =head2 Adding a new Search Tool  =head2 Adding a new Search Tool
# Line 257  Line 262 
262    
263  =over 4  =over 4
264    
265  =item query  =item cgi
266    
267  The CGI query object for the current script.  The CGI query object for the current script.
268    
# Line 267  Line 272 
272    
273  sub new {  sub new {
274      # Get the parameters.      # Get the parameters.
275      my ($class, $query) = @_;      my ($class, $cgi) = @_;
276      # Check for a session ID.      # Check for a session ID.
277      my $session_id = $query->param("SessionID");      my $session_id = $cgi->param("SessionID");
278      my $type = "old";      my $type = "old";
279      if (! $session_id) {      if (! $session_id) {
280            Trace("No session ID found.") if T(3);
281          # 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
282          # store it in the query object.          # store it in the query object.
283          $session_id = NewSessionID();          $session_id = NewSessionID();
284          $type = "new";          $type = "new";
285          $query->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
286        } else {
287            Trace("Session ID is $session_id.") if T(3);
288      }      }
289      # Compute the subclass name.      # Compute the subclass name.
290      $class =~ /SH(.+)$/;      my $subClass;
291      my $subClass = $1;      if ($class =~ /SH(.+)$/) {
292            # Here we have a real search class.
293            $subClass = $1;
294        } else {
295            # Here we have a bare class. The bare class cannot search, but it can
296            # process search results.
297            $subClass = 'SearchHelper';
298        }
299      # Insure everybody knows we're in Sprout mode.      # Insure everybody knows we're in Sprout mode.
300      $query->param(-name => 'SPROUT', -value => 1);      $cgi->param(-name => 'SPROUT', -value => 1);
301      # Generate the form name.      # Generate the form name.
302      my $formName = "$class$formCount";      my $formName = "$class$formCount";
303      $formCount++;      $formCount++;
# Line 290  Line 305 
305      # 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
306      # class name and a placeholder for the Sprout object.      # class name and a placeholder for the Sprout object.
307      my $retVal = {      my $retVal = {
308                    query => $query,                    query => $cgi,
309                    type => $type,                    type => $type,
310                    class => $subClass,                    class => $subClass,
311                    sprout => undef,                    sprout => undef,
# Line 300  Line 315 
315                    genomeList => undef,                    genomeList => undef,
316                    genomeParms => [],                    genomeParms => [],
317                    filtered => 0,                    filtered => 0,
318                      extraPos => 0,
319                   };                   };
320      # Bless and return it.      # Bless and return it.
321      bless $retVal, $class;      bless $retVal, $class;
# Line 360  Line 376 
376      return ($self->{type} eq 'new');      return ($self->{type} eq 'new');
377  }  }
378    
379    =head3 SetExtraPos
380    
381    C<< $shelp->SetExtraPos($newValue); >>
382    
383    Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.
384    
385    =over 4
386    
387    =item newValue
388    
389    C<1> if the extra columns should be displayed at the end, else C<0>.
390    
391    =back
392    
393    =cut
394    
395    sub SetExtraPos {
396        my ($self, $newValue) = @_;
397        $self->{extraPos} = $newValue;
398    }
399    
400  =head3 ID  =head3 ID
401    
402  C<< my $sessionID = $shelp->ID(); >>  C<< my $sessionID = $shelp->ID(); >>
# Line 662  Line 699 
699      # Check for a first-call situation.      # Check for a first-call situation.
700      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
701          Trace("Setting up the columns.") if T(3);          Trace("Setting up the columns.") if T(3);
702          # Here we need to set up the column information. Start with the extras,          # Here we need to set up the column information. First we accumulate the extras,
703          # sorted by column name.          # sorted by column name.
704          my @colNames = ();          my @xtraNames = ();
705          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
706              push @colNames, "X=$col";              push @xtraNames, "X=$col";
707            }
708            # Set up the column name array.
709            my @colNames = ();
710            # If extras go at the beginning, put them in first.
711            if (! $self->{extraPos}) {
712                push @colNames, @xtraNames;
713          }          }
714          # Add the default columns.          # Add the default columns.
715          push @colNames, $self->DefaultFeatureColumns();          push @colNames, $self->DefaultFeatureColumns();
716          # Add any additional columns requested by the feature filter.          # Add any additional columns requested by the feature filter.
717          push @colNames, FeatureQuery::AdditionalColumns($self);          push @colNames, FeatureQuery::AdditionalColumns($self);
718            # If extras go at the end, put them in here.
719            if ($self->{extraPos}) {
720                push @colNames, @xtraNames;
721            }
722            Trace("Full column list determined.") if T(3);
723          # Save the full list.          # Save the full list.
724          $self->{cols} = \@colNames;          $self->{cols} = \@colNames;
725          # 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
726          # output.          # output.
727            Trace("Writing column headers.") if T(3);
728          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});
729            Trace("Column headers written.") if T(3);
730      }      }
731      # Get the feature ID.      # Get the feature ID.
732      my $fid = $fd->FID();      my $fid = $fd->FID();
# Line 979  Line 1029 
1029    
1030  sub ComputeFASTA {  sub ComputeFASTA {
1031      # Get the parameters.      # Get the parameters.
1032      my ($self, $incomingType, $desiredType, $sequence) = @_;      my ($self, $desiredType, $sequence) = @_;
1033      # Declare the return variable. If an error occurs, it will remain undefined.      # Declare the return variable. If an error occurs, it will remain undefined.
1034      my $retVal;      my $retVal;
1035      # This variable will be cleared if an error is detected.      # This variable will be cleared if an error is detected.
# Line 1035  Line 1085 
1085          $fastaData =~ s/\n//g;          $fastaData =~ s/\n//g;
1086          $fastaData =~ s/\s+//g;          $fastaData =~ s/\s+//g;
1087          # Finally, verify that it's DNA if we're doing DNA stuff.          # Finally, verify that it's DNA if we're doing DNA stuff.
1088          if ($desiredType eq 'dna' && $fastaData =~ /[^agct]/i) {          if ($desiredType eq 'dna' && $fastaData =~ /[^agctxn]/i) {
1089              $self->SetMessage("Invaid characters detected. Is the input really a DNA sequence?");              $self->SetMessage("Invalid characters detected. Is the input really a DNA sequence?");
1090              $okFlag = 0;              $okFlag = 0;
1091          }          }
1092      }      }
# Line 1107  Line 1157 
1157      # Read in the subsystems.      # Read in the subsystems.
1158      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1159                                 ['Subsystem(classification)', 'Subsystem(id)']);                                 ['Subsystem(classification)', 'Subsystem(id)']);
1160        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1161        # is at the end, ALL subsystems are unclassified and we don't bother.
1162        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1163            while ($subs[0]->[0] eq '') {
1164                my $classLess = shift @subs;
1165                push @subs, $classLess;
1166            }
1167        }
1168      # Declare the return variable.      # Declare the return variable.
1169      my @retVal = ();      my @retVal = ();
1170      # 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 1570 
1570      my $retVal = $cgi->Tr($cgi->td("Results/Page"),      my $retVal = $cgi->Tr($cgi->td("Results/Page"),
1571                            $cgi->td($cgi->popup_menu(-name => 'PageSize',                            $cgi->td($cgi->popup_menu(-name => 'PageSize',
1572                                                      -values => [10, 25, 50, 100, 1000],                                                      -values => [10, 25, 50, 100, 1000],
1573                                                      -default => $pageSize) . " " .                                                      -default => $pageSize)),
                                    $cgi->checkbox(-name => 'ShowURL',  
                                                   -value => 1,  
                                                   -label => 'Show URL')),  
1574                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1575                                                  -name => 'Search',                                                  -name => 'Search',
1576                                                  -value => $realCaption)));                                                  -value => $realCaption)));
# Line 1525  Line 1580 
1580    
1581  =head3 FeatureFilterRows  =head3 FeatureFilterRows
1582    
1583  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(@subset); >>
1584    
1585  This method creates table rows that can be used to filter features. The form  This method creates table rows that can be used to filter features. The form
1586  values can be used to select features by genome using the B<FeatureQuery>  values can be used to select features by genome using the B<FeatureQuery>
1587  object.  object.
1588    
1589    =over 4
1590    
1591    =item subset
1592    
1593    List of rows to display. The default (C<all>) is to display all rows.
1594    C<words> displays the word search box, C<subsys> displays the subsystem
1595    selector, and C<options> displays the options row.
1596    
1597    =item RETURN
1598    
1599    Returns the html text for table rows containing the desired feature filtering controls.
1600    
1601    =back
1602    
1603  =cut  =cut
1604    
1605  sub FeatureFilterRows {  sub FeatureFilterRows {
1606      # Get the parameters.      # Get the parameters.
1607      my ($self) = @_;      my ($self, @subset) = @_;
1608        if (@subset == 0 || $subset[0] eq 'all') {
1609            @subset = qw(words subsys options);
1610        }
1611      # Return the result.      # Return the result.
1612      return FeatureQuery::FilterRows($self);      return FeatureQuery::FilterRows($self, @subset);
1613  }  }
1614    
1615  =head3 GBrowseFeatureURL  =head3 GBrowseFeatureURL
# Line 1705  Line 1777 
1777    
1778  =head3 ComputeSearchURL  =head3 ComputeSearchURL
1779    
1780  C<< my $url = $shelp->ComputeSearchURL(); >>  C<< my $url = $shelp->ComputeSearchURL(%overrides); >>
1781    
1782  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
1783  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 1787 
1787  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
1788  remove the parameter entirely from a get-style URL.  remove the parameter entirely from a get-style URL.
1789    
1790    =over 4
1791    
1792    =item overrides
1793    
1794    Hash containing override values for the parameters, where the parameter name is
1795    the key and the parameter value is the override value. If the override value is
1796    C<undef>, the parameter will be deleted from the result.
1797    
1798    =item RETURN
1799    
1800    Returns a GET-style URL for invoking the search with the specified overrides.
1801    
1802    =back
1803    
1804  =cut  =cut
1805    
1806  sub ComputeSearchURL {  sub ComputeSearchURL {
1807      # Get the parameters.      # Get the parameters.
1808      my ($self) = @_;      my ($self, %overrides) = @_;
1809      # Get the database and CGI query object.      # Get the database and CGI query object.
1810      my $cgi = $self->Q();      my $cgi = $self->Q();
1811      my $sprout = $self->DB();      my $sprout = $self->DB();
# Line 1746  Line 1832 
1832          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1833          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1834          # Check for special cases.          # Check for special cases.
1835          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1836              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1837              @values = ();              @values = ();
1838          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 1760  Line 1846 
1846              if ($allFlag) {              if ($allFlag) {
1847                  @values = ();                  @values = ();
1848              }              }
1849            } elsif (exists $overrides{$parmKey}) {
1850                # Here the value is being overridden, so we skip it for now.
1851                @values = ();
1852          }          }
1853          # If we still have values, create the URL parameters.          # If we still have values, create the URL parameters.
1854          if (@values) {          if (@values) {
1855              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;              push @urlList, map { "$parmKey=" . uri_escape($_) } @values;
1856          }          }
1857      }      }
1858        # Now do the overrides.
1859        for my $overKey (keys %overrides) {
1860            # Only use this override if it's not a delete marker.
1861            if (defined $overrides{$overKey}) {
1862                push @urlList, "$overKey=" . uri_escape($overrides{$overKey});
1863            }
1864        }
1865      # Add the parameters to the URL.      # Add the parameters to the URL.
1866      $retVal .= "?" . join(";", @urlList);      $retVal .= "?" . join(";", @urlList);
1867      # Return the result.      # Return the result.
# Line 2111  Line 2207 
2207                      if ($hasChildren) {                      if ($hasChildren) {
2208                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
2209                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2210                            Trace("Children of $myLabel finished.") if T(4);
2211                      }                      }
2212                  }                  }
2213              }              }
# Line 2145  Line 2242 
2242              }              }
2243              # Next, we format the label.              # Next, we format the label.
2244              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
2245              Trace("Formatting tree node for $myLabel.") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
2246              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
2247              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
2248                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
# Line 2197  Line 2294 
2294    
2295  =head2 Feature Column Methods  =head2 Feature Column Methods
2296    
2297  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
2298  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
2299  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
2300  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 2369 
2369      } elsif ($colName =~ /^keyword:(.+)$/) {      } elsif ($colName =~ /^keyword:(.+)$/) {
2370          $retVal = ucfirst $1;          $retVal = ucfirst $1;
2371      } elsif ($colName eq 'orgName') {      } elsif ($colName eq 'orgName') {
2372          $retVal = "Gene Name";          $retVal = "Organism and Gene ID";
2373      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2374          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2375      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
# Line 2345  Line 2442 
2442          ($retVal) = $record->Value('Feature(assignment)');          ($retVal) = $record->Value('Feature(assignment)');
2443      } elsif ($colName eq 'gblink') {      } elsif ($colName eq 'gblink') {
2444          # 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.
2445          $retVal = Formlet('GBrowse', "GetGBrowse.cgi", undef,          $retVal = FakeButton('GBrowse', "GetGBrowse.cgi", undef,
2446                            fid => $fid);                            fid => $fid);
2447      } elsif ($colName eq 'group') {      } elsif ($colName eq 'group') {
2448          # Get the NMPDR group name.          # Get the NMPDR group name.
# Line 2363  Line 2460 
2460          $retVal = $self->FeatureName($fid);          $retVal = $self->FeatureName($fid);
2461      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2462          # 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.
2463          $retVal = Formlet('NMPDR', "protein.cgi", undef,          $retVal = FakeButton('NMPDR', "protein.cgi", undef,
2464                            prot => $fid, SPROUT => 1, new_framework => 0,                            prot => $fid, SPROUT => 1, new_framework => 0,
2465                            user => '');                            user => '');
2466      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
# Line 2432  Line 2529 
2529          # Get the subsystems.          # Get the subsystems.
2530          Trace("Generating subsystems for feature $fid.") if T(4);          Trace("Generating subsystems for feature $fid.") if T(4);
2531          my %subs = $sprout->SubsystemsOf($fid);          my %subs = $sprout->SubsystemsOf($fid);
2532          # Convert them to links.          # Extract the subsystem names.
2533          my @links = map { HTML::sub_link($cgi, $_) } sort keys %subs;          my @names = map { HTML::sub_link($cgi, $_) } sort keys %subs;
2534          # String them into a list.          # String them into a list.
2535          $retVal = join(", ", @links);          $retVal = join(", ", @names);
2536      } elsif ($type =~ /^keyword:(.+)$/) {      } elsif ($type =~ /^keyword:(.+)$/) {
2537          # 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
2538          # feature ID.          # feature ID.
# Line 2557  Line 2654 
2654      if (! @wordList) {      if (! @wordList) {
2655          if ($required) {          if ($required) {
2656              $self->SetMessage("No search words specified.");              $self->SetMessage("No search words specified.");
2657            } else {
2658                $retVal = 1;
2659          }          }
2660      } elsif (! @plusWords) {      } elsif (! @plusWords) {
2661          $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 2666 
2666      return $retVal;      return $retVal;
2667  }  }
2668    
2669    =head3 FakeButton
2670    
2671    C<< my $html = SearchHelper::FakeButton($caption, $url, $target, %parms); >>
2672    
2673    Create a fake button that hyperlinks to the specified URL with the specified parameters.
2674    Unlike a real button, this one won't visibly click, but it will take the user to the
2675    correct place.
2676    
2677    The parameters of this method are deliberately identical to L</Formlet> so that we
2678    can switch easily from real buttons to fake ones in the code.
2679    
2680    =over 4
2681    
2682    =item caption
2683    
2684    Caption to be put on the button.
2685    
2686    =item url
2687    
2688    URL for the target page or script.
2689    
2690    =item target
2691    
2692    Frame or target in which the new page should appear. If C<undef> is specified,
2693    the default target will be used.
2694    
2695    =item parms
2696    
2697    Hash containing the parameter names as keys and the parameter values as values.
2698    These will be appended to the URL.
2699    
2700    =back
2701    
2702    =cut
2703    
2704    sub FakeButton {
2705        # Get the parameters.
2706        my ($caption, $url, $target, %parms) = @_;
2707        # Declare the return variable.
2708        my $retVal;
2709        # Compute the target URL.
2710        my $targetUrl = "$url?" . join(";", map { "$_=" . uri_escape($parms{$_}) } keys %parms);
2711        # Compute the target-frame HTML.
2712        my $targetHtml = ($target ? " target=\"$target\"" : "");
2713        # Assemble the result.
2714        return "<a href=\"$targetUrl\" $targetHtml><div class=\"button2 button\">$caption</div></a>";
2715    }
2716    
2717  =head3 Formlet  =head3 Formlet
2718    
2719  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.27

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3