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

Annotation of /Sprout/RHFeatures.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package RHFeatures;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use Sprout;
8 :     use SearchHelper;
9 :     use AliasAnalysis;
10 :     use HTML;
11 :     use base 'ResultHelper';
12 :    
13 :     =head1 Feature Result Helper
14 :    
15 :     =head2 Introduction
16 :    
17 :     The feature result helper is used for searches where the result is a list of
18 :     features. As such, it is the biggest and most popular of all the result
19 :     helpers.
20 :    
21 :     Because features are the bread and butter of the NMPDR, this helper provides
22 :     a set of built-in filters. Each built-in filter is associated
23 :     with a form fragment. The L</FilteredQuery> method returns a list of features
24 :     that satisfy all the filters used. The L</DefaultResultColumns> method will add
25 :     to the output columns relevant to the parameters of the search.
26 :    
27 :     The default action of this helper is to assume no values are required for any of the
28 :     filters. In the case of a word search, you can use the method L</KeywordsRequired> to
29 :     denote that an empty keyword list is unacceptable.
30 :    
31 :     =cut
32 :    
33 :     =head2 Public Methods
34 :    
35 :     =head3 new
36 :    
37 : parrello 1.7 my $rhelp = RHFeatures->new($shelp);
38 : parrello 1.1
39 :     Construct a new RHFeatures object.
40 :    
41 :     =over 4
42 :    
43 :     =item shelp
44 :    
45 :     Parent search helper object for this result helper.
46 :    
47 :     =back
48 :    
49 :     =cut
50 :    
51 :     sub new {
52 :     # Get the parameters.
53 :     my ($class, $shelp) = @_;
54 :     # Create the helper object.
55 :     my $retVal = ResultHelper::new($class, $shelp);
56 :     # Denote no keyword is required.
57 :     $retVal->{wordSearch} = 0;
58 :     # Bless and return it.
59 :     bless $retVal, $class;
60 :     return $retVal;
61 :     }
62 :    
63 :     =head2 Feature Filtering Support
64 :    
65 :     =head3 KeywordsRequired
66 :    
67 : parrello 1.7 $rhelp->KeywordsRequired();
68 : parrello 1.1
69 :     Denote that a value is required for the word search (C<keywords>) field.
70 :    
71 :     =cut
72 :    
73 :     sub KeywordsRequired {
74 :     # Get the parameters.
75 :     my ($self) = @_;
76 :     # Denote that a keyword is required.
77 :     $self->{wordSearch} = 1;
78 :     }
79 :    
80 :     =head3 FeatureFilterFormRows
81 :    
82 : parrello 1.7 my $htmlText = RHFeatures::FeatureFilterFormRows($shelp, @sections);
83 : parrello 1.1
84 :     Return a string of feature filter rows for a search form.
85 :    
86 :     =over 4
87 :    
88 :     =item shelp
89 :    
90 :     Currently-active search helper.
91 :    
92 :     =item sections
93 :    
94 :     A list of section names. If no section names are specified, all sections will be
95 :     included.
96 :    
97 :     =item RETURN
98 :    
99 :     Returns the HTML text for table rows containing the selected filters.
100 :    
101 :     =back
102 :    
103 :     The currently-supported sections are:
104 :    
105 :     =over 4
106 :    
107 :     =item options
108 :    
109 :     Contains checkboxes used to configure the search results. C<ShowAliases> includes feature aliases
110 : parrello 1.4 in the output, C<FavoredAlias> allows the user to specify a favored alias for the alias list,
111 :     and C<FunctionSort> sorts the output by functional role.
112 : parrello 1.1
113 :     =item subsystem
114 :    
115 :     Restricts the features to those that participate in a single subsystem. The subsystem name is
116 :     specified in a field called C<subsystem>.
117 :    
118 :     =back
119 :    
120 :     =cut
121 :    
122 :     sub FeatureFilterFormRows {
123 :     # Get the parameters.
124 :     my ($shelp, @sections) = @_;
125 :     # Get the CGI and Sprout objects from the search helper.
126 :     my $cgi = $shelp->Q();
127 :     my $sprout = $shelp->DB();
128 :     # We'll stuff the computed table rows in here.
129 :     my @retVal = ();
130 :     # If there are no sections, denote we want all of them.
131 :     my @actualSections;
132 :     if (@sections) {
133 :     @actualSections = @sections;
134 :     } else {
135 :     @actualSections = qw(subsystem options);
136 :     }
137 :     # Produce the sections in the named sequence.
138 :     for my $section (@actualSections) {
139 :     if ($section eq 'subsystem') {
140 :     # Get the currently-selected subsystem name.
141 :     my $subsystemName = $cgi->param('subsystem') || '(all)';
142 :     # Get all the subsystems in the database.
143 :     my @subsystemList = $sprout->GetFlat(['Subsystem'], "ORDER BY Subsystem(id)", [], 'Subsystem(id)');
144 :     # Add the all-subsystem indicator.
145 :     unshift @subsystemList, '(all)';
146 :     # Format everything into a table row.
147 :     push @retVal, $cgi->Tr($cgi->td("Subsystem"),
148 :     $cgi->td({ colspan => 2 },
149 :     $cgi->popup_menu(-name => 'subsystem',
150 :     -values => \@subsystemList,
151 :     -default => $subsystemName) .
152 : parrello 1.4 SearchHelper::Hint("Subsystem Filter",
153 :     "Select a subsystem to restrict output to genes in " .
154 : parrello 1.1 "that subsystem. Note that a subsystem applies to a " .
155 :     "limited set of organisms, so using this filter may " .
156 :     "yield an empty result set.")));
157 :    
158 :     } elsif ($section eq 'options') {
159 :     # Get the current values of the parameters.
160 :     my $aliases = $cgi->param('ShowAliases');
161 :     my $funcSort = $cgi->param('FunctionSort');
162 : parrello 1.3 my $favored = $cgi->param('FavoredAlias') || '';
163 : parrello 1.1 # Display them as checkboxes.
164 : parrello 1.4 push @retVal, $cgi->Tr($cgi->td("Options"),
165 : parrello 1.1 $cgi->td({colspan => 2},
166 :     $cgi->checkbox(-name => 'FunctionSort',
167 :     -value => 1,
168 :     -label => 'Sort by Function',
169 :     -default => $funcSort) .
170 :     " " .
171 : parrello 1.3 "<br />" .
172 :     $cgi->checkbox(-name => 'ShowAliases',
173 :     -value => 1,
174 :     -label => 'Show Alias Links',
175 :     -default => $aliases) .
176 :     ", favoring those beginning with&nbsp;" .
177 :     $cgi->textfield(-name => 'FavoredAlias',
178 :     -size => 5,
179 :     -default => $favored) .
180 : parrello 1.4 SearchHelper::Hint("Gene Display Options",
181 :     "For each gene, displays its other names (aliases). " .
182 : parrello 1.3 "You can use the text box to specify a prefix. Aliases " .
183 :     "that begin with the prefix will be sorted to " .
184 :     "the beginning of the list.")
185 :     ));
186 : parrello 1.1 } else {
187 :     Trace("Invalid feature filter form row name \"$section\".") if T(1);
188 :     }
189 :     }
190 :     # Return the accumulated table rows.
191 :     return join("\n", @retVal);
192 :     }
193 :    
194 :     =head3 WordSearchRow
195 :    
196 : parrello 1.7 my $htmlText = RHFeatures::WordSearchRow($shelp);
197 : parrello 1.1
198 :     Return a filter row for word searches. The word search uses the keyword search index
199 :     on the feature table, and allows many different options, including boolean flags and
200 :     phrase quoting. When a word search is used, there will be an extra field in the
201 :     returned B<ERDBObject>s-- C<search-relevance>-- which is a floating-point value that can
202 :     be used to modify the sort key for the search results.
203 :    
204 :     =over 4
205 :    
206 :     =item shelp
207 :    
208 :     Currently-active search helper.
209 :    
210 :     =item RETURN
211 :    
212 :     Returns an HTML table row containing the form field and labels for keyword searching.
213 :     The word search parameter will have the name C<keywords>.
214 :    
215 :     =back
216 :    
217 :     =cut
218 :    
219 :     sub WordSearchRow {
220 :     # Get the parameters.
221 :     my ($shelp) = @_;
222 :     # Get the CGI query object.
223 :     my $cgi = $shelp->Q();
224 :     # Get the current keyword value.
225 :     my $expressionString = $cgi->param('keywords') || '';
226 :     # Create the word search row in the return variable.
227 :     my $retVal = $cgi->Tr($cgi->td("Search Words"),
228 :     $cgi->td({colspan => 2}, $cgi->textfield(-name => 'keywords',
229 :     -value => $expressionString,
230 :     -size => 40) .
231 : parrello 1.4 SearchHelper::Hint("Keyword Box",
232 :     "Specify a gene ID, an EC number, " .
233 : parrello 1.1 "or words from subsystem names, " .
234 :     "functional roles, and/or an organism's " .
235 :     "taxonomy.")));
236 :     # Return it.
237 :     return $retVal;
238 :     }
239 :    
240 :     =head3 GetQuery
241 :    
242 : parrello 1.7 my $fquery = $rhelp->GetQuery($genomeID);
243 : parrello 1.1
244 :     Construct a query for processing the features in a particular genome
245 :     relevant to a search. This method is used to retrieve all of the
246 :     features that satisfy the filtering criteria of the current search. Use this
247 :     method when your search is applying a post-query filter to the list of
248 :     features returned by the feature filters. Use L</CheckFeature> if your
249 :     search is retrieving a set of features and wants to reduce them using
250 :     the filter.
251 :    
252 :     The feature filter attempts to find features in the most optimal way possible.
253 :     If a subsystem is specified, then we will start from the B<HasRoleInSubsystem>
254 :     relationship, taking advantage of the fact that all features for a given genome
255 :     are clustered together in the index. If no subsystem is specified, then we will
256 :     start from B<HasFeature>, filtering by genome. If no subsystem or genome is
257 :     specified, we start from B<Feature>. At some future point we may need
258 :     to be even more sophisticated than that.
259 :    
260 :     =over 4
261 :    
262 :     =item genomeID (optional)
263 :    
264 :     Genome whose features are to be found and filtered. If omitted, then the
265 :     features for all genomes will be returned.
266 :    
267 :     =item RETURN
268 :    
269 :     Returns a hash containing information describing how to query the database
270 :     for the desired features. This hash is passed to the L</Fetch> method
271 :     to execute the query and return features.
272 :    
273 :     =back
274 :    
275 :     =cut
276 :    
277 :     sub GetQuery {
278 :     # Get the parameters.
279 :     my ($self, $genomeID) = @_;
280 :     Trace("Constructing query for $genomeID.") if T(3) && defined $genomeID;
281 :     Trace("Constructing query for all genomes.") if T(3) && ! defined $genomeID;
282 :     # Start with a hash reference.
283 :     my $retVal = {};
284 :     # Get the CGI query and Sprout objects.
285 :     my $shelp = $self->Parent();
286 :     my $cgi = $shelp->Q();
287 :     my $sprout = $shelp->DB();
288 :     # Get our stash variable for the property ID.
289 :     my $propIDs;
290 :     # Get the subsystem name. If it's "(all)", we convert to a null string.
291 :     my $subsystem = $cgi->param('subsystem');
292 :     $subsystem = "" if ($subsystem eq "(all)");
293 :     # Set up the search data. The $qData will contain all the parameters we need
294 :     # for the ERDB Get command.
295 :     my $qData = { sprout => $sprout, count => 0 };
296 :     # Now we determine what type of search we're doing based on the CGI paraneters.
297 :     # Note that "findex" will be the index in the table list of the feature table.
298 :     # We need this so we can tell the ERDB full-text search mechanism which table
299 :     # has the keyword field in it.
300 :     if ($subsystem) {
301 :     # Here we are doing a subsystem search.
302 :     $qData->{tables} = ['HasRoleInSubsystem', 'Feature'];
303 :     $qData->{filter} = "HasRoleInSubsystem(to-link) = ?";
304 :     $qData->{params} = [$subsystem];
305 :     $qData->{findex} = 1;
306 :     if (defined $genomeID) {
307 :     # Here we're filtering by genome, so we need to add a genome filter.
308 :     $qData->{filter} .= " AND HasRoleInSubsystem(genome) = ?";
309 :     push @{$qData->{params}}, $genomeID;
310 :     }
311 :     } elsif (defined $genomeID) {
312 :     # This is search by genome ID, so we start from Genome.
313 :     $qData->{tables} = ['HasFeature', 'Feature'];
314 :     $qData->{filter} = "HasFeature(from-link) = ?";
315 :     $qData->{params} = [$genomeID];
316 : parrello 1.2 $qData->{findex} = 1;
317 : parrello 1.1 } else {
318 :     # This is a pure feature type search, so we start from Feature.
319 :     $qData->{tables} = ['Feature'];
320 :     $qData->{filter} = "";
321 :     $qData->{params} = [];
322 :     $qData->{findex} = 0;
323 :     }
324 :     # Finally, check for search words. Note we take precautions to keep from being fooled by a
325 :     # bunch of blanks.
326 :     my $keywords = $cgi->param('keywords') || "";
327 :     if ($keywords =~ /^\s+$/) {
328 :     $keywords = "";
329 :     }
330 :     # If we have any search words left, denote we're a keyword search.
331 :     if ($keywords) {
332 :     $qData->{keywords} = $keywords;
333 :     }
334 :     Trace("Feature query filter is \"$qData->{filter}\" with keywords \"$keywords\".") if T(3);
335 :     $retVal->{subsystem} = $subsystem;
336 :     $retVal->{currentQuery} = undef;
337 :     $retVal->{queryData} = $qData;
338 :     $retVal->{fidCache} = {};
339 :     # Return the query management object.
340 :     return $retVal;
341 :     }
342 :    
343 :     =head3 Fetch
344 :    
345 : parrello 1.7 my $featureData = $rhelp->Fetch($fquery);
346 : parrello 1.1
347 :     Return the data for the next feature. The object returned will be a B<ERDBObject> for
348 :     the desired feature plus any useful ancillary data. If there are no more features
349 :     it will return C<undef>.
350 :    
351 :     =over 4
352 :    
353 :     =item fquery
354 :    
355 :     A feature query object creatd by L</GetQuery>.
356 :    
357 :     =item RETURN
358 :    
359 :     Returns an B<ERDBObject> for the desired feature, or C<undef> if there are no more
360 :     features available.
361 :    
362 :     =back
363 :    
364 :     =cut
365 :    
366 :     sub Fetch {
367 :     # Get the parameters.
368 :     my ($self, $fquery) = @_;
369 :     # Declare the return variable. If we do not find anything to put in it, the
370 :     # user will presume we've run out of features.
371 :     my $retVal;
372 :     # Get the query data object.
373 :     my $qData = $fquery->{queryData};
374 :     # Get the feature ID cache.
375 :     my $fidCache = $fquery->{fidCache};
376 :     # Insure we have a query.
377 :     my $query = $fquery->{currentQuery};
378 :     if (! defined($query)) {
379 :     $query = _GetNextQuery($qData);
380 :     }
381 :     Trace("Starting query loop.") if T(4);
382 :     # Loop until we find a feature or run out of queries.
383 :     while (! defined($retVal) && defined($query)) {
384 :     Trace("Starting fetch loop.") if T(4);
385 :     # Save a place to store the feature that comes back.
386 :     my $featureData;
387 :     while (! defined($retVal) && ($featureData = $query->Fetch())) {
388 :     # Only proceed if this feature is new.
389 :     my $fid = $featureData->PrimaryValue('Feature(id)');
390 :     Trace("Feature $fid found.") if T(4);
391 :     if (! $fidCache->{$fid}) {
392 :     # Make sure we don't check it again.
393 :     $fidCache->{$fid} = 1;
394 : parrello 1.2 # Return it.
395 :     $retVal = $featureData;
396 : parrello 1.1 }
397 :     }
398 :     # Check to see if we found a feature.
399 :     if (! defined($retVal)) {
400 :     # We did not, so we get the next query.
401 :     $query = _GetNextQuery($qData);
402 :     } else {
403 :     # We did, so save the query for the next call.
404 :     $fquery->{currentQuery} = $query;
405 :     }
406 :     }
407 :     # Return the result.
408 :     return $retVal;
409 :     }
410 :    
411 :     =head3 ValidParms
412 :    
413 : parrello 1.7 my $flag = $rhelp->ValidParms();
414 : parrello 1.1
415 :     Validate the filtering parameters for the current search request.
416 :    
417 :     This method returns TRUE if the filtering parameters are valid, and FALSE if
418 :     they're invalid. In the latter case, B<SetMessage> will have been called on the
419 :     search helper object to communicate the error message.
420 :    
421 :     =cut
422 :    
423 :     sub Valid {
424 :     # Get the parameters.
425 :     my ($self) = @_;
426 :     Trace("Validating filter parameters.") if T(3);
427 :     # Get the CGI object.
428 :     my $cgi = $self->Parent()->Q();
429 :     # Declare the return variable. We assume everything's fine, then set it to
430 :     # 0 if an error occurs. This enables us to flatten the IFs somewhat.
431 :     my $retVal = 1;
432 :     # The only validation we need to do here is for the keywords. We make use
433 :     # of the "wordSearch" field to find out if the client has specified that
434 :     # a keyword is required.
435 :     my $keywords = $cgi->param('keywords') || "";
436 :     if (! $self->ValidateKeywords($keywords, $self->{wordSearch})) {
437 :     $retVal = 0;
438 :     }
439 :     Trace("Validation result is $retVal.") if T(3);
440 :     # Return the result.
441 :     return $retVal;
442 :     }
443 :    
444 :     =head3 ValidateKeywords
445 :    
446 : parrello 1.7 my $okFlag = $rhelp->ValidateKeywords($keywordString, $required);
447 : parrello 1.1
448 :     Insure that a keyword string is reasonably valid. If it is invalid, a message will be
449 :     set.
450 :    
451 :     =over 4
452 :    
453 :     =item keywordString
454 :    
455 :     Keyword string specified as a parameter to the current search.
456 :    
457 :     =item required
458 :    
459 :     TRUE if there must be at least one keyword specified, else FALSE.
460 :    
461 :     =item RETURN
462 :    
463 :     Returns TRUE if the keyword string is valid, else FALSE. Note that a null keyword string
464 :     is acceptable if the I<$required> parameter is not specified.
465 :    
466 :     =back
467 :    
468 :     =cut
469 :    
470 :     sub ValidateKeywords {
471 :     # Get the parameters.
472 :     my ($self, $keywordString, $required) = @_;
473 :     # Get the parent search helper.
474 :     my $shelp = $self->Parent();
475 :     # Declare the return variable.
476 :     my $retVal = 0;
477 :     my @wordList = split /\s+/, $keywordString;
478 :     # Right now our only real worry is a list of all minus words. The problem with it is that
479 :     # it will return an incorrect result.
480 :     my @plusWords = grep { $_ =~ /^[^\-]/ } @wordList;
481 :     if (! @wordList) {
482 :     if ($required) {
483 :     $shelp->SetMessage("No search words specified.");
484 :     } else {
485 :     $retVal = 1;
486 :     }
487 :     } elsif (! @plusWords) {
488 :     $shelp->SetMessage("At least one keyword must be positive. All the keywords entered are preceded by minus signs.");
489 :     } else {
490 :     $retVal = 1;
491 :     }
492 :     # Return the result.
493 :     return $retVal;
494 :     }
495 :    
496 :     =head3 CheckSubsystem
497 :    
498 : parrello 1.7 my $flag = $fquery->CheckSubsystem($featureData);
499 : parrello 1.1
500 :     Determine whether or not the specified feature is in the correct subsystem.
501 :     This method will return TRUE if we pass the test, else FALSE.
502 :    
503 :     =over 4
504 :    
505 :     =item featureData
506 :    
507 :     B<ERDBObject> for the feature to check.
508 :    
509 :     =item RETURN
510 :    
511 :     Returns TRUE if the feature is in the correct subsystem, else FALSE.
512 :    
513 :     =back
514 :    
515 :     =cut
516 :    
517 :     sub CheckSubsystem {
518 :     # Get the parameters.
519 :     my ($self, $featureData) = @_;
520 :     # Get the CGI query object.
521 :     my $cgi = $self->Parent()->Q();
522 :     # Declare the return variable.
523 :     my $retVal;
524 :     # Check to see if we're filtering by subsystem.
525 :     my $subsystem = $cgi->param('subsystem') || "(all)";
526 :     if ($subsystem eq '(all)') {
527 :     # Not filtering, so we pass automatically.
528 :     $retVal = 1;
529 :     } else {
530 :     # Here we're filtering. Check to see if the query is filtering for us.
531 :     if ($featureData->HasField('HasRoleInSubsystem(to-link)')) {
532 :     my ($mySubsystem) = $featureData->Value('HasRoleInSubsystem(to-link)');
533 :     if ($mySubsystem && $subsystem eq $mySubsystem) {
534 :     # Yes it is, so pass automatically.
535 :     $retVal = 1;
536 :     }
537 :     }
538 :     if (! $retVal) {
539 :     # Now we have to check by querying the database.
540 :     my $sprout = $self->DB();
541 :     my ($mySubsystem) = $sprout->GetFlat(['HasRoleInSubsystem'],
542 :     "HasRoleInSubsystem(to-link) = ? AND HasRoleInSubsystem(from-link) = ?",
543 :     [$subsystem, $self->FID()],
544 :     'HasRoleInSubsystem(to-link)');
545 :     if ($mySubsystem) {
546 :     $retVal = 1;
547 :     } else {
548 :     $retVal = 0;
549 :     }
550 :     }
551 :     }
552 :     # Return the result.
553 :     return $retVal;
554 :     }
555 :    
556 :     =head3 CheckFeature
557 :    
558 : parrello 1.7 my $okFlag = $rhelp->CheckFeature($feature);
559 : parrello 1.1
560 :     Determine whether or not the specified feature fulfills all the requirements of
561 :     this result helper's active filters. This is an expensive method, so only use
562 :     it if you are filtering something fairly small.
563 :    
564 :     =over 4
565 :    
566 :     =item feature
567 :    
568 :     B<ERDBObject> for the feature to examine.
569 :    
570 :     =item RETURN
571 :    
572 :     Returns TRUE if the feature satisfies all our conditions, else FALSE.
573 :    
574 :     =back
575 :    
576 :     =cut
577 :    
578 :     sub CheckFeature {
579 :     # Get the parameters.
580 :     my ($self, $feature) = @_;
581 :     # Get the CGI query and database objects.
582 :     my $shelp = $self->Parent();
583 :     my $cgi = $shelp->Q();
584 :     my $sprout = $shelp->DB();
585 :     # The first condition we require is a matching subsystem.
586 :     my $retVal = $self->CheckSubsystem($feature);
587 :     # If we match the subsystem, we need to check the keywords.
588 :     my $keywords = $cgi->param('keywords') || '';
589 :     if ($retVal && $keywords) {
590 :     # Build a new query that will return a result only if the feature passes the keyword text.
591 :     my $query = $sprout->Search($keywords, 0, ['Feature'], 'Feature(id) = ?',
592 :     [$feature->PrimaryValue('Feature(id)')]);
593 :     # If the query could not find a result, return FALSE.
594 :     if (! $query->Fetch()) {
595 :     $retVal = 0;
596 :     }
597 :     }
598 :     # Return the result.
599 :     return $retVal;
600 :     }
601 :    
602 :     =head3 _GetNextQuery
603 :    
604 : parrello 1.7 my $query = RHFeatures::_GetNextQuery($qData);
605 : parrello 1.1
606 :     Get the next query for retrieving features. This method should only be used internally.
607 :    
608 :     Currently, we have a single query. This may not always be the case, in which instance
609 :     this method will need to return multiple queries in sequence.
610 :    
611 :     =over 4
612 :    
613 :     =item qData
614 :    
615 :     Current query data object.
616 :    
617 :     =item RETURN
618 :    
619 :     Returns a B<DBQuery> object for the current feature query, or C<undef> if there are no
620 :     more queries to make.
621 :    
622 :     =back
623 :    
624 :     =cut
625 :    
626 :     sub _GetNextQuery {
627 :     # Get the parameters.
628 :     my ($qData) = @_;
629 :     # Declare the return variable.
630 :     my $retVal;
631 :     # Since there's only one query per request, we fail if this method is called
632 :     # twice.
633 :     if ($qData->{count} == 0) {
634 :     $qData->{count}++;
635 :     # Get the sprout object.
636 :     my $sprout = $qData->{sprout};
637 :     # The type of query is dependent on whether or not a keyword search
638 :     # is involved.
639 :     if (exists $qData->{keywords}) {
640 :     Trace("Query is for a full-text search.") if T(3);
641 :     $retVal = $sprout->Search($qData->{keywords}, $qData->{findex}, $qData->{tables},
642 :     $qData->{filter}, $qData->{params});
643 :     } else {
644 :     $retVal = $sprout->Get($qData->{tables}, $qData->{filter}, $qData->{params});
645 :     }
646 :     Trace("Query created.") if T(3);
647 :     } else {
648 :     Trace("Last query processed.") if T(3);
649 :     }
650 :     # Return the result.
651 :     return $retVal;
652 :     }
653 :    
654 :     =head3 AdditionalColumns
655 :    
656 : parrello 1.7 my @cols = $rhelp->AdditionalColumns();
657 : parrello 1.1
658 :     Return any additional columns that should be included in the feature display.
659 :     The columns returned will be standard columns, not extra columns particular
660 :     to the search. This method is required to support the extra columns mandated
661 :     by the feature filter options row as well as extra columns that may be mandated
662 :     by keywords.
663 :    
664 :     =cut
665 :    
666 :     sub AdditionalColumns {
667 :     # Get the parameters.
668 :     my ($self) = @_;
669 :     # Get the CGI query object and the sprout database.
670 :     my $shelp = $self->Parent();
671 :     my $cgi = $shelp->Q();
672 :     my $sprout = $shelp->DB();
673 :     # Get the return value.
674 :     my @retVal = ();
675 :     # Check for additional columns. If the feature filter form was not used,
676 :     # these if-conditions will automatically be FALSE.
677 :     if ($cgi->param('ShowAliases')) {
678 :     push @retVal, 'alias';
679 :     }
680 :     # We look for the special attribute keywords here. First, we get the special
681 :     # field list for features.
682 :     my %specialHash = $sprout->SpecialFields('Feature');
683 :     Trace("Special words are: " . join(" ", keys %specialHash) . ".") if T(3);
684 :     # Get the incoming keyword list.
685 :     my $keywordString = $cgi->param('keywords');
686 :     if ($keywordString) {
687 :     # Okay, we have a keyword list here. Parse out the positive words.
688 :     my @goodWords = ERDB::SplitKeywords($keywordString);
689 :     Trace("Good words from the keyword list are: " . join(" ", @goodWords) . ".") if T(3);
690 :     # Loop through them, checking for specials. (Note that in general,
691 :     # the keyword list will contain only one or two words, so we're
692 :     # faster cycling through it instead of cycling through the specials.)
693 :     for my $word (@goodWords) {
694 :     if ($specialHash{$word} eq 'property_search') {
695 :     push @retVal, "keyword:$word";
696 :     }
697 :     }
698 :     }
699 :     Trace("Returning from AdditionalColumns. " . scalar(@retVal) . " columns found.") if T(3);
700 :     # Return the result.
701 :     return @retVal;
702 :     }
703 :    
704 :     =head3 SortKey
705 :    
706 : parrello 1.7 my $key = $rhelp->SortKey($feature, $datum);
707 : parrello 1.1
708 :     Return the sort key for the specified feature. The sort key is normally a
709 :     thing created from the group name, but it can be overridden by options
710 :     on the form generated by the feature query. For example, if a keyword
711 :     search is being used, the search relevance takes precedence over everything
712 :     but whether or not the feature is an NMPDR feature. If the user asked
713 :     to sort the features by functional assignment, that would take precedence
714 :     as well.
715 :    
716 :     =over 4
717 :    
718 :     =item feature
719 :    
720 :     ERDB object for the feature to be sorted.
721 :    
722 :     =item datum
723 :    
724 :     A string to be prefixed to the sort key. If the sort is being overriden
725 :     by the search options, the overriding key will precede this value;
726 :     otherwise, this value precedes all other sort key data.
727 :    
728 :     =item RETURN
729 :    
730 :     Returns a string that can be used to sort the specified feature into the
731 :     correct position, or that can be suffixed to an existing key.
732 :    
733 :     =back
734 :    
735 :     =cut
736 :    
737 :     sub SortKey {
738 :     # Get the parameters.
739 :     my ($self, $feature, $datum) = @_;
740 :     # Insure we have a datum value.
741 :     my $realDatum = (defined($datum) ? $datum : "");
742 :     # Get the CGI query object and the parent search helper.
743 :     my $shelp = $self->Parent();
744 :     my $cgi = $shelp->Q();
745 :     my $sprout = $shelp->DB();
746 :     # Get the feature ID.
747 :     my $fid = $feature->PrimaryValue('Feature(id)');
748 :     # Get the organism data.
749 :     my $genomeID = $sprout->GenomeOf($fid);
750 :     my ($orgName, $group) = $shelp->OrganismData($genomeID);
751 :     # Start the sort key with an "A" for an NMPDR genome and a "Z" otherwise.
752 :     my $retVal = ($group ? "A" : "Z");
753 :     # Check for keyword filtering.
754 :     if ($feature->HasField('Feature(search-relevance)')) {
755 :     # If there's keyword filtering, then search relevance is a factor.
756 :     my $relevance = $feature->PrimaryValue('Feature(search-relevance)');
757 :     # We need to normalize it so it works in a character-based sort. We
758 :     # also need to invert it so that a higher relevance sorts to the top.
759 :     my $relevanceString = sprintf("%0.3f", 9999 - $relevance);
760 :     $relevanceString = " $relevanceString" while length($relevanceString) < 11;
761 :     # Now we add it to the sort key.
762 :     $retVal .= $relevanceString;
763 :     }
764 :     # Add the organism name and feature ID.
765 :     $retVal .= "[$orgName $fid]";
766 :     # Prefix the incoming datum.
767 :     $retVal = "$datum $retVal";
768 :     # Check for functional role sorting. If the caller is not using any feature filtering,
769 :     # the following condition will automatically be FALSE and functional role sorting will
770 :     # not be used.
771 :     if ($cgi->param('FunctionSort')) {
772 :     # Here the user wants to sort by function. We put the functional
773 :     # assignment before the sort key.
774 :     $retVal = $feature->PrimaryValue('Feature(assignment)') . $retVal;
775 :     }
776 :     # Return the result.
777 :     return $retVal;
778 :     }
779 :    
780 :     =head2 Virtual Overrides
781 :    
782 :     =head3 DefaultResultColumns
783 :    
784 : parrello 1.7 my @colNames = $rhelp->DefaultResultColumns();
785 : parrello 1.1
786 :     Return a list of the default columns to be used by searches with this
787 :     type of result. Note that the actual default columns are computed by
788 :     the search helper. This method is only needed if the search helper doesn't
789 :     care.
790 :    
791 :     The columns returned should be in the form of column names, all of which
792 :     must be defined by the result helper class.
793 :    
794 :     =cut
795 :    
796 :     sub DefaultResultColumns {
797 :     # Get the parameters.
798 :     my ($self) = @_;
799 :     # Start with the standard columns.
800 : parrello 1.9 my @retVal = qw(orgName fid function svLink subsystem);
801 : parrello 1.1 # Add the optional columns.
802 :     push @retVal, $self->AdditionalColumns();
803 :     # Return the result.
804 :     return @retVal;
805 :     }
806 :    
807 :     =head3 MoreDownloadFormats
808 :    
809 : parrello 1.7 $rhelp->MoreDownloadFormats(\%dlTypes);
810 : parrello 1.1
811 :     Add additional supported download formats to the type table. The table is a
812 :     hash keyed on the download type code for which the values are the download
813 :     descriptions. There is a special syntax that allows the placement of text
814 :     fields inside the description. Use square brackets containing the name
815 :     for the text field. The field will come in to the download request as
816 :     a GET-type field.
817 :    
818 :     =over 4
819 :    
820 :     =item dlTypes
821 :    
822 :     Reference to a download-type hash. The purpose of this method is to add more
823 :     download types relevant to the particular result type. Each type is described
824 :     by a key (the download type itself) and a description. The description can
825 :     contain a single text field that may be used to pass a parameter to the
826 :     download. The text field is of the format C<[>I<fieldName>C<]>,
827 :     where I<fieldName> is the name to give the text field's parameter in the
828 :     generated download URL.
829 :    
830 :     =back
831 :    
832 :     =cut
833 :    
834 :     sub MoreDownloadFormats {
835 :     # Get the parameters.
836 :     my ($self, $dlTypes) = @_;
837 :     Trace("Adding download formats for feature helper.") if T(3);
838 :     # Add a download type for FASTA.
839 : parrello 1.4 $dlTypes->{fasta} = "DNA FASTA sequences of all results including [flank]nt flanking sequence";
840 :     $dlTypes->{pfasta} = "Protein FASTA sequences of all results";
841 : parrello 1.1 }
842 :    
843 :     =head3 MoreDownloadDataMethods
844 :    
845 : parrello 1.7 my @lines = $rhelp->MoreDownloadDataMethods($objectID, $dlType, \@cols, \@colHdrs);
846 : parrello 1.1
847 :     Create one or more lines of download data for a download of the specified type. Override
848 :     this method if you need to process more download types than the default C<tbl> method.
849 :    
850 :     =over 4
851 :    
852 :     =item objectID
853 :    
854 :     ID of the object for this data row.
855 :    
856 :     =item dlType
857 :    
858 :     Download type (e.g. C<fasta>, etc.)
859 :    
860 :     =item cols
861 :    
862 :     Reference to a list of the data columns from the result cache, or alternatively
863 :     the string C<header> (indicating that header lines are desired) or C<footer>
864 :     (indicating that footer lines are desired).
865 :    
866 :     =item colHdrs
867 :    
868 :     The list of column headers from the result cache.
869 :    
870 :     =item RETURN
871 :    
872 :     Returns an array of data lines to output to the download file.
873 :    
874 :     =back
875 :    
876 :     =cut
877 :    
878 :     sub MoreDownloadDataMethods {
879 :     # Get the parameters.
880 :     my ($self, $objectID, $dlType, $cols, $colHdrs) = @_;
881 :     # Declare the return variable.
882 :     my @retVal;
883 :     # Check the download type.
884 : parrello 1.4 if ($dlType eq 'fasta' || $dlType eq 'pfasta') {
885 :     # The FASTA downloads do not have headers or footers, so we only
886 :     # process if we have a real ID. A real ID has an array of columns
887 :     # passed with it, which is what we check.
888 : parrello 1.1 if (ref $cols eq 'ARRAY') {
889 : parrello 1.4 # Okay, here we have a real ID to download. The two types of
890 :     # fasta sequences are computed almost identically. First, we need
891 :     # the flanking width from the CGI parameters. The default is 0. The
892 :     # protein FASTA does not have flanking data, so it will always
893 :     # use the default.
894 : parrello 1.1 my $cgi = $self->Parent()->Q();
895 :     my $flankingWidth = $cgi->param('flank') || 0;
896 :     # Get the parent search helper.
897 :     my $shelp = $self->Parent();
898 : parrello 1.4 # Compute the fasta type.
899 :     my $type = ($dlType eq 'fasta' ? 'dna' : 'prot');
900 : parrello 1.1 # Ask it for the fasta data.
901 : parrello 1.4 my $fasta = $shelp->ComputeFASTA($type => $objectID, $flankingWidth);
902 : parrello 1.1 # Break it into lines.
903 :     @retVal = split(/\n/, $fasta);
904 :     } else {
905 :     Trace("Header/footer line skipped.") if T(3);
906 :     }
907 :     } else {
908 : parrello 1.4 # Here the download type is not one we recognize.
909 : parrello 1.1 Confess("Invalid download type \"$dlType\" specified for result class $self->{type}.");
910 :     }
911 :     # Return the output.
912 :     return @retVal;
913 :     }
914 :    
915 :     =head2 Utility Methods
916 :    
917 :     =head3 CurrentFeature
918 :    
919 : parrello 1.7 my $featureRecord = $rhelp->CurrentFeature($fid);
920 : parrello 1.1
921 :     Return the feature record for the specified feature. If the feature record
922 :     is already cached, we'll use the cache value; otherwise, we will pull in the
923 :     feature record from the database.
924 :    
925 :     =over 4
926 :    
927 :     =item fid
928 :    
929 :     Current feature's ID.
930 :    
931 :     =item RETURN
932 :    
933 :     Returns an B<ERDBObject> for the specified feature.
934 :    
935 :     =back
936 :    
937 :     =cut
938 :    
939 :     sub CurrentFeature {
940 :     # Get the parameters.
941 :     my ($self, $fid) = @_;
942 :     # Check the cache.
943 :     my $cache = $self->Cache();
944 :     my $retVal = $cache->{feature};
945 :     # If the cache is empty, read the feature from the database.
946 :     if (! defined($retVal)) {
947 :     my $sprout = $self->DB();
948 :     $retVal = $sprout->GetEntity(Feature => $fid);
949 :     # Put it in the cache for future use.
950 :     $cache->{feature} = $retVal;
951 :     }
952 :     # Return the feature.
953 :     return $retVal;
954 :     }
955 :    
956 :     =head2 Column Methods
957 :    
958 :     =head3 alias
959 :    
960 : parrello 1.7 my $colDatum = RHFeatures::alias($type => $rhelp, $key);
961 : parrello 1.1
962 :     This method computes the various things we need to know into order to process
963 :     the alias column.
964 :    
965 :     =over 4
966 :    
967 :     =item type
968 :    
969 :     Type of data about the column that is required: C<title> for the column title,
970 :     C<download> for the download flag, and so forth.
971 :    
972 :     =item rhelp
973 :    
974 :     Result helper being used to format the search output.
975 :    
976 :     =item key (optional)
977 :    
978 :     The key to be used to compute a run-time value.
979 :    
980 :     =item RETURN
981 :    
982 :     Returns the desired information about the alias column.
983 :    
984 :     =back
985 :    
986 :     =cut
987 :    
988 :     sub alias {
989 :     # Get the parameters.
990 :     my ($type, $rhelp, $key) = @_;
991 :     # Declare the return variable.
992 :     my $retVal;
993 :     # Process according to the information requested.
994 :     if ($type eq 'title') {
995 :     # Return the title for this column.
996 :     $retVal = 'External Aliases';
997 :     } elsif ($type eq 'download') {
998 :     # This field should be included in a download.
999 :     $retVal = 'list';
1000 :     } elsif ($type eq 'style') {
1001 :     # Here the caller wants the style class used to format this column.
1002 :     $retVal = 'leftAlign';
1003 :     } elsif ($type eq 'value') {
1004 : parrello 1.3 # Aliases are expensive to load, so we ask for a runtime value.
1005 :     # We need the feature ID and the favored alias type.
1006 :     my $cgi = $rhelp->Parent()->Q();
1007 :     my $favored = $cgi->param('FavoredAlias') || '';
1008 :     my $fid = $rhelp->ID();
1009 :     $retVal = "%%alias=$fid/$favored";
1010 : parrello 1.1 } elsif ($type eq 'runTimeValue') {
1011 :     # Get the Sprout database object.
1012 :     my $sprout = $rhelp->DB();
1013 : parrello 1.3 # Split the feature ID and the favored alias prefix.
1014 :     my ($fid, $favored) = split('/', $key);
1015 : parrello 1.1 # Get the aliases for the specified feature.
1016 : parrello 1.3 my @aliases = $sprout->FeatureAliases($fid);
1017 :     # Is there a favored alias?
1018 :     if ($favored) {
1019 :     # Yes, so we have to sort the favored aliases to the beginning.
1020 :     my @favors = ();
1021 :     my @other = ();
1022 :     my $len = length $favored;
1023 :     my $lcFavored = lc $favored;
1024 :     # Separate the favored aliases from the others.
1025 :     for my $alias (@aliases) {
1026 :     if (lc(substr($alias, 0, $len)) eq $lcFavored) {
1027 :     push @favors, $alias;
1028 :     } else {
1029 :     push @other, $alias;
1030 :     }
1031 :     }
1032 :     # Put them back together.
1033 :     @aliases = (@favors, @other);
1034 :     }
1035 : parrello 1.1 # Format them into a comma-separated list with URLs where appropriate.
1036 :     $retVal = AliasAnalysis::FormatHtml(@aliases);
1037 :     }
1038 :     return $retVal;
1039 :     }
1040 :    
1041 :     =head3 subsystem
1042 :    
1043 : parrello 1.7 my $colDatum = RHFeatures::subsystem($type => $rhelp, $key);
1044 : parrello 1.1
1045 :     This method computes the various things we need to know into order to process
1046 :     the subsystem column.
1047 :    
1048 :     =over 4
1049 :    
1050 :     =item type
1051 :    
1052 :     Type of data about the column that is required: C<title> for the column title,
1053 :     C<download> for the download flag, and so forth.
1054 :    
1055 :     =item rhelp
1056 :    
1057 :     Result helper being used to format the search output.
1058 :    
1059 :     =item key (optional)
1060 :    
1061 :     The key to be used to compute a run-time value.
1062 :    
1063 :     =item RETURN
1064 :    
1065 :     Returns the desired information about the subsystem column.
1066 :    
1067 :     =back
1068 :    
1069 :     =cut
1070 :    
1071 :     sub subsystem {
1072 :     # Get the parameters.
1073 :     my ($type, $rhelp, $key) = @_;
1074 :     # Declare the return variable.
1075 :     my $retVal;
1076 :     # Process according to the information requested.
1077 :     if ($type eq 'title') {
1078 :     # Return the title for this column.
1079 :     $retVal = 'Subsystems';
1080 :     } elsif ($type eq 'download') {
1081 :     # This field should be included in a download.
1082 :     $retVal = 'list';
1083 :     } elsif ($type eq 'style') {
1084 :     # Here the caller wants the style class used to format this column.
1085 :     $retVal = 'leftAlign';
1086 :     } elsif ($type eq 'value') {
1087 :     # Ask for a runtime value. Subsystems are expensive to load.
1088 :     $retVal = '%%subsystem=' . $rhelp->ID();
1089 :     } elsif ($type eq 'runTimeValue') {
1090 :     # Get the Sprout database object.
1091 :     my $sprout = $rhelp->DB();
1092 : parrello 1.4 # Get the genome ID for this peg.
1093 :     my $genomeID = $sprout->GenomeOf($key);
1094 : parrello 1.1 # Get the CGI query object.
1095 :     my $cgi = $rhelp->Parent()->Q();
1096 :     # Get the subsystems for the specified feature.
1097 :     my @subsystems = $sprout->SubsystemList($key);
1098 :     # Convert them to hyperlinks.
1099 : parrello 1.4 my @links = map { HTML::sub_link($cgi, $_, $genomeID) } @subsystems;
1100 : parrello 1.1 # String them together.
1101 :     $retVal = join(", ", @links);
1102 :     }
1103 :     return $retVal;
1104 :     }
1105 :    
1106 :     =head3 relevance
1107 :    
1108 : parrello 1.7 my $colDatum = RHFeatures::relevance($type => $rhelp, $key);
1109 : parrello 1.1
1110 :     This method computes the various things we need to know into order to process
1111 :     the relevance column.
1112 :    
1113 :     =over 4
1114 :    
1115 :     =item type
1116 :    
1117 :     Type of data about the column that is required: C<title> for the column title,
1118 :     C<download> for the download flag, and so forth.
1119 :    
1120 :     =item rhelp
1121 :    
1122 :     Result helper being used to format the search output.
1123 :    
1124 :     =item key (optional)
1125 :    
1126 :     The key to be used to compute a run-time value.
1127 :    
1128 :     =item RETURN
1129 :    
1130 :     Returns the desired information about the relevance column.
1131 :    
1132 :     =back
1133 :    
1134 :     =cut
1135 :    
1136 :     sub relevance {
1137 :     # Get the parameters.
1138 :     my ($type, $rhelp, $key) = @_;
1139 :     # Declare the return variable.
1140 :     my $retVal;
1141 :     # Process according to the information requested.
1142 :     if ($type eq 'title') {
1143 :     # Return the title for this column.
1144 :     $retVal = 'Relevance';
1145 :     } elsif ($type eq 'download') {
1146 :     # This field should be included in a download.
1147 :     $retVal = 'num';
1148 :     } elsif ($type eq 'style') {
1149 :     # Here the caller wants the style class used to format this column.
1150 :     $retVal = 'rightAlign';
1151 :     } elsif ($type eq 'value') {
1152 :     # Get the current record.
1153 :     my $record = $rhelp->Record();
1154 :     # Extract the search relevance.
1155 :     my $relevance = $record->PrimaryValue('Feature(search-relevance)');
1156 :     # Now we need to format it.
1157 :     $retVal = sprintf("%0.3f", $relevance);
1158 :     } elsif ($type eq 'runTimeValue') {
1159 :     # Runtime support is not needed for this column.
1160 :     }
1161 :     return $retVal;
1162 :     }
1163 :    
1164 :     =head3 keyword
1165 :    
1166 : parrello 1.7 my $colDatum = RHFeatures::keyword($type => $rhelp, $key);
1167 : parrello 1.1
1168 :     This method computes the various things we need to know into order to process
1169 :     the keyword column. The keyword column name contains the keyword ID as
1170 :     part of the name, so when we are processing a search, the runtime value will
1171 :     be the keyword ID, and when are displaying results, the runtime value will
1172 :     be the keyword ID, a slash, and then the feature ID.
1173 :    
1174 :     =over 4
1175 :    
1176 :     =item type
1177 :    
1178 :     Type of data about the column that is required: C<title> for the column title,
1179 :     C<download> for the download flag, and so forth.
1180 :    
1181 :     =item rhelp
1182 :    
1183 :     Result helper being used to format the search output.
1184 :    
1185 :     =item key (optional)
1186 :    
1187 :     The key to be used to compute a run-time value, or the name of the keyword.
1188 :    
1189 :     =item RETURN
1190 :    
1191 :     Returns the desired information about the keyword column.
1192 :    
1193 :     =back
1194 :    
1195 :     =cut
1196 :    
1197 :     sub keyword {
1198 :     # Get the parameters.
1199 :     my ($type, $rhelp, $key) = @_;
1200 :     # Declare the return variable.
1201 :     my $retVal;
1202 :     # Process according to the information requested.
1203 :     if ($type eq 'title') {
1204 :     # Return the title for this column.
1205 :     $retVal = ucfirst $key;
1206 :     } elsif ($type eq 'download') {
1207 :     # This field should be included in a download.
1208 :     $retVal = 'list';
1209 :     } elsif ($type eq 'style') {
1210 :     # Here the caller wants the style class used to format this column.
1211 :     $retVal = 'leftAlign';
1212 :     } elsif ($type eq 'value') {
1213 :     # Getting special attribute columns is expensive, because they're multi-valued,
1214 :     # so we do this at run-time.
1215 :     $retVal = "%%keyword=$key/" . $rhelp->ID();
1216 :     } elsif ($type eq 'runTimeValue') {
1217 :     # Here the caller wants the value of the named keyword. The text is the
1218 :     # keyword ID followed by the feature ID with an intervening slash.
1219 :     $key =~ /^([^\/]+)\/(.+)/;
1220 :     my $keywordName = $1;
1221 :     my $fid = $2;
1222 :     # Get the sprout database object.
1223 :     my $sprout = $rhelp->DB();
1224 :     # Get the attribute values.
1225 :     Trace("Getting $keywordName values for feature $fid.") if T(4);
1226 :     my @values = $sprout->GetFlat(['Feature'], "Feature(id) = ?", [$fid],
1227 :     "Feature($keywordName)");
1228 :     # String them into a list.
1229 :     $retVal = join(", ", @values);
1230 :     }
1231 :     return $retVal;
1232 :     }
1233 :    
1234 :     =head3 orgName
1235 :    
1236 : parrello 1.7 my $colDatum = RHFeatures::orgName($type => $rhelp, $key);
1237 : parrello 1.1
1238 :     This method computes the various things we need to know into order to process
1239 :     the orgName column.
1240 :    
1241 :     =over 4
1242 :    
1243 :     =item type
1244 :    
1245 :     Type of data about the column that is required: C<title> for the column title,
1246 :     C<download> for the download flag, and so forth.
1247 :    
1248 :     =item rhelp
1249 :    
1250 :     Result helper being used to format the search output.
1251 :    
1252 :     =item key (optional)
1253 :    
1254 :     The key to be used to compute a run-time value.
1255 :    
1256 :     =item RETURN
1257 :    
1258 :     Returns the desired information about the orgName column.
1259 :    
1260 :     =back
1261 :    
1262 :     =cut
1263 :    
1264 :     sub orgName {
1265 :     # Get the parameters.
1266 :     my ($type, $rhelp, $key) = @_;
1267 :     # Declare the return variable.
1268 :     my $retVal;
1269 :     # Process according to the information requested.
1270 :     if ($type eq 'title') {
1271 :     # Return the title for this column.
1272 :     $retVal = 'Organism Name';
1273 :     } elsif ($type eq 'download') {
1274 :     # This field should be included in a download.
1275 :     $retVal = 'text';
1276 :     } elsif ($type eq 'style') {
1277 :     # Here the caller wants the style class used to format this column.
1278 :     $retVal = 'leftAlign';
1279 :     } elsif ($type eq 'value') {
1280 :     # Get the Sprout database object.
1281 :     my $sprout = $rhelp->DB();
1282 :     # Get the feature ID.
1283 :     my $fid = $rhelp->ID();
1284 :     # Get the feature's genome ID.
1285 :     my $genomeID = $sprout->GenomeOf($fid);
1286 :     # Extract the organism name from the search helper.
1287 :     my $shelp = $rhelp->Parent();
1288 :     $retVal = $shelp->Organism($genomeID);
1289 : parrello 1.3 # Check to see if we're showing FIG IDs or another
1290 :     # type.
1291 : parrello 1.5 my $aliasType = $shelp->GetPreferredAliasType();
1292 :     if ($aliasType ne 'FIG') {
1293 : parrello 1.3 # We're showing non-FIG IDs, so we include the FIG ID in the
1294 :     # organism name.
1295 :     $retVal .= " [$fid]";
1296 :     }
1297 : parrello 1.1 } elsif ($type eq 'runTimeValue') {
1298 :     # Runtime support is not needed for this column.
1299 :     }
1300 :     return $retVal;
1301 :     }
1302 :    
1303 :     =head3 fid
1304 :    
1305 : parrello 1.7 my $colDatum = RHFeatures::fid($type => $rhelp, $key);
1306 : parrello 1.1
1307 :     This method computes the various things we need to know into order to process
1308 :     the fid column.
1309 :    
1310 :     =over 4
1311 :    
1312 :     =item type
1313 :    
1314 :     Type of data about the column that is required: C<title> for the column title,
1315 :     C<download> for the download flag, and so forth.
1316 :    
1317 :     =item rhelp
1318 :    
1319 :     Result helper being used to format the search output.
1320 :    
1321 :     =item key (optional)
1322 :    
1323 :     The key to be used to compute a run-time value.
1324 :    
1325 :     =item RETURN
1326 :    
1327 :     Returns the desired information about the fid column.
1328 :    
1329 :     =back
1330 :    
1331 :     =cut
1332 :    
1333 :     sub fid {
1334 :     # Get the parameters.
1335 :     my ($type, $rhelp, $key) = @_;
1336 :     # Declare the return variable.
1337 :     my $retVal;
1338 :     # Process according to the information requested.
1339 :     if ($type eq 'title') {
1340 :     # Return the title for this column.
1341 :     $retVal = 'Gene';
1342 :     } elsif ($type eq 'download') {
1343 :     # This field should be included in a download.
1344 :     $retVal = 'text';
1345 :     } elsif ($type eq 'style') {
1346 :     # Here the caller wants the style class used to format this column.
1347 :     $retVal = 'leftAlign';
1348 :     } elsif ($type eq 'value') {
1349 :     # Because this may involve aliases, we compute the feature ID at run-time.
1350 :     $retVal = "%%fid=" . $rhelp->ID();
1351 :     } elsif ($type eq 'runTimeValue') {
1352 :     # Get the feature object from the database or the cache.
1353 :     my $feature = $rhelp->CurrentFeature($key);
1354 :     # Ask for the preferred ID.
1355 :     $retVal = $rhelp->PreferredID($feature);
1356 :     }
1357 :     return $retVal;
1358 :     }
1359 :    
1360 :     =head3 function
1361 :    
1362 : parrello 1.7 my $colDatum = RHFeatures::function($type => $rhelp, $key);
1363 : parrello 1.1
1364 :     This method computes the various things we need to know into order to process
1365 :     the function column.
1366 :    
1367 :     =over 4
1368 :    
1369 :     =item type
1370 :    
1371 :     Type of data about the column that is required: C<title> for the column title,
1372 :     C<download> for the download flag, and so forth.
1373 :    
1374 :     =item rhelp
1375 :    
1376 :     Result helper being used to format the search output.
1377 :    
1378 :     =item key (optional)
1379 :    
1380 :     The key to be used to compute a run-time value.
1381 :    
1382 :     =item RETURN
1383 :    
1384 :     Returns the desired information about the function column.
1385 :    
1386 :     =back
1387 :    
1388 :     =cut
1389 :    
1390 :     sub function {
1391 :     # Get the parameters.
1392 :     my ($type, $rhelp, $key) = @_;
1393 :     # Declare the return variable.
1394 :     my $retVal;
1395 :     # Process according to the information requested.
1396 :     if ($type eq 'title') {
1397 :     # Return the title for this column.
1398 :     $retVal = 'Functional Assignment';
1399 :     } elsif ($type eq 'download') {
1400 :     # This field should be included in a download.
1401 :     $retVal = 'text';
1402 :     } elsif ($type eq 'style') {
1403 :     # Here the caller wants the style class used to format this column.
1404 :     $retVal = 'leftAlign';
1405 :     } elsif ($type eq 'value') {
1406 :     # Get the current record.
1407 :     my $feature = $rhelp->Record();
1408 :     # Extract the functional role.
1409 :     $retVal = $feature->PrimaryValue('Feature(assignment)');
1410 :     } elsif ($type eq 'runTimeValue') {
1411 :     # Runtime support is not needed for this column.
1412 :     }
1413 :     return $retVal;
1414 :     }
1415 :    
1416 : parrello 1.9 =head3 svLink
1417 : parrello 1.1
1418 : parrello 1.9 my $colDatum = RHFeatures::svLink($type => $rhelp, $key);
1419 : parrello 1.1
1420 :     This method computes the various things we need to know into order to process
1421 : parrello 1.9 the SeedViewer link column. Currently, this takes us to the Seed Viewer's
1422 : parrello 1.8 feature page.
1423 : parrello 1.1
1424 :     =over 4
1425 :    
1426 :     =item type
1427 :    
1428 :     Type of data about the column that is required: C<title> for the column title,
1429 :     C<download> for the download flag, and so forth.
1430 :    
1431 :     =item rhelp
1432 :    
1433 :     Result helper being used to format the search output.
1434 :    
1435 :     =item key (optional)
1436 :    
1437 :     The key to be used to compute a run-time value.
1438 :    
1439 :     =item RETURN
1440 :    
1441 :     Returns the desired information about the gblink column.
1442 :    
1443 :     =back
1444 :    
1445 :     =cut
1446 :    
1447 : parrello 1.9 sub svLink {
1448 : parrello 1.1 # Get the parameters.
1449 :     my ($type, $rhelp, $key) = @_;
1450 :     # Declare the return variable.
1451 :     my $retVal;
1452 :     # Process according to the information requested.
1453 :     if ($type eq 'title') {
1454 :     # Return the title for this column.
1455 : parrello 1.6 $retVal = 'Viewer';
1456 : parrello 1.1 } elsif ($type eq 'download') {
1457 :     # This field should not be included in a download.
1458 :     $retVal = '';
1459 :     } elsif ($type eq 'style') {
1460 :     # Here the caller wants the style class used to format this column.
1461 :     $retVal = 'center';
1462 :     } elsif ($type eq 'value') {
1463 :     # Here we want a link to the GBrowse page using the official GBrowse button.
1464 : parrello 1.9 $retVal = $rhelp->FakeButton('Viewer', "wiki/rest.cgi/NmpdrPlugin/SeedViewer", undef, page => 'Annotation',
1465 : parrello 1.6 feature => $rhelp->ID());
1466 : parrello 1.1 } elsif ($type eq 'runTimeValue') {
1467 :     # Runtime support is not needed for this column.
1468 :     }
1469 :     return $retVal;
1470 :     }
1471 :    
1472 :     =head3 nmpdrLink
1473 :    
1474 : parrello 1.7 my $colDatum = RHFeatures::nmpdrLink($type => $rhelp, $key);
1475 : parrello 1.1
1476 :     This method computes the various things we need to know into order to process
1477 :     the nmpdrLink column.
1478 :    
1479 :     =over 4
1480 :    
1481 :     =item type
1482 :    
1483 :     Type of data about the column that is required: C<title> for the column title,
1484 :     C<download> for the download flag, and so forth.
1485 :    
1486 :     =item rhelp
1487 :    
1488 :     Result helper being used to format the search output.
1489 :    
1490 :     =item key (optional)
1491 :    
1492 :     The key to be used to compute a run-time value.
1493 :    
1494 :     =item RETURN
1495 :    
1496 :     Returns the desired information about the nmpdrLink column.
1497 :    
1498 :     =back
1499 :    
1500 :     =cut
1501 :    
1502 :     sub nmpdrLink {
1503 :     # Get the parameters.
1504 :     my ($type, $rhelp, $key) = @_;
1505 :     # Declare the return variable.
1506 :     my $retVal;
1507 :     # Process according to the information requested.
1508 :     if ($type eq 'title') {
1509 :     # Return the title for this column.
1510 :     $retVal = 'NMPDR Page';
1511 :     } elsif ($type eq 'download') {
1512 :     # This field should be included in a download.
1513 :     $retVal = 'link';
1514 :     } elsif ($type eq 'style') {
1515 :     # Here the caller wants the style class used to format this column.
1516 :     $retVal = 'center';
1517 :     } elsif ($type eq 'value') {
1518 :     # Here we want a link to the protein page using the official NMPDR button.
1519 : parrello 1.3 $retVal = $rhelp->FakeButton('NMPDR', "protein.cgi", undef, prot => $rhelp->ID(),
1520 : parrello 1.1 SPROUT => 1, new_framework => 0, user => '');
1521 :     } elsif ($type eq 'runTimeValue') {
1522 :     # Runtime support is not needed for this column.
1523 :     }
1524 :     return $retVal;
1525 :     }
1526 :    
1527 : parrello 1.5 =head3 GBrowseFeatureURL
1528 : parrello 1.1
1529 : parrello 1.7 my $url = RHFeatures::GBrowseFeatureURL($sprout, $feat);
1530 : parrello 1.5
1531 :     Compute the URL required to pull up a Gbrowse page for the the specified feature.
1532 :     In order to do this, we need to pull out the ID of the feature's Genome, its
1533 :     contig ID, and some rough starting and stopping offsets.
1534 :    
1535 :     =over 4
1536 :    
1537 :     =item sprout
1538 :    
1539 :     Sprout object for accessing the database.
1540 :    
1541 :     =item feat
1542 :    
1543 :     ID of the feature whose Gbrowse URL is desired.
1544 :    
1545 :     =item RETURN
1546 :    
1547 :     Returns a GET-style URL for the Gbrowse CGI, with parameters specifying the genome
1548 :     ID, contig ID, starting offset, and stopping offset.
1549 :    
1550 :     =back
1551 :    
1552 :     =cut
1553 :    
1554 :     sub GBrowseFeatureURL {
1555 :     # Get the parameters.
1556 :     my ($sprout, $feat) = @_;
1557 :     # Declare the return variable.
1558 :     my $retVal;
1559 :     # Compute the genome ID.
1560 :     my ($genomeID) = FIGRules::ParseFeatureID($feat);
1561 :     # Only proceed if the feature ID produces a valid genome.
1562 :     if ($genomeID) {
1563 :     # Get the feature location string.
1564 :     my $loc = $sprout->FeatureLocation($feat);
1565 :     # Compute the contig, start, and stop points.
1566 :     my($contig, $start, $stop) = BasicLocation::Parse($loc);
1567 :     Trace("Start and stop are ($start,$stop) on contig $contig.") if T(3);
1568 :     # Now we need to do some goofiness to insure that the location is not too
1569 :     # big and that we get some surrounding stuff.
1570 :     my $mid = int(($start + $stop) / 2);
1571 :     my $chunk_len = 20000;
1572 :     my $max_feature = 40000;
1573 :     my $feat_len = abs($stop - $start);
1574 :     if ($feat_len > $chunk_len) {
1575 :     if ($feat_len > $max_feature) {
1576 :     $chunk_len = $max_feature;
1577 :     } else {
1578 :     $chunk_len = $feat_len + 100;
1579 :     }
1580 :     }
1581 :     my($show_start, $show_stop);
1582 :     if ($chunk_len == $max_feature) {
1583 :     $show_start = $start - 300;
1584 :     } else {
1585 :     $show_start = $mid - int($chunk_len / 2);
1586 :     }
1587 :     if ($show_start < 1) {
1588 :     $show_start = 1;
1589 :     }
1590 :     $show_stop = $show_start + $chunk_len - 1;
1591 :     my $clen = $sprout->ContigLength($contig);
1592 :     if ($show_stop > $clen) {
1593 :     $show_stop = $clen;
1594 :     }
1595 :     my $seg_id = $contig;
1596 :     $seg_id =~ s/:/--/g;
1597 :     Trace("Show limits are ($show_start,$show_stop) in genome $genomeID with ref $seg_id.") if T(3);
1598 :     # Assemble all the pieces.
1599 :     $retVal = "gbrowse.cgi/GB_$genomeID?ref=$seg_id;start=$show_start;stop=$show_stop";
1600 :     }
1601 :     # Return the result.
1602 :     return $retVal;
1603 :     }
1604 : parrello 1.1
1605 : parrello 1.3 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3