[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.2, Mon Jul 16 20:04:51 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 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("If the distance between two genes " .
93                                                         "is greater than this number of base " .
94                                                         "pairs, they will be treated as " .
95                                                         "belonging to different operons."))),
96                  $cgi->Tr($cgi->td("Upstream base pairs to display"),                  $cgi->Tr($cgi->td("Upstream base pairs to display"),
97                           $cgi->td($cgi->textfield(-name => 'upstream',                           $cgi->td($cgi->textfield(-name => 'upstream',
98                                                    -value => $options->{upstream},                                                    -value => $options->{upstream},
99                                                    -size => 5))),                                                    -size => 5) .
100                             SearchHelper::Hint("When displaying the upstream DNA, this is " .
101                                                "the number of base pairs preceding the gene " .
102                                                "that will be shown."))),
103                  $cgi->Tr($cgi->td("Instream base pairs to display"),                  $cgi->Tr($cgi->td("Instream base pairs to display"),
104                           $cgi->td($cgi->textfield(-name => 'instream',                           $cgi->td($cgi->textfield(-name => 'instream',
105                                                    -value => $options->{instream},                                                    -value => $options->{instream},
106                                                    -size => 5))),                                                    -size => 5) .
107                                      SearchHelper::Hint("When displaying the upstream DNA, this is " .
108                                                         "the number of base pairs from inside the " .
109                                                         "gene that will be shown."))),
110                  $cgi->Tr($cgi->td("Maximum lint size"),                  $cgi->Tr($cgi->td("Maximum lint size"),
111                           $cgi->td($cgi->textfield(-name => 'lintSize',                           $cgi->td($cgi->textfield(-name => 'lintSize',
112                                                    -value => $options->{lintSize},                                                    -value => $options->{lintSize},
113                                                    -size => 5)));                                                    -size => 5) .
114                                      SearchHelper::Hint("Genes whose size in base pairs are equal to " .
115                                                         "or less than this amount will; be ignored.")));
116      # Add the special feature options.      # Add the special feature options.
117      push @rows, FeatureQuery::SpecialOptions($self);      push @rows, RHFeatures::FeatureFilterFormRows($self, 'options');
118      # Add the submit button.      # Add the submit button.
119      push @rows, $self->SubmitRow();      push @rows, $self->SubmitRow();
120      # Make the rows into a table.      # Make the rows into a table.
# Line 135  Line 144 
144      # Declare the return variable. If it remains undefined, the caller will      # Declare the return variable. If it remains undefined, the caller will
145      # know that an error occurred.      # know that an error occurred.
146      my $retVal;      my $retVal;
     # Denote that the upstream column gos at the end.  
     $self->SetExtraPos('Upstream DNA', 'Location');  
147      # Get the genome ID.      # Get the genome ID.
148      my $genomeID = $cgi->param('genome');      my $genomeID = $cgi->param('genome');
149      # Get the tuning parameters.      # Get the tuning parameters.
# Line 158  Line 165 
165          my $query = $sprout->Get(['HasFeature', 'Feature', 'IsLocatedIn', 'Contig'],          my $query = $sprout->Get(['HasFeature', 'Feature', 'IsLocatedIn', 'Contig'],
166                                   "HasFeature(from-link) = ? ORDER BY IsLocatedIn(to-link), IsLocatedIn(beg)",                                   "HasFeature(from-link) = ? ORDER BY IsLocatedIn(to-link), IsLocatedIn(beg)",
167                                   [$genomeID]);                                   [$genomeID]);
168          # Create a feature data object to help us process the features.          # Create a feature result helper to help us process the features.
169          my $fd = FeatureData->new($self);          my $rhelp = RHFeatures->new($self);
170            # Set the columns.
171            $self->DefaultColumns($rhelp);
172            # Define the extra columns.
173            $rhelp->AddExtraColumn(operonID => 0,     download => 'text',  title => 'Operon ID', style => 'leftAlign');
174            $rhelp->AddExtraColumn(location => 1,     download => 'text',  title => 'Location', style => 'leftAlign');
175            $rhelp->AddExtraColumn(upstream => undef, download => 'align', title => 'Upstream DNA', style => 'leftAlign');
176          # Start the session.          # Start the session.
177          $self->OpenSession();          $self->OpenSession($rhelp);
178          # The trickiest part of this whole process is computing the operon information.          # The trickiest part of this whole process is computing the operon information.
179          # 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
180          # 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 191 
191          # 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
192          # operon.          # operon.
193          my $lastLocation = BasicLocation->new(" ", 0, '+', 0);          my $lastLocation = BasicLocation->new(" ", 0, '+', 0);
194          # 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
195          # a single feature. Only the last result is output.          # a single feature. Only the last result is output.
196            my $lastFeature;
197          my $lastFid = "";          my $lastFid = "";
198          # Finally, we need to save the current contig ID and length.          # Finally, we need to save the current contig ID and length.
199          $self->{contigID} = "";          $self->{contigID} = "";
# Line 190  Line 204 
204              my $thisLocation = BasicLocation->new($feature->Values(['IsLocatedIn(to-link)', 'IsLocatedIn(beg)',              my $thisLocation = BasicLocation->new($feature->Values(['IsLocatedIn(to-link)', 'IsLocatedIn(beg)',
205                                                                     'IsLocatedIn(dir)', 'IsLocatedIn(len)']));                                                                     'IsLocatedIn(dir)', 'IsLocatedIn(len)']));
206              # Get this feature's ID.              # Get this feature's ID.
207              my ($thisFid) = $feature->Value('IsLocatedIn(from-link)');              my $thisFid = $feature->PrimaryValue('IsLocatedIn(from-link)');
208              # Only proceed if this feature is not lint.              # Only proceed if this feature is not lint.
209              if ($thisLocation->Length >= $options->{lintSize}) {              if ($thisLocation->Length >= $options->{lintSize}) {
210                  # Determine whether or not this is a new feature.                  # Determine whether or not this is a new feature.
# Line 203  Line 217 
217                      # 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).
218                      if ($lastFid) {                      if ($lastFid) {
219                          Trace("Writing feature $lastFid.") if T(4);                          Trace("Writing feature $lastFid.") if T(4);
220                          $self->OutputFeature($fd, $lastLocation, $options);                          $self->OutputFeature($rhelp, $lastFeature, $lastLocation, $options);
221                          $retVal++;                          $retVal++;
222                          # Reveal our status every 100 features.                          # Reveal our status every 100 features.
223                          if ($retVal % 100 == 0) {                          if ($retVal % 100 == 0) {
224                              $self->PrintLine("$retVal features processed. $self->{operonID} operons found.");                              $self->PrintLine("$retVal features processed. $self->{operonID} operons found.");
225                          }                          }
226                      }                      }
227                      # Remember the new feature ID.                      # Remember the new feature and its ID.
228                      $lastFid = $thisFid;                      $lastFid = $thisFid;
229                      # Store this new feature in the feature data object.                      $lastFeature = $feature;
                     $fd->Store($feature);  
230                      # Check the operon status.                      # Check the operon status.
231                      if ($lastLocation->Contig eq $thisLocation->Contig &&                      if ($lastLocation->Contig eq $thisLocation->Contig &&
232                          $lastLocation->Dir eq $thisLocation->Dir &&                          $lastLocation->Dir eq $thisLocation->Dir &&
# Line 241  Line 254 
254          }          }
255          # Output the last feature (if any).          # Output the last feature (if any).
256          if ($lastFid) {          if ($lastFid) {
257              $self->OutputFeature($fd, $lastLocation, $options);              $self->OutputFeature($rhelp, $lastFeature, $lastLocation, $options);
258              $retVal++;              $retVal++;
259          }          }
260          # Close the session file.          # Close the session file.
# Line 270  Line 283 
283    
284  =head3 SortKey  =head3 SortKey
285    
286  C<< my $key = $shelp->SortKey($fdata); >>  C<< my $key = $shelp->SortKey($rhelp, $record); >>
287    
288  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
289  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
290  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,
291  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.  
292    
293  =over 4  =over 4
294    
295    =item rhelp
296    
297    Current result helper object.
298    
299  =item record  =item record
300    
301  The C<FeatureData> containing the current feature.  The C<ERDBObject> containing the current feature.
302    
303  =item RETURN  =item RETURN
304    
# Line 295  Line 310 
310    
311  sub SortKey {  sub SortKey {
312      # Get the parameters.      # Get the parameters.
313      my ($self, $fdata) = @_;      my ($self, $rhelp, $record) = @_;
314      # Get the current operon ID and sequence.      # Get the current operon ID and sequence.
315      my $operonID = $self->{operonID};      my $operonID = $self->{operonID};
316      my $operonSeqNumber = $self->{operonFeatureSeq};      my $operonSeqNumber = $self->{operonFeatureSeq};
317      # 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
318      # fixed width for the operon ID.      # fixed width for the operon ID.
319      my $retVal = "$operonID.$operonSeqNumber";      my $operonKey = "$operonID.$operonSeqNumber";
320      while (length $retVal < 20) {      while (length $operonKey < 20) {
321          $retVal = "0$retVal";          $operonKey = "0$operonKey";
322      }      }
323        # Create a feature sort key for this feature with the operon data mixed in.
324        my $retVal = $rhelp->SortKey($record, $operonKey);
325      # Return the result.      # Return the result.
326      return $retVal;      return $retVal;
327  }  }
328    
329  =head3 OutputFeature  =head3 OutputFeature
330    
331  C<< $shelp->OutputFeature($fd, $location, $options); >>  C<< $shelp->OutputFeature($rhelp, $feature, $location, $options); >>
332    
333  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,
334  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 336 
336    
337  =over 4  =over 4
338    
339  =item fd  =item rhelp
340    
341    Feature result helper.
342    
343  Feature Data object with the current feature stored in it.  =item feature
344    
345  =item location  =item location
346    
# Line 338  Line 357 
357    
358  sub OutputFeature {  sub OutputFeature {
359      # Get the parameters.      # Get the parameters.
360      my ($self, $fd, $location, $options) = @_;      my ($self, $rhelp, $feature, $location, $options) = @_;
361      # Get access to Sprout.      # Get access to Sprout.
362      my $sprout = $self->DB();      my $sprout = $self->DB();
363      # Get the contig length.      # Get the contig length.
# Line 367  Line 386 
386      # the SEED format so the user can eyeball the distance between genes.      # the SEED format so the user can eyeball the distance between genes.
387      my $locationString = $location->SeedString;      my $locationString = $location->SeedString;
388      $locationString =~ s/^[^:]+://;      $locationString =~ s/^[^:]+://;
389      # 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
390      # 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.
391      $fd->AddExtraColumns('Operon ID' => $self->{operonID} . $location->Dir,      $rhelp->PutExtraColumns(operonID => $self->{operonID} . $location->Dir,
392                           'Upstream DNA' => $upstreamDNA,                              upstream => $upstreamDNA,
393                           'Location' => $locationString);                              location => $locationString);
394        # Compute the sort key and the feature ID.
395        my $sortKey = $self->SortKey($rhelp, $feature);
396        my $fid = $feature->PrimaryValue('Feature(id)');
397      # Put the feature to the output.      # Put the feature to the output.
398      $self->PutFeature($fd);      $rhelp->PutData($sortKey, $fid, $feature);
399    }
400    
401    =head3 SearchTitle
402    
403    C<< my $titleHtml = $shelp->SearchTitle(); >>
404    
405    Return the display title for this search. The display title appears above the search results.
406    If no result is returned, no title will be displayed. The result should be an html string
407    that can be legally put inside a block tag such as C<h3> or C<p>.
408    
409    =cut
410    
411    sub SearchTitle {
412        # Get the parameters.
413        my ($self) = @_;
414        # Compute the title. We extract the genome ID from the query parameters.
415        my $cgi = $self->Q();
416        my $pdbID = $cgi->param('genome');
417        my $retVal = "Docking Results for $pdbID";
418        # Return it.
419        return $retVal;
420  }  }
421    
422    
423  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3