[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.22, Sat Dec 2 09:45:30 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 272  Line 277 
277      my $session_id = $cgi->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          $cgi->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      my $subClass;      my $subClass;
# Line 307  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 367  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 669  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 1042  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 1114  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 1519  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',  
                                                   -checked => 1)),  
1574                            $cgi->td($cgi->submit(-class => 'goButton',                            $cgi->td($cgi->submit(-class => 'goButton',
1575                                                  -name => 'Search',                                                  -name => 'Search',
1576                                                  -value => $realCaption)));                                                  -value => $realCaption)));
# Line 1533  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 1768  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 2143  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 2177  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 2377  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 2395  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 2601  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.22  
changed lines
  Added in v.1.27

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3