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

Annotation of /Sprout/SHTargetSearch.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 :     package SHTargetSearch;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use CGI qw(-nosticky);
8 :     use HTML;
9 :     use Sprout;
10 :     use RHFeatures;
11 :     use base 'SearchHelper';
12 :    
13 :     =head1 Candidate Target Features Search Helper
14 :    
15 :     =head2 Introduction
16 :    
17 :     This search allows the user to specify a boolean combination of genome and feature
18 :     criteria for searching.
19 :    
20 :     The idea of this search is that the user initially sees a few rows of
21 :     fields, and has the option of adding more. As a result, instead of a single list
22 :     of form fields, every single form field is itself a list, and the lists are
23 :     precisely in parallel. So, there will be a list of C<operator> values and a list
24 :     of C<type> values, and the tenth operator will correspond to the tenth type.
25 :    
26 :     Each criterion is represented by an [[TargetCriterionPm]] object. The methods of this
27 :     object are used to handle the special processing required by each individual
28 :     criterion, including the javascript required to configure the form fields and
29 :     the post-processing of the query results. The exceptions are the standard feature
30 :     filter fields.
31 :    
32 :     A criterion in the target search form is implemented as a table row. The first
33 :     column of the table contains buttons for adding and deleting rows. The second
34 :     column contains the I<type dropdown>. Selecting an entry in the type dropdown tells
35 :     the target search which criterion object applies to it. The last column contains
36 :     configurable form fields, including a I<selection control>, a I<min/max control>,
37 :     a I<text input control>, and a I<hint control>.
38 :    
39 :     The form fields for the search are as follows.
40 :    
41 :     =over 4
42 :    
43 :     =item operator
44 :    
45 :     Boolean operator for this criterion: C<AND>, C<OR>, or C<NOT>.
46 :    
47 :     =item type
48 :    
49 :     Type of this criterion from the I<type dropdown>. The type is used to find the
50 :     criterion's [[TargetCriterionPm]] object.
51 :    
52 :     =item selection
53 :    
54 :     Value selected from the I<selection control>.
55 :    
56 :     =item minValue
57 :    
58 :     Minimum value for a range, from the I<min/max control>.
59 :    
60 :     =item maxValue
61 :    
62 :     Maximum value for a range, from the I<min/max control>.
63 :    
64 :     =item stringValue
65 :    
66 :     String entered by the user, from the I<text input control>.
67 :    
68 :     =back
69 :    
70 :     This object contains the following local fields, in addition to the
71 :     fields of the [[SearchHelperPm]] base class.
72 :    
73 :     =over 4
74 :    
75 :     =item targetSearchTypes
76 :    
77 :     Table of search criterion types. This is a reference to a hash that
78 :     matches the possible values in the type dropdown to [[TargetCriterionPm]]
79 :     objects.
80 :    
81 :     =item targetSearchCriteria
82 :    
83 :     Reference to a list of Criterion Parameter Objects describing the search
84 :     criteria present on the input form, or C<undef> if the criteria have not
85 :     been parsed yet.
86 :    
87 :     =item targetSearchValid
88 :    
89 :     TRUE if no error was detected during parsing of the search criteria, FALSE if
90 :     one or more parameters were invalid.
91 :    
92 :     =back
93 :    
94 :     =head3 Parameter Name List
95 :    
96 :     The parameter name list is a constant that defines the names of the configurable
97 :     parameters in the target search form. Each criterion row has a complete set of these
98 :     fields, but only certain fields display for each criterion type.
99 :    
100 :     =cut
101 :    
102 :     my @ParmNames = qw(selection minValue maxValue stringValue operator);
103 :    
104 :     =head3 Criterion Parameter Objects
105 :    
106 :     A [[TargetCriterionPm]] object describes a search criterion type. To describe an
107 :     actual search criterion, we use I<Criterion Parameter Objects>. These objects are
108 :     simple hashes containing the values for all the parameters in the search criterion's
109 :     table row on the search form. In addition, the object contains an index number (key C<idx>),
110 :     a pointer to the relevant [[TargetCriterionPm]] object (key C<type>), the relevant
111 :     criterion type (key C<typeKey>, and a flag indicating whether or not the
112 :     criterion was enforced using SQL (key C<sql>). This tells us all we need to know
113 :     to process the query and its aftermath.
114 :    
115 :     =head2 Virtual Methods
116 :    
117 :     =head3 Initialize
118 :    
119 :     $shelp->Initialize();
120 :    
121 :     Perform end-of-constructor initialization for this search helper.
122 :    
123 :     =cut
124 :    
125 :     sub Initialize {
126 :     my ($self) = @_;
127 :     # Create the result helper.
128 :     my $rhelp = RHFeatures->new($self);
129 :     $self->{rhelp} = $rhelp;
130 :     # Ask it for the search types.
131 :     $self->{targetSearchTypes} = $rhelp->GetCriteria();
132 :     # Denote we haven't parsed the criteria yet.
133 :     $self->{targetSearchCriteria} = undef;
134 :     $self->{targetSearchValid} = 1;
135 :     }
136 :    
137 :     =head3 Form
138 :    
139 :     my $html = $shelp->Form();
140 :    
141 :     Generate the HTML for a form to request a new search.
142 :    
143 :     =cut
144 :    
145 :     sub Form {
146 :     # Get the parameters.
147 :     my ($self) = @_;
148 :     # Get the CGI and sprout objects.
149 :     my $cgi = $self->Q();
150 :     my $sprout = $self->DB();
151 :     # Insure the criteria have been computed. We need this for the CriterionRows
152 :     # method that builds the form to work properly.
153 :     $self->ComputeCriteria();
154 :     # Include our special javascript.
155 :     my $retVal = qq(<script type="text/javascript" src="$FIG_Config::cgi_url/Html/SHTargetSearch.js"></script>);
156 :     # Start the form.
157 :     $retVal .= $self->FormStart("Target Feature Search");
158 :     # Create the data needed to manage the type dropdown. We start with a sorted
159 :     # list of available criterion types.
160 :     my $searchTypes = $self->{targetSearchTypes};
161 :     my @typeList = sort { $self->CriterionCMP($searchTypes, $a, $b) } keys %$searchTypes;
162 :     # Now we loop through the types. For each type, we store its label in the label hash,
163 :     # generate its configuration javascript, and specify its style class in attribute hash.
164 :     my $labelHash = {};
165 :     my @javascript = ("function configureCriterion(field) {",
166 :     " var selectData = new Array(0);",
167 :     " var typeValue = field.value;",
168 :     " switch (typeValue) {",
169 :     );
170 :     for my $type (@typeList) {
171 :     # Get the criterion object.
172 :     my $typeData = $searchTypes->{$type};
173 :     # Stuff the label in the label hash.
174 :     $labelHash->{$type} = $typeData->label();
175 :     # If it's sane, it gets an attribute.
176 :     # Start the javascript for this type selection.
177 :     push @javascript, " case '$type' : ";
178 :     # If we have selection data, we need to build it.
179 :     my $selectionHash = $typeData->selectionData();
180 :     if (defined $selectionHash) {
181 :     my @constructor = map { qq("$_", "$selectionHash->{$_}") } sort keys %$selectionHash;
182 :     push @javascript, " selectData = [" . join(", ", @constructor) . "];";
183 :     }
184 :     # Create a Javascript string literal out of the hint.
185 :     my $hint = $typeData->hint();
186 :     $hint =~ s/'/\\'/g;
187 :     $hint = "'$hint'";
188 :     # Generate the parameters to configureRow.
189 :     my @parms = ('field.parentNode', $typeData->minMax(), $typeData->text(), $hint,
190 :     'selectData');
191 :     # Generate the configuration call.
192 :     push @javascript, " configureRow(", join(", ", @parms) . ");";
193 :     # Finally, the break statement.
194 :     push @javascript, " break;";
195 :     }
196 :     # Create a table for the form data. It will contain one or more
197 :     # criterion rows.
198 :     my @table = CGI::Tr(CGI::td("Search Conditions"), CGI::td({colspan => 2},
199 :     $self->CriterionRows(\@typeList, $labelHash, $cgi)));
200 :     # Add the submit row.
201 :     push @table, $self->SubmitRow();
202 :     $retVal .= $self->MakeTable(\@table);
203 :     # Close the javascript and queue it.
204 :     push @javascript, " }",
205 :     "}";
206 :     $self->QueueFormScript(join("\n", @javascript));
207 :     # Close the form.
208 :     $retVal .= $self->FormEnd();
209 :     # Return the result.
210 :     return $retVal;
211 :     }
212 :    
213 :     =head3 Find
214 :    
215 :     my $resultCount = $shelp->Find();
216 :    
217 :     Conduct a search based on the current CGI query parameters. The search results will
218 :     be written to the session cache file and the number of results will be
219 :     returned. If the search parameters are invalid, a result count of C<undef> will be
220 :     returned and a result message will be stored in this object describing the problem.
221 :    
222 :     =cut
223 :    
224 :     sub Find {
225 :     my ($self) = @_;
226 :     # Get the CGI and Sprout objects.
227 :     my $cgi = $self->Q();
228 :     my $sprout = $self->DB();
229 :     # Declare the return variable. If it remains undefined, the caller will
230 :     # know that an error occurred.
231 :     my $retVal;
232 :     # Get the result helper.
233 :     my $rhelp = $self->{rhelp};
234 :     $self->PrintLine("Analyzing criteria.");
235 :     # Get the search criteria from the form fields. Most of the time, the
236 :     # criteria will already have been computed when the form was built, but
237 :     # if the client turned off the form, this precaution will save us from
238 :     # disaster.
239 :     my $criteria = $self->ComputeCriteria();
240 :     # Only proceed if the criteria were valid.
241 :     if (defined $criteria) {
242 :     # Set the column list.
243 :     $self->DefaultColumns($rhelp);
244 :     # We now begin the process of handling extra columns. For each criterion
245 :     # object, we ask it if extra columns are required. If so, it must call
246 :     # the AddExtraColumn method on the result helper to make things
247 :     # ready. We only want to do this, however, once per criterion object,
248 :     # and the same criterion object may occur multiple times in the criterion
249 :     # list. To start us off, we create a hash mapping TargetCriterion types to
250 :     # TargetCriterion objects for the criteria used in this search, and a list
251 :     # of the TargetCriterion objects used in this search that demand extra
252 :     # columns be added to the results.
253 :     my (%usedCriterionTypes, @extraColumnsNeeded);
254 :     # Now loop through the criteria.
255 :     for my $criterion (@$criteria) {
256 :     # Get this criterion's type name.
257 :     my $type = $criterion->{typeKey};
258 :     # Only look at this criterion if it's a new type.
259 :     if (! exists $usedCriterionTypes{$type}) {
260 :     # Get its type object.
261 :     my $typeData = $criterion->{type};
262 :     $usedCriterionTypes{$type} = $typeData;
263 :     # Add this to the result helper as an optional column.
264 :     $rhelp->AddOptionalColumn($typeData->colName());
265 :     }
266 :     }
267 :     # Initialize the session file.
268 :     $self->OpenSession($rhelp);
269 :     # Initialize the result counter.
270 :     $retVal = 0;
271 :     # This hash will be used to prevent duplicates.
272 :     my %fids;
273 :     # Create the query.
274 :     Trace("Creating query.") if T(3);
275 :     my $fquery = $self->ComputeQuery($criteria);
276 :     while (my $feature = $fquery->Fetch()) {
277 :     # Get the feature ID.
278 :     my $fid = $feature->PrimaryValue('Feature(id)');
279 :     # Only process this feature if it's new.
280 :     if (! exists $fids{$fid}) {
281 :     # Reset the criterion objects for the new feature.
282 :     for my $typeData (values %usedCriterionTypes) {
283 :     $typeData->Reset();
284 :     }
285 :     # Check to see if this feature matches.
286 :     if ($self->CheckFeature($feature, $criteria)) {
287 :     # It does. Compute the sort key.
288 :     my $sortKey = $rhelp->SortKey($feature);
289 :     # Emit the feature.
290 :     $rhelp->PutData($sortKey, $fid, $feature);
291 :     $retVal++;
292 :     }
293 :     # Insure we don't check this feature again.
294 :     $fids{$fid} = 1;
295 :     }
296 :     }
297 :     $self->PrintLine("Results found: $retVal.<br />");
298 :     # Close the session file.
299 :     $self->CloseSession();
300 :     }
301 :     # Return the result count.
302 :     return $retVal;
303 :     }
304 :    
305 :     =head3 Description
306 :    
307 :     my $htmlText = $shelp->Description();
308 :    
309 :     Return a description of this search. The description is used for the table of contents
310 :     on the main search tools page. It may contain HTML, but it should be character-level,
311 :     not block-level, since the description is going to appear in a list.
312 :    
313 :     =cut
314 :    
315 :     sub Description {
316 :     # Get the parameters.
317 :     my ($self) = @_;
318 :     # Return the result.
319 :     return "Search for genes in selected genomes, filtered by various criteria.";
320 :     }
321 :    
322 :     =head3 SearchTitle
323 :    
324 :     my $titleHtml = $shelp->SearchTitle();
325 :    
326 :     Return the display title for this search. The display title appears above the search results.
327 :     If no result is returned, no title will be displayed. The result should be an html string
328 :     that can be legally put inside a block tag such as C<h3> or C<p>.
329 :    
330 :     =cut
331 :    
332 :     sub SearchTitle {
333 :     return "Custom Gene Target Search";
334 :     }
335 :    
336 :     =head3 HeaderHtml
337 :    
338 :     my $html = $shelp->HeaderHtml();
339 :    
340 :     Generate HTML for the HTML header. If extra styles or javascript are required,
341 :     they should go in here.
342 :    
343 :     =cut
344 :    
345 :     sub HeaderHtml {
346 :     return qq(<script type="text/javascript" src="$FIG_Config::cgi_url/Html/SHTargetSearch.js"></script>);
347 :     }
348 :    
349 :     =head3 GetResultHelper
350 :    
351 :     my $rhelp = $shelp->GetResultHelper($className);
352 :    
353 :     Return a result helper for this search helper. The default action is to create
354 :     a result helper from scratch; however, if the subclass has an internal result
355 :     helper it can override this method to return it without having to create a new
356 :     one.
357 :    
358 :     =over 4
359 :    
360 :     =item className
361 :    
362 :     Result helper class name.
363 :    
364 :     =item RETURN
365 :    
366 :     Returns a result helper of the specified class connected to this search helper.
367 :    
368 :     =back
369 :    
370 :     =cut
371 :    
372 :     sub GetResultHelper {
373 :     # Get the parameters.
374 :     my ($self, $className) = @_;
375 :     # Return our internal result helper.
376 :     return $self->{rhelp};
377 :     }
378 :    
379 :    
380 :    
381 :     =head2 Internal Methods
382 :    
383 :     =head3 ComputeCriteria
384 :    
385 :     my $criteria = $self->ComputeCriteria(\@genomes);
386 :    
387 :     Parse the search criteria from the form fields and return them in a list
388 :     reference. For each criterion, the list will contain a hash of the
389 :     relevant form fields. If the criteria are invalid, the return value will
390 :     be undefined instead of a list reference. The criteria are stored in
391 :     the =targetSearchCriteria= field of this object regardless of whether or
392 :     not there is an error; however, if there is an error, the return value
393 :     will not be the criterion list, it will be undefined.
394 :    
395 :     =cut
396 :    
397 :     sub ComputeCriteria {
398 :     # Get the parameters.
399 :     my ($self) = @_;
400 :     # Declare the return value.
401 :     my $retVal;
402 :     # Do we already have the criteria?
403 :     my $criteria = $self->{targetSearchCriteria};
404 :     if (defined $criteria) {
405 :     # If there were no errors, return it.
406 :     $retVal = $criteria if $self->{targetSearchValid};
407 :     } else {
408 :     # Here we need to compute them. Start with an empty list.
409 :     $criteria = [];
410 :     # Get the search type hash.
411 :     my $searchTypes = $self->{targetSearchTypes};
412 :     # This will be set to FALSE if an error is detected.
413 :     my $ok = 1;
414 :     # We'll save error messages in here.
415 :     my @errors;
416 :     # Get the CGI query object.
417 :     my $cgi = $self->Q();
418 :     # Extract the main parameter lists.
419 :     my %parmLists = map { $_ => [ $cgi->param($_) ] } @ParmNames;
420 :     # The number of sane criteria will be kept in here. We need at least one
421 :     # sane criterion for the search to be possible. Theoretically, we will
422 :     # only have a sanity failure if the user leaves the top row blank.
423 :     my $sane = 0;
424 :     # Get the list of incoming criterion types.
425 :     my @types = $cgi->param('type');
426 :     # Loop through the types.
427 :     for (my $i = 0; $i <= $#types && $ok; $i++) {
428 :     # Get this criterion's actual type.
429 :     my $type = $types[$i];
430 :     # Only proceed if it's non-null. Null criteria match every feature,
431 :     # and do not affect the results. Leaving them in means extra work
432 :     # and confuses the OR counting.
433 :     if ($type) {
434 :     # Get a hash for this type's parameter data.
435 :     my $criterionRow = { map { $_ => $parmLists{$_}->[$i] } @ParmNames };
436 :     # Add the type.
437 :     my $typeData = $searchTypes->{$type};
438 :     $criterionRow->{type} = $typeData;
439 :     $criterionRow->{typeKey} = $type;
440 :     # Add the index. The TargetCriterion object uses the index to generate
441 :     # unique table names in the join string.
442 :     $criterionRow->{idx} = $i;
443 :     # Add the SQL flag. This is set to 1 later on if the criterion is
444 :     # enforced by the SQL query.
445 :     $criterionRow->{sql} = 0;
446 :     # Validate the parameters.
447 :     $ok = $typeData->Validate($criterionRow);
448 :     if (! $ok) {
449 :     # The validation failed, so we need to set an error message.
450 :     push @errors, $typeData->message();
451 :     }
452 :     # Push this criterion into the result list.
453 :     push @$criteria, $criterionRow;
454 :     # If the operator is AND, we do a sanity check.
455 :     if ($criterionRow->{operator} eq 'AND' && $typeData->Sane($criterionRow)) {
456 :     $sane++;
457 :     }
458 :     }
459 :     }
460 :     # If we're OK so far, do a sanity check.
461 :     if ($ok && ! $sane) {
462 :     push @errors, "This query is too broad. Please specify a value for the first condition.";
463 :     Trace("Query rejected: too broad.") if T(3);
464 :     $ok = 0;
465 :     }
466 :     # Save the criteria and the error flag.
467 :     $self->{targetSearchCriteria} = $criteria;
468 :     $self->{targetSearchValid} = $ok;
469 :     # Do we have errors?
470 :     if (! $ok) {
471 :     # Yes, save the error message.
472 :     $self->SetMessage(join("\n", @errors));
473 :     } else {
474 :     # No, return the criteria list.
475 :     $retVal = $criteria;
476 :     }
477 :     }
478 :     # Return the result.
479 :     return $retVal;
480 :     }
481 :    
482 :    
483 :     =head3 CriterionRows
484 :    
485 :     my $html = $shelp->CriterionRows(\@typeList, \%labelHash, $cgi, $attrHash);
486 :    
487 :     Return the HTML for a criterion table with a single row and the specified
488 :     boolean operator. The criterion table is an invisible table that allows
489 :     the user to add new rows or delete any row but the first one.
490 :    
491 :     The last cell in each criterion row contains the controls that are configured
492 :     each time the user changes the type dropdown. The selection control is a C<select>
493 :     tag named C<selection>. The hint control is an anchor tag. The anchor tag's
494 :     title will contain the tooltip. The min/max control is a C<span> tag named C<minMax>.
495 :     The text control is an C<input> tag named C<stringValue>. This arrangement is
496 :     bound fairly tightly with the javascript methods in [[SHTargetSearchJs]].
497 :    
498 :     The criterion row places a group of span tags in the last table cell. Each of
499 :     these has a class name that indicates which control it represents. The span style
500 :     is toggled between C<display: inline> and C<display: none> by the javascript
501 :     configuration method. If additional controls are needed, they should be treated
502 :     the same way. The Javascript counts rather heavily on the fact that the type
503 :     dropdown is the only select box that is an immediate child of a table cell.
504 :    
505 :     =over 4
506 :    
507 :     =item typeList
508 :    
509 :     Reference to a list of the criterion types. This is used to build the type
510 :     dropdown.
511 :    
512 :     =item labelHash
513 :    
514 :     Reference to a hash of criterion types to display labels. This is used to build
515 :     the type dropdown.
516 :    
517 :     =item cgi
518 :    
519 :     A CGI query object containing the current values of the query parameters. This
520 :     is used to pre-generate the table rows using data from the previous search.
521 :    
522 :     =item attrHash (optional)
523 :    
524 :     Reference to a hash of display attributes for the entries in the type dropdown.
525 :     This is used to help the user determine which criterion types are sane.
526 :    
527 :     =item RETURN
528 :    
529 :     Returns a borderless HTML table with the javascript support needed to add and
530 :     delete criteria.
531 :    
532 :     =back
533 :    
534 :     =cut
535 :    
536 :     # This constant helps us to compute the display style of each configurable control.
537 :     use constant STYLES => { true => 'display: inline', false => 'display: none' };
538 :    
539 :     sub CriterionRows {
540 :     # Get the parameters.
541 :     my ($self, $typeList, $labelHash, $cgi, $attrHash) = @_;
542 :     # Default the attribute hash if it wasn't passed in.
543 :     if (! defined $attrHash) {
544 :     Trace("No attributes for search criteria.") if T(3);
545 :     $attrHash = {};
546 :     } else {
547 :     Trace("Attribute hash is\n" . Dumper($attrHash)) if T(3);
548 :     }
549 :     # Insure we have at least one criterion.
550 :     my @criteria = @{$self->{targetSearchCriteria}};
551 :     if (! @criteria) {
552 :     my %nullCriterion = map { $_ => "" } @ParmNames;
553 :     $nullCriterion{operator} = "AND";
554 :     $nullCriterion{typeKey} = "";
555 :     $nullCriterion{type} = $self->{targetSearchTypes}{""};
556 :     push @criteria, \%nullCriterion;
557 :     }
558 :     # We'll build the table rows in here.
559 :     my @rows = ();
560 :     # Loop through the criteria.
561 :     for my $criterion (@criteria) {
562 :     # Get the TargetCriterion object and its name.
563 :     my $typeData = $criterion->{type};
564 :     my $typeKey = $criterion->{typeKey};
565 :     # Get the operator.
566 :     my $op = $criterion->{operator};
567 :     # Compute the selection data stuff. Note that if there is no selection,
568 :     # we create a dummy list to insure that the value is passed along by
569 :     # the form. This is critical, because all of the value lists on the
570 :     # form must be in parallel.
571 :     my ($valueList, $selected, $showSelect);
572 :     my $selectHash = $typeData->selectionData();
573 :     if (! defined $selectHash) {
574 :     # No select hash, so create a dummy list with a selected value of 0.
575 :     $selectHash = {"0" => "(none)"};
576 :     $valueList = ["0"];
577 :     $selected = "0";
578 :     $showSelect = "false";
579 :     } else {
580 :     # A select hash exists, so create a selection control out of it. We must
581 :     # be sure to chop off the asterisk used to tell the JavaScript which value
582 :     # is the default.
583 :     $valueList = [ sort keys %$selectHash ];
584 :     my %labelList;
585 :     for my $key (@$valueList) {
586 :     $labelList{$key} = $selectHash->{$key};
587 :     $labelList{$key} =~ s/^\*//;
588 :     }
589 :     $selectHash = \%labelList;
590 :     $selected = $criterion->{selection};
591 :     $showSelect = "true";
592 :     }
593 :     # Get the other match flags.
594 :     my $minMax = $typeData->minMax();
595 :     my $text = $typeData->text();
596 :     # Now generate the row.
597 :     my $row = CGI::Tr(
598 :     CGI::td(join("",
599 :     CGI::button(-name => 'plus', -value => '+',
600 :     -class => 'button', -title => "Add a new row",
601 :     -onClick => 'addRow(this.parentNode)'),
602 :     CGI::button(-name => 'minus', -value => '-',
603 :     -class => 'button', -title => "Delete this row",
604 :     -onClick => 'delRow(this.parentNode)'),
605 :     " ",
606 :     CGI::popup_menu(-name => 'operator', -values => [qw(AND OR NOT)],
607 :     -default => $op),
608 :     )),
609 :     CGI::td(join("",
610 :     CGI::hidden(-name => 'operator', -value => $op),
611 :     CGI::popup_menu(-name => 'type', -values => $typeList,
612 :     -labels => $labelHash,
613 :     -onChange => 'configureCriterion(this)',
614 :     -default => $typeKey,
615 :     -attributes => $attrHash),
616 :     )),
617 :     CGI::td(join(" ",
618 :     CGI::a({ href => "$FIG_Config::cgi_url/wiki/view.cgi/FIG/TargetSearch" },
619 :     qq(<img src="$FIG_Config::cgi_url/Html/button-h.png" />)),
620 :     CGI::span({ style => STYLES->{$showSelect}, class => '_selectionControl' },
621 :     CGI::popup_menu(-name => 'selection', -values => $valueList,
622 :     -labels => $selectHash, -default => $selected)),
623 :     CGI::span({ style => STYLES->{$minMax},
624 :     class => '_minMaxControl' },
625 :     "from " .
626 :     CGI::textfield(-name => 'minValue', -size => 5,
627 :     -value => $criterion->{minValue}) .
628 :     " to " .
629 :     CGI::textfield(-name => 'maxValue', -size => 5,
630 :     -value => $criterion->{maxValue})),
631 :     CGI::span({ style => STYLES->{$text}, class => '_textControl' },
632 :     CGI::textfield(-name => 'stringValue', -size => 30,
633 :     -value => $criterion->{stringValue})),
634 :     )),
635 :     );
636 :     push @rows, $row;
637 :     }
638 :     # Return the result.
639 :     my $retVal = CGI::table({ class => 'target' }, CGI::Tr(\@rows));
640 :     return $retVal;
641 :     }
642 :    
643 :     =head3 ComputeQuery
644 :    
645 :     my $fquery = $self->ComputeQuery($criteria);
646 :    
647 :     Compute the query for searching in the specified genome to find the
648 :     features with the specified criteria. The return value will be an
649 :     [[ERDBQueryPm]] object that returns the desired features.
650 :    
651 :     =over 4
652 :    
653 :     =item criteria
654 :    
655 :     Reference to a list of Criterion Parameter Objects.
656 :    
657 :     =item RETURN
658 :    
659 :     Returns a query object for retrieving features that match as many of the
660 :     criteria as possible.
661 :    
662 :     =back
663 :    
664 :     =cut
665 :    
666 :     sub ComputeQuery {
667 :     # Get the parameters.
668 :     my ($self, $criteria) = @_;
669 :     # The filter clauses and parameters will go in these arrays.
670 :     my (@filters, @parms);
671 :     # The join string will be built in here. The list always starts with a
672 :     # genome-to-feature path. Additional criteria may add to the list.
673 :     my $joinString = "Genome HasFeature Feature";
674 :     # Now loop through the criteria, adding the filters. Only AND filters will
675 :     # be processed this way. There's always at least one that's sane, or we
676 :     # wouldn't have come this far.
677 :     for my $criterion (@$criteria) {
678 :     # Get this criterion's type and operator.
679 :     my $typeData = $criterion->{type};
680 :     my $op = $criterion->{operator};
681 :     # Only continue if it's an AND.
682 :     if ($op eq 'AND') {
683 :     # Get this criterion's query data.
684 :     my ($joins, $filterString, $parms) = $typeData->ComputeQuery($criterion);
685 :     # Only proceed if this criterion really is involved in the query process.
686 :     if (defined $joins) {
687 :     # First, we must handle the join path. If there is one, each element after
688 :     # the first needs to be suffixed with a number.
689 :     if (scalar(@$joins) > 1) {
690 :     # Start by putting in the base entity (Feature or Genome).
691 :     my $base = shift @$joins;
692 :     $joinString .= " AND $base";
693 :     # Now put in the rest of the path.
694 :     for my $join (@$joins) {
695 :     # Suffix this criterion's index to the join.
696 :     my $newJoin = "$join$criterion->{idx}";
697 :     # Fix it in the filter string.
698 :     $filterString =~ s/$join\(/$newJoin\(/gx;
699 :     # Add this join onto the path.
700 :     $joinString .= " $newJoin";
701 :     }
702 :     }
703 :     # Now push in the fixed filter and the parameters.
704 :     push @filters, "($filterString)";
705 :     push @parms, @$parms;
706 :     # Finally, denote that this criterion was processed using SQL.
707 :     $criterion->{sql} = 1;
708 :     }
709 :     }
710 :     }
711 :     # Compute the final filter string.
712 :     my $filter = join(" AND ", @filters);
713 :     # Create and execute the query.
714 :     my $sprout = $self->DB();
715 :     Trace("Target search query filter is \"$filter\" against ($joinString) with parameters: " .
716 :     join(", ", @parms)) if T(3);
717 :     my $retVal = $sprout->Get($joinString, $filter, \@parms);
718 :     # Return the result.
719 :     return $retVal;
720 :     }
721 :    
722 :     =head3 CheckFeature
723 :    
724 :     my $flag = $self->CheckFeature($feature, $criteria);
725 :    
726 :     Return TRUE if the specified feature satisfies the criteria, else FALSE.
727 :    
728 :     =over 4
729 :    
730 :     =item feature
731 :    
732 :     [[ERDBObjectPm]] object containing at least the feature and genome records.
733 :    
734 :     =item criteria
735 :    
736 :     Reference to a list of Criterion Parameter Objects.
737 :    
738 :     =item RETURN
739 :    
740 :     Returns TRUE if the feature matches, else FALSE.
741 :    
742 :     =back
743 :    
744 :     =cut
745 :    
746 :     sub CheckFeature {
747 :     # Get the parameters.
748 :     my ($self, $feature, $criteria) = @_;
749 :     # We have essentially three categories of criteria: AND, OR, and NOT. We will count
750 :     # the total number of each as well as the number of matches for each. The result
751 :     # will enable us to determine whether or not we have a match.
752 :     my %total = map { $_ => 0 } qw(AND OR NOT);
753 :     my %matched = map { $_ => 0 } qw(AND OR NOT);
754 :     # Now loop through the criteria.
755 :     for my $criterion (@$criteria) {
756 :     # Get the operator and the SQL flag.
757 :     my $op = $criterion->{operator};
758 :     my $match = $criterion->{sql};
759 :     # If this criterion hasn't been enforced by SQL, check it against the
760 :     # criterion type.
761 :     if (! $match) {
762 :     my $typeData = $criterion->{type};
763 :     $match = $typeData->Check($criterion, $feature);
764 :     }
765 :     # Increment the total count.
766 :     $total{$op}++;
767 :     # If we have a match, increment the match count.
768 :     $matched{$op}++ if $match;
769 :     }
770 :     # Now determine if the feature as a whole matches.
771 :     my $retVal = ($total{AND} == $matched{AND} &&
772 :     ($total{OR} == 0 || $matched{OR} > 0) &&
773 :     $matched{NOT} == 0);
774 :     # Return the result.
775 :     return $retVal;
776 :     }
777 :    
778 :    
779 :     =head3 CriterionCMP
780 :    
781 :     my $cmp = $shelp->CriterionCMP(\%searchTypes, $a, $b);
782 :    
783 :     Return a comparison number for two criteria. The comparison number is
784 :     designed to be used in a sort command that will order the criterion
785 :     types. Sane criteria sort before insane criteria, feature criteria sort
786 :     before organism criteria, and within those groups everything is
787 :     alphabetical.
788 :    
789 :     =over 4
790 :    
791 :     =item searchTypes
792 :    
793 :     Reference to a hash of type names to [[TargetCriterionPm]] objects.
794 :    
795 :     =item a
796 :    
797 :     First type to compare.
798 :    
799 :     =item b
800 :    
801 :     Second type to compare.
802 :    
803 :     =item RETURN
804 :    
805 :     Return a negative number if the two types are in the correct order,
806 :     a positive number if they should be switched, and 0 if they are the
807 :     same.
808 :    
809 :     =back
810 :    
811 :     =cut
812 :    
813 :     sub CriterionCMP {
814 :     # Get the parameters.
815 :     my ($self, $searchTypes, $a, $b) = @_;
816 :     # Declare the return variable.
817 :     my $retVal = 0;
818 :     # Only proceed if there's a difference.
819 :     if ($a ne $b) {
820 :     # Null sorts before everything.
821 :     if ($a eq '') {
822 :     $retVal = -1;
823 :     } elsif ($b eq '') {
824 :     $retVal = 1;
825 :     } else {
826 :     # Here we have a nontrivial case. Compute a sort key for
827 :     # each criterion type.
828 :     my @keys;
829 :     for my $type ($a, $b) {
830 :     my $thing = $searchTypes->{$type};
831 :     # Get the sanity flag. Sanity should sort low.
832 :     my $key = ($thing->Sane() ? 'A' : 'Z');
833 :     # Get the label.
834 :     my $label = $thing->label();
835 :     # First comes the organism flag. Organism sorts high.
836 :     $key .= ($label =~ /^Organism/ ? 'Z' : 'A');
837 :     # Check to see if this is an ID. IDs sort low.
838 :     $key .= ($label =~ /ID/ ? 'A' : 'Z');
839 :     # Tack on the label. Because we want to do a case-insensitive
840 :     # sort, we put in the label lower-cased followed by the
841 :     # real version.
842 :     $key .= join(':', lc($label), $label);
843 :     # Save this key.
844 :     push @keys, $key;
845 :     }
846 :     # Compare the computed sort keys.
847 :     $retVal = $keys[0] cmp $keys[1];
848 :     }
849 :     }
850 :     # Return the result.
851 :     return $retVal;
852 :     }
853 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3