[Bio] / Sprout / SHOpSearch.pm Repository:
ViewVC logotype

Diff of /Sprout/SHOpSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Thu Apr 19 00:06:25 2007 UTC revision 1.4, Thu Dec 6 14:58:03 2007 UTC
# Line 4  Line 4 
4    
5      use strict;      use strict;
6      use Tracer;      use Tracer;
     use SearchHelper;  
7      use CGI;      use CGI;
8      use HTML;      use HTML;
9      use Sprout;      use Sprout;
10      use FeatureData;      use RHFeatures;
     use FeatureQuery;  
11      use BasicLocation;      use BasicLocation;
12        use base 'SearchHelper';
     our @ISA = qw(SearchHelper);  
13    
14  =head1 Operon Analysis Feature Search Helper  =head1 Operon Analysis Feature Search Helper
15    
# Line 24  Line 21 
21  produced by a feature search, this method also shows the upstream DNA for each feature  produced by a feature search, this method also shows the upstream DNA for each feature
22  found. The size of the upstream region is also defined by a parameter.  found. The size of the upstream region is also defined by a parameter.
23    
24  It has the following extra parameters.  This search has the following extra parameters.
25    
26  =over 4  =over 4
27    
# Line 63  Line 60 
60    
61  =head3 Form  =head3 Form
62    
63  C<< my $html = $shelp->Form(); >>      my $html = $shelp->Form();
64    
65  Generate the HTML for a form to request a new search.  Generate the HTML for a form to request a new search.
66    
# Line 91  Line 88 
88                           $cgi->td("Maximum distance between operon genes"),                           $cgi->td("Maximum distance between operon genes"),
89                           $cgi->td($cgi->textfield(-name => 'nearDistance',                           $cgi->td($cgi->textfield(-name => 'nearDistance',
90                                                    -value => $options->{nearDistance},                                                    -value => $options->{nearDistance},
91                                                    -size => 5))),                                                    -size => 5) .
92                                      SearchHelper::Hint("OpSearch",
93                                                         "If the distance between two genes " .
94                                                         "is greater than this number of base " .
95                                                         "pairs, they will be treated as " .
96                                                         "belonging to different operons."))),
97                  $cgi->Tr($cgi->td("Upstream base pairs to display"),                  $cgi->Tr($cgi->td("Upstream base pairs to display"),
98                           $cgi->td($cgi->textfield(-name => 'upstream',                           $cgi->td($cgi->textfield(-name => 'upstream',
99                                                    -value => $options->{upstream},                                                    -value => $options->{upstream},
100                                                    -size => 5))),                                                    -size => 5) .
101                             SearchHelper::Hint("OpSearch",
102                                                "When displaying the upstream DNA, this is " .
103                                                "the number of base pairs preceding the gene " .
104                                                "that will be shown."))),
105                  $cgi->Tr($cgi->td("Instream base pairs to display"),                  $cgi->Tr($cgi->td("Instream base pairs to display"),
106                           $cgi->td($cgi->textfield(-name => 'instream',                           $cgi->td($cgi->textfield(-name => 'instream',
107                                                    -value => $options->{instream},                                                    -value => $options->{instream},
108                                                    -size => 5))),                                                    -size => 5) .
109                                      SearchHelper::Hint("OpSearch",
110                                                         "When displaying the upstream DNA, this is " .
111                                                         "the number of base pairs from inside the " .
112                                                         "gene that will be shown."))),
113                  $cgi->Tr($cgi->td("Maximum lint size"),                  $cgi->Tr($cgi->td("Maximum lint size"),
114                           $cgi->td($cgi->textfield(-name => 'lintSize',                           $cgi->td($cgi->textfield(-name => 'lintSize',
115                                                    -value => $options->{lintSize},                                                    -value => $options->{lintSize},
116                                                    -size => 5)));                                                    -size => 5) .
117                                      SearchHelper::Hint("OpSearch",
118                                                         "Genes whose size in base pairs are equal to " .
119                                                         "or less than this amount will; be ignored.")));
120      # Add the special feature options.      # Add the special feature options.
121      push @rows, FeatureQuery::SpecialOptions($self);      push @rows, RHFeatures::FeatureFilterFormRows($self, 'options');
122      # Add the submit button.      # Add the submit button.
123      push @rows, $self->SubmitRow();      push @rows, $self->SubmitRow();
124      # Make the rows into a table.      # Make the rows into a table.
# Line 118  Line 131 
131    
132  =head3 Find  =head3 Find
133    
134  C<< my $resultCount = $shelp->Find(); >>      my $resultCount = $shelp->Find();
135    
136  Conduct a search based on the current CGI query parameters. The search results will  Conduct a search based on the current CGI query parameters. The search results will
137  be written to the session cache file and the number of results will be  be written to the session cache file and the number of results will be
# Line 135  Line 148 
148      # Declare the return variable. If it remains undefined, the caller will      # Declare the return variable. If it remains undefined, the caller will
149      # know that an error occurred.      # know that an error occurred.
150      my $retVal;      my $retVal;
     # Denote that the upstream column gos at the end.  
     $self->SetExtraPos('Upstream DNA', 'Location');  
151      # Get the genome ID.      # Get the genome ID.
152      my $genomeID = $cgi->param('genome');      my $genomeID = $cgi->param('genome');
153      # Get the tuning parameters.      # Get the tuning parameters.
# Line 158  Line 169 
169          my $query = $sprout->Get(['HasFeature', 'Feature', 'IsLocatedIn', 'Contig'],          my $query = $sprout->Get(['HasFeature', 'Feature', 'IsLocatedIn', 'Contig'],
170                                   "HasFeature(from-link) = ? ORDER BY IsLocatedIn(to-link), IsLocatedIn(beg)",                                   "HasFeature(from-link) = ? ORDER BY IsLocatedIn(to-link), IsLocatedIn(beg)",
171                                   [$genomeID]);                                   [$genomeID]);
172          # Create a feature data object to help us process the features.          # Create a feature result helper to help us process the features.
173          my $fd = FeatureData->new($self);          my $rhelp = RHFeatures->new($self);
174            # Set the columns.
175            $self->DefaultColumns($rhelp);
176            # Define the extra columns.
177            $rhelp->AddExtraColumn(operonID => 0,     download => 'text',  title => 'Operon ID', style => 'leftAlign');
178            $rhelp->AddExtraColumn(location => 1,     download => 'text',  title => 'Location', style => 'leftAlign');
179            $rhelp->AddExtraColumn(upstream => undef, download => 'align', title => 'Upstream DNA', style => 'leftAlign');
180          # Start the session.          # Start the session.
181          $self->OpenSession();          $self->OpenSession($rhelp);
182          # The trickiest part of this whole process is computing the operon information.          # The trickiest part of this whole process is computing the operon information.
183          # Each feature has an operon ID and an operon sequence number. The operon ID          # Each feature has an operon ID and an operon sequence number. The operon ID
184          # is displayed as an extra column. The sequence number is combined with the          # is displayed as an extra column. The sequence number is combined with the
# Line 178  Line 195 
195          # so that the first feature we encounted will be considered the start of a new          # so that the first feature we encounted will be considered the start of a new
196          # operon.          # operon.
197          my $lastLocation = BasicLocation->new(" ", 0, '+', 0);          my $lastLocation = BasicLocation->new(" ", 0, '+', 0);
198          # This variable contains the last feature's ID. We may receive multiple results for          # This variable contains the last feature. We may receive multiple results for
199          # a single feature. Only the last result is output.          # a single feature. Only the last result is output.
200            my $lastFeature;
201          my $lastFid = "";          my $lastFid = "";
202          # Finally, we need to save the current contig ID and length.          # Finally, we need to save the current contig ID and length.
203          $self->{contigID} = "";          $self->{contigID} = "";
# Line 190  Line 208 
208              my $thisLocation = BasicLocation->new($feature->Values(['IsLocatedIn(to-link)', 'IsLocatedIn(beg)',              my $thisLocation = BasicLocation->new($feature->Values(['IsLocatedIn(to-link)', 'IsLocatedIn(beg)',
209                                                                     'IsLocatedIn(dir)', 'IsLocatedIn(len)']));                                                                     'IsLocatedIn(dir)', 'IsLocatedIn(len)']));
210              # Get this feature's ID.              # Get this feature's ID.
211              my ($thisFid) = $feature->Value('IsLocatedIn(from-link)');              my $thisFid = $feature->PrimaryValue('IsLocatedIn(from-link)');
212              # Only proceed if this feature is not lint.              # Only proceed if this feature is not lint.
213              if ($thisLocation->Length >= $options->{lintSize}) {              if ($thisLocation->Length >= $options->{lintSize}) {
214                  # Determine whether or not this is a new feature.                  # Determine whether or not this is a new feature.
# Line 203  Line 221 
221                      # We have a new feature. Write out the previous feature's data (if any).                      # We have a new feature. Write out the previous feature's data (if any).
222                      if ($lastFid) {                      if ($lastFid) {
223                          Trace("Writing feature $lastFid.") if T(4);                          Trace("Writing feature $lastFid.") if T(4);
224                          $self->OutputFeature($fd, $lastLocation, $options);                          $self->OutputFeature($rhelp, $lastFeature, $lastLocation, $options);
225                          $retVal++;                          $retVal++;
226                          # Reveal our status every 100 features.                          # Reveal our status every 100 features.
227                          if ($retVal % 100 == 0) {                          if ($retVal % 100 == 0) {
228                              $self->PrintLine("$retVal features processed. $self->{operonID} operons found.");                              $self->PrintLine("$retVal features processed. $self->{operonID} operons found.");
229                          }                          }
230                      }                      }
231                      # Remember the new feature ID.                      # Remember the new feature and its ID.
232                      $lastFid = $thisFid;                      $lastFid = $thisFid;
233                      # Store this new feature in the feature data object.                      $lastFeature = $feature;
                     $fd->Store($feature);  
234                      # Check the operon status.                      # Check the operon status.
235                      if ($lastLocation->Contig eq $thisLocation->Contig &&                      if ($lastLocation->Contig eq $thisLocation->Contig &&
236                          $lastLocation->Dir eq $thisLocation->Dir &&                          $lastLocation->Dir eq $thisLocation->Dir &&
# Line 241  Line 258 
258          }          }
259          # Output the last feature (if any).          # Output the last feature (if any).
260          if ($lastFid) {          if ($lastFid) {
261              $self->OutputFeature($fd, $lastLocation, $options);              $self->OutputFeature($rhelp, $lastFeature, $lastLocation, $options);
262              $retVal++;              $retVal++;
263          }          }
264          # Close the session file.          # Close the session file.
# Line 253  Line 270 
270    
271  =head3 Description  =head3 Description
272    
273  C<< my $htmlText = $shelp->Description(); >>      my $htmlText = $shelp->Description();
274    
275  Return a description of this search. The description is used for the table of contents  Return a description of this search. The description is used for the table of contents
276  on the main search tools page. It may contain HTML, but it should be character-level,  on the main search tools page. It may contain HTML, but it should be character-level,
# Line 270  Line 287 
287    
288  =head3 SortKey  =head3 SortKey
289    
290  C<< my $key = $shelp->SortKey($fdata); >>      my $key = $shelp->SortKey($rhelp, $record);
291    
292  Return the sort key for the specified feature data. The default is to sort by feature name,  Return the sort key for the current feature. The features are
293  floating NMPDR organisms to the top. If a full-text search is used, then the default  sorted by sequence within operon, which is determined entirely
294  sort is by relevance followed by feature name. This sort may be overridden by the  by data cached in this object. The sort order may, however,
295  search class to provide fancier functionality. This method is called by  be modified by options
 B<PutFeature>, so it is only used for feature searches. A non-feature search  
 would presumably have its own sort logic.  
296    
297  =over 4  =over 4
298    
299    =item rhelp
300    
301    Current result helper object.
302    
303  =item record  =item record
304    
305  The C<FeatureData> containing the current feature.  The C<ERDBObject> containing the current feature.
306    
307  =item RETURN  =item RETURN
308    
# Line 295  Line 314 
314    
315  sub SortKey {  sub SortKey {
316      # Get the parameters.      # Get the parameters.
317      my ($self, $fdata) = @_;      my ($self, $rhelp, $record) = @_;
318      # Get the current operon ID and sequence.      # Get the current operon ID and sequence.
319      my $operonID = $self->{operonID};      my $operonID = $self->{operonID};
320      my $operonSeqNumber = $self->{operonFeatureSeq};      my $operonSeqNumber = $self->{operonFeatureSeq};
321      # The operon Sequence number is already at a fixed width. We need to pad to a      # The operon Sequence number is already at a fixed width. We need to pad to a
322      # fixed width for the operon ID.      # fixed width for the operon ID.
323      my $retVal = "$operonID.$operonSeqNumber";      my $operonKey = "$operonID.$operonSeqNumber";
324      while (length $retVal < 20) {      while (length $operonKey < 20) {
325          $retVal = "0$retVal";          $operonKey = "0$operonKey";
326      }      }
327        # Create a feature sort key for this feature with the operon data mixed in.
328        my $retVal = $rhelp->SortKey($record, $operonKey);
329      # Return the result.      # Return the result.
330      return $retVal;      return $retVal;
331  }  }
332    
333  =head3 OutputFeature  =head3 OutputFeature
334    
335  C<< $shelp->OutputFeature($fd, $location, $options); >>      $shelp->OutputFeature($rhelp, $feature, $location, $options);
336    
337  Output the current feature. We use the location to compute an upstream location for the feature,  Output the current feature. We use the location to compute an upstream location for the feature,
338  and this is added to the feature data object as an extra column named C<Upstream DNA>. The operon ID  and this is added to the feature data object as an extra column named C<Upstream DNA>. The operon ID
# Line 319  Line 340 
340    
341  =over 4  =over 4
342    
343  =item fd  =item rhelp
344    
345    Feature result helper.
346    
347  Feature Data object with the current feature stored in it.  =item feature
348    
349  =item location  =item location
350    
# Line 338  Line 361 
361    
362  sub OutputFeature {  sub OutputFeature {
363      # Get the parameters.      # Get the parameters.
364      my ($self, $fd, $location, $options) = @_;      my ($self, $rhelp, $feature, $location, $options) = @_;
365      # Get access to Sprout.      # Get access to Sprout.
366      my $sprout = $self->DB();      my $sprout = $self->DB();
367      # Get the contig length.      # Get the contig length.
# Line 367  Line 390 
390      # the SEED format so the user can eyeball the distance between genes.      # the SEED format so the user can eyeball the distance between genes.
391      my $locationString = $location->SeedString;      my $locationString = $location->SeedString;
392      $locationString =~ s/^[^:]+://;      $locationString =~ s/^[^:]+://;
393      # Store the upstream DNA in the feature data object along with the operon ID. We add      # Store the upstream DNA in the result helper along with the operon ID. We add
394      # the direction to the operon ID so the user knows more easily which way we're pointing.      # the direction to the operon ID so the user knows more easily which way we're pointing.
395      $fd->AddExtraColumns('Operon ID' => $self->{operonID} . $location->Dir,      $rhelp->PutExtraColumns(operonID => $self->{operonID} . $location->Dir,
396                           'Upstream DNA' => $upstreamDNA,                              upstream => $upstreamDNA,
397                           'Location' => $locationString);                              location => $locationString);
398        # Compute the sort key and the feature ID.
399        my $sortKey = $self->SortKey($rhelp, $feature);
400        my $fid = $feature->PrimaryValue('Feature(id)');
401      # Put the feature to the output.      # Put the feature to the output.
402      $self->PutFeature($fd);      $rhelp->PutData($sortKey, $fid, $feature);
403    }
404    
405    =head3 SearchTitle
406    
407        my $titleHtml = $shelp->SearchTitle();
408    
409    Return the display title for this search. The display title appears above the search results.
410    If no result is returned, no title will be displayed. The result should be an html string
411    that can be legally put inside a block tag such as C<h3> or C<p>.
412    
413    =cut
414    
415    sub SearchTitle {
416        # Get the parameters.
417        my ($self) = @_;
418        # Compute the title. We extract the genome ID from the query parameters.
419        my $cgi = $self->Q();
420        my $pdbID = $cgi->param('genome');
421        my $retVal = "Docking Results for $pdbID";
422        # Return it.
423        return $retVal;
424  }  }
425    
426    
427  1;  1;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3