[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.25, Wed Dec 20 20:06:17 2006 UTC revision 1.28, Tue Apr 10 06:05:40 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 230  Line 235 
235  in the output, or you could search for something that's not a feature at all. The  in the output, or you could search for something that's not a feature at all. The
236  above code is just a loose framework.  above code is just a loose framework.
237    
238    In addition to the finding and filtering, it is necessary to send status messages
239    to the output so that the user does not get bored waiting for results. The L</PrintLine>
240    method performs this function. The single parameter should be text to be
241    output to the browser. In general, you'll invoke it as follows.
242    
243        $self->PrintLine("...my message text...<br />");
244    
245    The break tag is optional. When the Find method gets control, a paragraph will
246    have been started so that everything is XHTML-compliant.
247    
248  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>  If you wish to add your own extra columns to the output, use the B<AddExtraColumns>
249  method of the feature query object.  method of the feature query object.
250    
# Line 251  Line 266 
266    
267  =head3 new  =head3 new
268    
269  C<< my $shelp = SearchHelper->new($query); >>  C<< my $shelp = SearchHelper->new($cgi); >>
270    
271  Construct a new SearchHelper object.  Construct a new SearchHelper object.
272    
# Line 272  Line 287 
287      my $session_id = $cgi->param("SessionID");      my $session_id = $cgi->param("SessionID");
288      my $type = "old";      my $type = "old";
289      if (! $session_id) {      if (! $session_id) {
290            Trace("No session ID found.") if T(3);
291          # 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
292          # store it in the query object.          # store it in the query object.
293          $session_id = NewSessionID();          $session_id = NewSessionID();
294          $type = "new";          $type = "new";
295          $cgi->param(-name => 'SessionID', -value => $session_id);          $cgi->param(-name => 'SessionID', -value => $session_id);
296        } else {
297            Trace("Session ID is $session_id.") if T(3);
298      }      }
299      # Compute the subclass name.      # Compute the subclass name.
300      my $subClass;      my $subClass;
# Line 307  Line 325 
325                    genomeList => undef,                    genomeList => undef,
326                    genomeParms => [],                    genomeParms => [],
327                    filtered => 0,                    filtered => 0,
328                      extraPos => 0,
329                   };                   };
330      # Bless and return it.      # Bless and return it.
331      bless $retVal, $class;      bless $retVal, $class;
# Line 367  Line 386 
386      return ($self->{type} eq 'new');      return ($self->{type} eq 'new');
387  }  }
388    
389    =head3 SetExtraPos
390    
391    C<< $shelp->SetExtraPos($newValue); >>
392    
393    Indicate whether the extra columns should be in the front (C<0>) or end (C<1>) columns of the results.
394    
395    =over 4
396    
397    =item newValue
398    
399    C<1> if the extra columns should be displayed at the end, else C<0>.
400    
401    =back
402    
403    =cut
404    
405    sub SetExtraPos {
406        my ($self, $newValue) = @_;
407        $self->{extraPos} = $newValue;
408    }
409    
410  =head3 ID  =head3 ID
411    
412  C<< my $sessionID = $shelp->ID(); >>  C<< my $sessionID = $shelp->ID(); >>
# Line 669  Line 709 
709      # Check for a first-call situation.      # Check for a first-call situation.
710      if (! defined $self->{cols}) {      if (! defined $self->{cols}) {
711          Trace("Setting up the columns.") if T(3);          Trace("Setting up the columns.") if T(3);
712          # Here we need to set up the column information. Start with the extras,          # Tell the user what's happening.
713            $self->PrintLine("Creating output columns.<br />");
714            # Here we need to set up the column information. First we accumulate the extras,
715          # sorted by column name.          # sorted by column name.
716          my @colNames = ();          my @xtraNames = ();
717          for my $col (sort keys %{$extraCols}) {          for my $col (sort keys %{$extraCols}) {
718              push @colNames, "X=$col";              push @xtraNames, "X=$col";
719            }
720            # Set up the column name array.
721            my @colNames = ();
722            # If extras go at the beginning, put them in first.
723            if (! $self->{extraPos}) {
724                push @colNames, @xtraNames;
725          }          }
726          # Add the default columns.          # Add the default columns.
727          push @colNames, $self->DefaultFeatureColumns();          push @colNames, $self->DefaultFeatureColumns();
728          # Add any additional columns requested by the feature filter.          # Add any additional columns requested by the feature filter.
729          push @colNames, FeatureQuery::AdditionalColumns($self);          push @colNames, FeatureQuery::AdditionalColumns($self);
730            # If extras go at the end, put them in here.
731            if ($self->{extraPos}) {
732                push @colNames, @xtraNames;
733            }
734          Trace("Full column list determined.") if T(3);          Trace("Full column list determined.") if T(3);
735          # Save the full list.          # Save the full list.
736          $self->{cols} = \@colNames;          $self->{cols} = \@colNames;
737          # Write out the column headers. This also prepares the cache file to receive          # Write out the column names. This also prepares the cache file to receive
738          # output.          # output.
739          Trace("Writing column headers.") if T(3);          Trace("Writing column headers.") if T(3);
740          $self->WriteColumnHeaders(map { $self->FeatureColumnTitle($_) } @{$self->{cols}});          $self->WriteColumnHeaders(@{$self->{cols}});
741          Trace("Column headers written.") if T(3);          Trace("Column headers written.") if T(3);
742      }      }
743      # Get the feature ID.      # Get the feature ID.
# Line 780  Line 832 
832          # We found one, so close it.          # We found one, so close it.
833          Trace("Closing session file.") if T(2);          Trace("Closing session file.") if T(2);
834          close $self->{fileHandle};          close $self->{fileHandle};
835            # Tell the user.
836            my $cgi = $self->Q();
837            $self->PrintLine("Output formatting complete.<br />");
838      }      }
839  }  }
840    
# Line 1117  Line 1172 
1172      # Read in the subsystems.      # Read in the subsystems.
1173      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],      my @subs = $sprout->GetAll(['Subsystem'], "ORDER BY Subsystem(classification), Subsystem(id)", [],
1174                                 ['Subsystem(classification)', 'Subsystem(id)']);                                 ['Subsystem(classification)', 'Subsystem(id)']);
1175        # Put any unclassified subsystems at the end. They will always be at the beginning, so if one
1176        # is at the end, ALL subsystems are unclassified and we don't bother.
1177        if ($#subs >= 0 && $subs[$#subs]->[0] ne '') {
1178            while ($subs[0]->[0] eq '') {
1179                my $classLess = shift @subs;
1180                push @subs, $classLess;
1181            }
1182        }
1183      # Declare the return variable.      # Declare the return variable.
1184      my @retVal = ();      my @retVal = ();
1185      # 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 1191  Line 1254 
1254              if ($optionThing->{links}) {              if ($optionThing->{links}) {
1255                  # Compute the link value.                  # Compute the link value.
1256                  my $linkable = uri_escape($id);                  my $linkable = uri_escape($id);
1257                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;SPROUT=1";                  $nodeContent->{link} = "../FIG/display_subsys.cgi?ssa_name=$linkable;request=show_ssa;sort=by_phylo;show_clusters=1;SPROUT=1";
1258              }              }
1259              if ($optionThing->{radio}) {              if ($optionThing->{radio}) {
1260                  # Compute the radio value.                  # Compute the radio value.
# Line 1532  Line 1595 
1595    
1596  =head3 FeatureFilterRows  =head3 FeatureFilterRows
1597    
1598  C<< my $htmlText = $shelp->FeatureFilterRows(); >>  C<< my $htmlText = $shelp->FeatureFilterRows(@subset); >>
1599    
1600  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
1601  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>
1602  object.  object.
1603    
1604    =over 4
1605    
1606    =item subset
1607    
1608    List of rows to display. The default (C<all>) is to display all rows.
1609    C<words> displays the word search box, C<subsys> displays the subsystem
1610    selector, and C<options> displays the options row.
1611    
1612    =item RETURN
1613    
1614    Returns the html text for table rows containing the desired feature filtering controls.
1615    
1616    =back
1617    
1618  =cut  =cut
1619    
1620  sub FeatureFilterRows {  sub FeatureFilterRows {
1621      # Get the parameters.      # Get the parameters.
1622      my ($self) = @_;      my ($self, @subset) = @_;
1623        if (@subset == 0 || $subset[0] eq 'all') {
1624            @subset = qw(words subsys options);
1625        }
1626      # Return the result.      # Return the result.
1627      return FeatureQuery::FilterRows($self);      return FeatureQuery::FilterRows($self, @subset);
1628  }  }
1629    
1630  =head3 GBrowseFeatureURL  =head3 GBrowseFeatureURL
# Line 1767  Line 1847 
1847          # a singleton list, but that's okay.          # a singleton list, but that's okay.
1848          my @values = split (/\0/, $parms{$parmKey});          my @values = split (/\0/, $parms{$parmKey});
1849          # Check for special cases.          # Check for special cases.
1850          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF ShowURL)) {          if (grep { $_ eq $parmKey } qw(SessionID ResultCount Page PageSize Trace TF)) {
1851              # These are bookkeeping parameters we don't need to start a search.              # These are bookkeeping parameters we don't need to start a search.
1852              @values = ();              @values = ();
1853          } elsif ($parmKey =~ /_SearchThing$/) {          } elsif ($parmKey =~ /_SearchThing$/) {
# Line 2142  Line 2222 
2222                      if ($hasChildren) {                      if ($hasChildren) {
2223                          Trace("Processing children of $myLabel.") if T(4);                          Trace("Processing children of $myLabel.") if T(4);
2224                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');                          push @childHtml, ShowBranch($cgi, $myLabel, $myID, $myContent, $options, 'none');
2225                            Trace("Children of $myLabel finished.") if T(4);
2226                      }                      }
2227                  }                  }
2228              }              }
# Line 2176  Line 2257 
2257              }              }
2258              # Next, we format the label.              # Next, we format the label.
2259              my $labelHtml = $myLabel;              my $labelHtml = $myLabel;
2260              Trace("Formatting tree node for $myLabel.") if T(4);              Trace("Formatting tree node for \"$myLabel\".") if T(4);
2261              # Apply a hyperlink if necessary.              # Apply a hyperlink if necessary.
2262              if (defined $attrHash->{link}) {              if (defined $attrHash->{link}) {
2263                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },                  $labelHtml = $cgi->a({ href => $attrHash->{link}, target => $options->{target} },
# Line 2236  Line 2317 
2317  the name for the protein page link column is C<protlink>. If the column is to appear  the name for the protein page link column is C<protlink>. If the column is to appear
2318  in the default list of feature columns, add it to the list returned by  in the default list of feature columns, add it to the list returned by
2319  L</DefaultFeatureColumns>. Then add code to produce the column title to  L</DefaultFeatureColumns>. Then add code to produce the column title to
2320  L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>, and  L</FeatureColumnTitle> and code to produce its value to L</FeatureColumnValue>. If the
2321  everything else will happen automatically.  feature column should be excluded from downloads, add it to the C<FeatureColumnSkip>
2322    hash. Everything else will happen automatically.
2323    
2324  There is one special column name syntax for extra columns (that is, nonstandard  There is a special column name syntax for extra columns (that is, nonstandard
2325  feature columns). If the column name begins with C<X=>, then it is presumed to be  feature columns). If the column name begins with C<X=>, then it is presumed to be
2326  an extra column. The column title is the text after the C<X=>, and its value is  an extra column. The column title is the text after the C<X=>, and its value is
2327  pulled from the extra column hash.  pulled from the extra column hash.
2328    
2329    =cut
2330    
2331    # This hash is used to determine which columns should not be included in downloads.
2332    my %FeatureColumnSkip = map { $_ => 1 } qw(gblink viewerlink protlink);
2333    
2334  =head3 DefaultFeatureColumns  =head3 DefaultFeatureColumns
2335    
2336  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>  C<< my @colNames = $shelp->DefaultFeatureColumns(); >>
# Line 2306  Line 2393 
2393          $retVal = "Organism and Gene ID";          $retVal = "Organism and Gene ID";
2394      } elsif ($colName eq 'protlink') {      } elsif ($colName eq 'protlink') {
2395          $retVal = "NMPDR Protein Page";          $retVal = "NMPDR Protein Page";
2396        } elsif ($colName eq 'viewerlink') {
2397            $retVal = "Annotation Page";
2398      } elsif ($colName eq 'subsystem') {      } elsif ($colName eq 'subsystem') {
2399          $retVal = "Subsystems";          $retVal = "Subsystems";
2400      }      }
# Line 2313  Line 2402 
2402      return $retVal;      return $retVal;
2403  }  }
2404    
2405    =head3 FeatureColumnDownload
2406    
2407    C<< my $keep = $shelp->FeatureColumnDownload($colName); >>
2408    
2409    Return TRUE if the named feature column is to be kept when downloading, else FALSE.
2410    
2411    =over 4
2412    
2413    =item colName
2414    
2415    Name of the relevant feature column.
2416    
2417    =item RETURN
2418    
2419    Return TRUE if the named column should be kept while downloading, else FALSE. In general,
2420    FALSE is returned if the column generates a button, image, or other purely-HTML value.
2421    
2422    =back
2423    
2424    =cut
2425    
2426    sub FeatureColumnDownload {
2427        # Get the parameters.
2428        my ($self, $colName) = @_;
2429        # Return the determination. We download the column if it's not in the skip-hash.
2430        # Note we return 0 and 1 instead of 1 and undef because it simplifies some tracing.
2431        return (exists $FeatureColumnSkip{$colName} ? 0 : 1);
2432    }
2433    
2434    
2435  =head3 FeatureColumnValue  =head3 FeatureColumnValue
2436    
# Line 2328  Line 2446 
2446    
2447  =item record  =item record
2448    
2449  DBObject record for the feature being displayed in the current row.  ERDBObject record for the feature being displayed in the current row.
2450    
2451  =item extraCols  =item extraCols
2452    
# Line 2397  Line 2515 
2515          $retVal = FakeButton('NMPDR', "protein.cgi", undef,          $retVal = FakeButton('NMPDR', "protein.cgi", undef,
2516                            prot => $fid, SPROUT => 1, new_framework => 0,                            prot => $fid, SPROUT => 1, new_framework => 0,
2517                            user => '');                            user => '');
2518        } elsif ($colName eq 'viewerlink') {
2519            # Here we want a link to the SEED viewer page using the official viewer button.
2520            $retVal = FakeButton('Annotation', "index.cgi", undef,
2521                                 action => 'ShowAnnotation', prot => $fid);
2522      }elsif ($colName eq 'subsystem') {      }elsif ($colName eq 'subsystem') {
2523          # Another run-time column: subsystem list.          # Another run-time column: subsystem list.
2524          $retVal = "%%subsystem=$fid";          $retVal = "%%subsystem=$fid";
# Line 2764  Line 2886 
2886      return $retVal;      return $retVal;
2887  }  }
2888    
2889    =head3 PrintLine
2890    
2891    C<< $shelp->PrintLine($message); >>
2892    
2893    Print a line of CGI output. This is used during the operation of the B<Find> method while
2894    searching, so the user sees progress in real-time.
2895    
2896    =over 4
2897    
2898    =item message
2899    
2900    HTML text to display.
2901    
2902    =back
2903    
2904    =cut
2905    
2906    sub PrintLine {
2907        # Get the parameters.
2908        my ($self, $message) = @_;
2909        # Send them to the output.
2910        print "$message\n";
2911    }
2912    
2913    
2914  1;  1;

Legend:
Removed from v.1.25  
changed lines
  Added in v.1.28

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3