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

Annotation of /Sprout/TargetCriterionEC.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     #
4 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
5 :     # for Interpretations of Genomes. All Rights Reserved.
6 :     #
7 :     # This file is part of the SEED Toolkit.
8 :     #
9 :     # The SEED Toolkit is free software. You can redistribute
10 :     # it and/or modify it under the terms of the SEED Toolkit
11 :     # Public License.
12 :     #
13 :     # You should have received a copy of the SEED Toolkit Public License
14 :     # along with this program; if not write to the University of Chicago
15 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
16 :     # Genomes at veronika@thefig.info or download a copy from
17 :     # http://www.theseed.org/LICENSE.TXT.
18 :     #
19 :    
20 :     package TargetCriterionEC;
21 :    
22 :     use strict;
23 :     use Tracer;
24 :     use Sprout;
25 :     use base qw(TargetCriterionQuery);
26 :    
27 :     =head1 EC Number Match Target Search Criterion Object
28 :    
29 :     =head2 Introduction
30 :    
31 :     This is a search criterion object for search criteria involving an EC number.
32 :     For any given feature, we have not only its primary EC numbers, but also
33 :     any wild-card EC numbers that might subsume it. As a result, finding the
34 :     features for a particular EC number is very fast, but when we display the
35 :     EC numbers, we're going to be showing too much information. This object,
36 :     in addition to having a more sophisticated validation algorithm, also removes
37 :     redundant numbers from the display.
38 :    
39 :     =head2 Special Methods
40 :    
41 :     =head3 new
42 :    
43 :     my $tc = TargetCriterionEC->new($rhelp, $name, $label, $hint);
44 :    
45 :     Construct a new TargetCriterionEC object. The following parameters are
46 :     expected.
47 :    
48 :     =over 4
49 :    
50 :     =item rhelp
51 :    
52 :     [[ResultHelperPm]] object for the active search.
53 :    
54 :     =item name
55 :    
56 :     Identifying name of this criterion.
57 :    
58 :     =item label
59 :    
60 :     Label to display for this criterion in the type dropdown.
61 :    
62 :     =item hint
63 :    
64 :     The hint tooltip to be displayed for this criterion.
65 :    
66 :     =back
67 :    
68 :     =cut
69 :    
70 :     sub new {
71 :     # Get the parameters.
72 :     my ($class, $rhelp, $name, $label, $hint) = @_;
73 :     # Construct the underlying object.
74 :     my $retVal = TargetCriterionQuery::new($class, $rhelp, { label => $label,
75 :     hint => $hint,
76 :     text => 1,
77 :     name => $name },
78 :     ec => qw(Feature));
79 :     # Return the object.
80 :     return $retVal;
81 :     }
82 :    
83 :     =head2 Virtual Methods
84 :    
85 :     =head3 Validate
86 :    
87 :     my $okFlag = $tc->Validate($parms);
88 :    
89 :     Return TRUE if the specified parameters are valid for a search criterion of this type
90 :     and FALSE otherwise. If an error is detected, the error message can be retrieved using
91 :     the L</message> method.
92 :    
93 :     =over 4
94 :    
95 :     =item parms
96 :    
97 :     A Criterion Parameter Object whose fields are to be validated.
98 :    
99 :     =item RETURN
100 :    
101 :     Returns TRUE if the parameters are valid, else FALSE.
102 :    
103 :     =back
104 :    
105 :     =cut
106 :    
107 :     sub Validate {
108 :     # Get the parameters.
109 :     my ($self, $parms) = @_;
110 :     # Default to valid.
111 :     my $retVal = 1;
112 :     # Get the relevant value.
113 :     my $value = $parms->{stringValue} || '';
114 :     # Fail if it has the wrong format.
115 :     if ($value eq '') {
116 :     $retVal = 0;
117 :     $self->SetMessage("No value specified for $self->{label}.");
118 :     } else {
119 :     my @pieces = split /\./, $value;
120 :     if (@pieces != 4) {
121 :     $retVal = 0;
122 :     $self->SetMessage("Incorrect number of sections in $self->{label}.");
123 :     } else {
124 :     # Parse the individual pieces. Note that as soon as we find a minus,
125 :     # we require all the following pieces to be minuses.
126 :     while ($retVal && (my $piece = shift @pieces)) {
127 :     if ($piece eq '-') {
128 :     my $count = scalar(grep { $_ ne '-' } @pieces);
129 :     if ($count > 0) {
130 :     $retVal = 0;
131 :     $self->SetMessage("Improper hyphen use in $self->{label}.");
132 :     }
133 :     } elsif ($piece =~ /\D/) {
134 :     $retVal = 0;
135 :     $self->SetMessage("Invalid number in $self->{label}.");
136 :     }
137 :     }
138 :     }
139 :     }
140 :     # Return the validation code.
141 :     return $retVal;
142 :     }
143 :    
144 :     =head3 Sane
145 :    
146 :     my $flag = $tc->Sane($parms);
147 :    
148 :     Return TRUE if this is a sane criterion, else FALSE. Every search must have at least one
149 :     sane criterion in order to be valid.
150 :    
151 :     =over 4
152 :    
153 :     =item parms (optional)
154 :    
155 :     The Criterion Parameter Object for the current query.
156 :    
157 :     =item RETURN
158 :    
159 :     Returns TRUE if this query returns a relatively limited result set and uses SQL,
160 :     else FALSE. We return TRUE if the EC number has no more than two hyphens.
161 :    
162 :     =back
163 :    
164 :     =cut
165 :    
166 :     sub Sane {
167 :     my ($self, $parms) = @_;
168 :     # Declare the return value.
169 :     my $retVal;
170 :     # Check the parameters.
171 :     if (! $parms) {
172 :     # This is usually a sane criterion, so when we're called without a
173 :     # parameter object, we return TRUE.
174 :     $retVal = 1;
175 :     } elsif ($parms->{stringValue} =~ /-.-.-/) {
176 :     # Here there are too many hyphens (unless the thing is malformed in
177 :     # some way, in which case sanity is not an issue).
178 :     $retVal = 0;
179 :     } else {
180 :     # Here we're okay.
181 :     $retVal = 1;
182 :     }
183 :     return $retVal;
184 :     }
185 :    
186 :     =head3 CacheValue
187 :    
188 :     my $value = $tc->CacheValue($feature);
189 :    
190 :     Return the value to cache for this criterion with respect to the specified
191 :     feature. Normally, this will be an HTML displayable version of the
192 :     appropriate value. If the value is immediately available, it is
193 :     returned; however, if the value is not available at the current time, a
194 :     runtime-value request is returned in its place.
195 :    
196 :     =over 4
197 :    
198 :     =item feature
199 :    
200 :     [[ERDBObjectPm]] object containing the data for the current feature.
201 :    
202 :     =item RETURN
203 :    
204 :     Returns the value that should be put in the search result cache file for
205 :     this column.
206 :    
207 :     =back
208 :    
209 :     =cut
210 :    
211 :     sub CacheValue {
212 :     # Get the parameters.
213 :     my ($self, $feature) = @_;
214 :     # Declare the return variable.
215 :     my $retVal;
216 :     # We need to determine if we already have the value or not. First, we check
217 :     # the cache.
218 :     if (defined $self->{cache}) {
219 :     # Yes. Format it as HTML.
220 :     $retVal = $self->FormatECs($self->{cache});
221 :     } else {
222 :     # It's not in the cache, so we put it off until runtime.
223 :     my $name = $self->name();
224 :     my $fid = $feature->PrimaryValue('Feature(id)');
225 :     $retVal = "%%$name=$fid";
226 :     }
227 :     # Return the result.
228 :     return $retVal;
229 :     }
230 :    
231 :    
232 :     =head3 RunTimeValue
233 :    
234 :     my $runTimeValue = $tc->RunTimeValue($runTimeKey);
235 :    
236 :     Return the run-time value for this column using the specified key. The key
237 :     in this case will be the feature ID. The feature ID continas the genome ID
238 :     embedded within it.
239 :    
240 :     The way we compute the run-time value depends on where the value can be found.
241 :     If it's in the Feature or Genome objects, we simply read it using B<GetFlat>.
242 :     Otherwise, we
243 :    
244 :     =over 4
245 :    
246 :     =item runTimeKey
247 :    
248 :     Key value placed in the search result cache when the need for the desired
249 :     value was determined during search processing. This will be the feature
250 :     ID.
251 :    
252 :     =item RETURN
253 :    
254 :     Returns the actual value to be used for the specified column.
255 :    
256 :     =back
257 :    
258 :     =cut
259 :    
260 :     sub RunTimeValue {
261 :     # Get the parameters.
262 :     my ($self, $runTimeKey) = @_;
263 :     # Read the values from the database. Note that the run-time key in this case
264 :     # is a feature ID.
265 :     my @values = $self->ReadDatabaseValues($runTimeKey);
266 :     # Format the values for HTML display.
267 :     my $retVal = $self->FormatECs(\@values);
268 :     # Return the result.
269 :     return $retVal;
270 :     }
271 :    
272 :     =head3 FormatECs
273 :    
274 :     my $html = $tc->FormatECs(\@values);
275 :    
276 :     Format a list of EC numbers for display. Redundant EC numbers will be
277 :     removed, and the others will be hyperlinked to searches.
278 :    
279 :     =over 4
280 :    
281 :     =item values
282 :    
283 :     Reference to a list of well-formed EC number strings.
284 :    
285 :     =item RETURN
286 :    
287 :     Returns HTML listing the nonredundant EC numbers hyperlinked to the
288 :     appropriate searches.
289 :    
290 :     =back
291 :    
292 :     =cut
293 :    
294 :     sub FormatECs {
295 :     # Get the parameters.
296 :     my ($self, $values) = @_;
297 :     # Get a copy of the list sorted by the number of hyphens.
298 :     my @sortedValues = sort { tr/-// <=> tr/-// } @$values;
299 :     # We'll put the good values in here. Because the list
300 :     # is sorted from fewest hyphens to most, we only need to
301 :     # look at a kept number when deciding whether or not to
302 :     # keep the current one. If there's a more specific version
303 :     # of a number, we'll already have seen it thanks to the sort.
304 :     my @keepers;
305 :     # Loop through the list of values.
306 :     for my $ec (@sortedValues) {
307 :     # We'll set this to a nonzero value if there's a matching number.
308 :     my $match = 0;
309 :     # We only need to do fancy stuff if there's a hyphen.
310 :     if ($ec =~ /(.+?)-/) {
311 :     # Check for a match among the kept stuff.
312 :     my $prefix = $1;
313 :     my $len = length($1);
314 :     $match = (grep { substr($_, 0, $len) eq $prefix } @keepers);
315 :     # If there's no match, keep this number.
316 :     }
317 :     # If there's no match, this is a keeper.
318 :     push @keepers, $ec;
319 :     }
320 :     # We need to convert each EC number to a search hyperlink. This
321 :     # requires computing a URL with the following prefix.
322 :     my $url = "$FIG_Config::cgi_url/wiki/rest.cgi/NmpdrPlugin/search?Class=WordSearch;keywords=";
323 :     # Build the list of links.
324 :     my @links = map { CGI::a({ href => "$url$_"}, $_) } @keepers;
325 :     # Convert it to a comma-delimited list.
326 :     my $retVal = join(", ", @links);
327 :     # Return the result.
328 :     return $retVal;
329 :     }
330 :    
331 :     =head3 ComputeQuery
332 :    
333 :     my ($joins, $filterString, $parms) = $tc->ComputeQuery($criterion);
334 :    
335 :     Compute the SQL filter, join list, and parameter list for this
336 :     criterion. If the criterion cannot be processed by SQL, then nothing is
337 :     returned, and the criterion must be handled during post-processing.
338 :    
339 :     The join list and the parameter list should both be list references. The
340 :     filter string is a true string.
341 :    
342 :     If the filter string only uses the B<Genome> and B<Feature> tables, then the
343 :     join list can be left empty. Otherwise, the join list should start with the
344 :     particular starting point (B<Genome> or B<Feature>) and list the path through
345 :     the other relevant entities and relationships. Each criterion will have its
346 :     own separate join path.
347 :    
348 :     =over 4
349 :    
350 :     =item criterion
351 :    
352 :     Reference to a Criterion Parameter Object.
353 :    
354 :     =item RETURN
355 :    
356 :     Returns a 3-tuple consisting of the join list, the relevant filter string,
357 :     and the matching parameters. If the criterion cannot be processed using
358 :     SQL, then the return list contains three undefined values. (This is what happens if
359 :     you don't override this method.)
360 :    
361 :     =back
362 :    
363 :     =cut
364 :    
365 :     sub ComputeQuery {
366 :     # Get the parameters.
367 :     my ($self, $criterion) = @_;
368 :     # Get the name of the relevant field with the appropriate suffix.
369 :     my $fieldName = $self->RelevantField($criterion->{idx});
370 :     # Compute the join list.
371 :     my $joins = $self->JoinList();
372 :     # Compute the filter string.
373 :     my $filterString = "$fieldName = ?";
374 :     # Get the parameter value.
375 :     my $parm = $criterion->{stringValue};
376 :     # Return the results.
377 :     return ($joins, $filterString, [$parm]);
378 :     }
379 :    
380 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3