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

Annotation of /Sprout/SHPropSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package SHPropSearch;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use CGI;
8 :     use HTML;
9 :     use Sprout;
10 : parrello 1.5 use RHFeatures;
11 :     use base 'SearchHelper';
12 : parrello 1.1
13 :     =head1 Property Search Feature Search Helper
14 :    
15 :     =head2 Introduction
16 :    
17 :     This search can be used to request all the features of a specified genome that have
18 :     specified property values. This search is not normally available to users; rather, it
19 :     is used by content developers to generate links.
20 :    
21 :     It has the following extra parameters.
22 :    
23 :     =over 4
24 :    
25 :     =item propertyPair[]
26 :    
27 :     One or more name/value pairs for properties. The name comes first, followed by an
28 :     equal sign and then the value. Theoretically, an unlimited number of name/value
29 :     pairs can be specified in this way, but the form only generates a fixed number
30 :     determined by the value of C<$FIG_Config::prop_search_limit>. A feature will
31 :     be returned if it matches any one of the name-value pairs.
32 :    
33 :     =item genome
34 :    
35 :     The ID of the genome whose features are to be searched.
36 :    
37 :     =back
38 :    
39 :     =head2 Virtual Methods
40 :    
41 :     =head3 Form
42 :    
43 : parrello 1.3 C<< my $html = $shelp->Form(); >>
44 : parrello 1.1
45 :     Generate the HTML for a form to request a new search.
46 :    
47 :     =cut
48 :    
49 :     sub Form {
50 :     # Get the parameters.
51 :     my ($self) = @_;
52 :     # Get the CGI and sprout objects.
53 :     my $cgi = $self->Q();
54 :     my $sprout = $self->DB();
55 :     # Start the form.
56 : parrello 1.2 my $retVal = $self->FormStart("Attribute Search");
57 : parrello 1.1 my @rows = ();
58 :     # First, we generate the genome menu.
59 :     my $genomeMenu = $self->NmpdrGenomeMenu('genome', 0, [$cgi->param('genome')]);
60 :     push @rows, $cgi->Tr($cgi->td({valign => "top"}, "Genome"),
61 :     $cgi->td({colspan => 2}, $genomeMenu));
62 :     # Now add the property rows.
63 :     my @pairs = grep { $_ } $cgi->param('propertyPair');
64 :     Trace(scalar(@pairs) . " property pairs read from CGI.") if T(3);
65 :     for (my $i = 1; $i <= $FIG_Config::prop_search_limit; $i++) {
66 :     my $thisPair = shift @pairs;
67 :     Trace("\"$thisPair\" popped from pairs array. " . scalar(@pairs) . " entries left.") if T(3);
68 :     push @rows, $cgi->Tr($cgi->td("Name=Value ($i)"),
69 :     $cgi->td({colspan => 2}, $cgi->textfield(-name => 'propertyPair',
70 :     -value => $thisPair,
71 :     -override => 1,
72 :     -size => 40)));
73 :     }
74 :     # Finally, the submit row.
75 :     push @rows, $self->SubmitRow();
76 :     # Build the form table.
77 :     $retVal .= $self->MakeTable(\@rows);
78 :     # Close the form.
79 :     $retVal .= $self->FormEnd();
80 :     # Return the result.
81 :     return $retVal;
82 :     }
83 :    
84 :     =head3 Find
85 :    
86 :     C<< my $resultCount = $shelp->Find(); >>
87 :    
88 :     Conduct a search based on the current CGI query parameters. The search results will
89 :     be written to the session cache file and the number of results will be
90 :     returned. If the search parameters are invalid, a result count of C<undef> will be
91 :     returned and a result message will be stored in this object describing the problem.
92 :    
93 :     =cut
94 :    
95 :     sub Find {
96 :     my ($self) = @_;
97 :     # Get the CGI and Sprout objects.
98 :     my $cgi = $self->Q();
99 :     my $sprout = $self->DB();
100 :     # Declare the return variable. If it remains undefined, the caller will
101 :     # know that an error occurred.
102 :     my $retVal;
103 :     # Insure we have a genome.
104 :     my ($genomeID) = $self->GetGenomes('genome');
105 :     if (! $genomeID) {
106 :     $self->SetMessage("No genome was specified.");
107 :     } else {
108 :     # Now we verify the property filters. First we get the specified pairs.
109 :     my @props = $cgi->param('propertyPair');
110 :     # We'll put the property IDs found into this list.
111 :     my @propIDs = ();
112 :     # We'll accumulate error messages in this list.
113 :     my @errors = ();
114 :     # Loop through the specified pairs.
115 :     for my $prop (@props) {
116 :     # Only proceed if we have something.
117 :     if ($prop) {
118 :     # Separate the name and value.
119 :     if ($prop =~ /^\s*(\w+)\s*=\s*(.*)\s*$/) {
120 :     my ($name, $value) = ($1, $2);
121 :     # Verify that they exist.
122 :     my ($id) = $sprout->GetFlat(['Property'],
123 :     "Property(property-name) = ? AND Property(property-value) = ?",
124 :     [$name, $value], 'Property(id)');
125 :     # If they do, save the ID.
126 :     if ($id) {
127 :     push @propIDs, $id;
128 :     }
129 :     } else {
130 :     # Here the format is wrong.
131 :     push @errors, "Could not parse \"$prop\" into a name-value pair.";
132 :     }
133 :     }
134 :     }
135 :     # Insure we have some values and that there are no errors.
136 :     if (@errors) {
137 :     $self->SetMessage(join(" ", @errors));
138 :     } elsif (! @propIDs) {
139 :     $self->SetMessage("None of the name-value pairs specified exist in the database.");
140 :     } else {
141 :     # If we are here, then we have a genome ($genomeID) and a list
142 :     # of desired property IDs (@propIDs). That means we can search.
143 : parrello 1.5 # Create the result helper.
144 :     my $rhelp = RHFeatures->new($self);
145 :     # Set the default columns.
146 :     $self->DefaultColumns($rhelp);
147 :     # Add the value columm at the front.
148 :     $rhelp->AddExtraColumn(values => 0, title => 'Values', download => 'list',
149 :     style => 'leftAlign');
150 : parrello 1.1 # Initialize the session file.
151 : parrello 1.5 $self->OpenSession($rhelp);
152 : parrello 1.1 # Initialize the result counter.
153 :     $retVal = 0;
154 :     # Create a feature data object for tracking the results.
155 :     my $fd = FeatureData->new($self);
156 :     # Create a variable to store the property value HTML.
157 :     my @extraCols = ();
158 :     # Denote that we currently don't have a feature.
159 :     my $fid = undef;
160 :     # Create the query.
161 :     my $query = $sprout->Get(['HasFeature', 'Feature', 'HasProperty', 'Property'],
162 :     "Property(id) IN (" . join(",", @propIDs) .
163 :     ") AND HasFeature(from-link) = ? ORDER BY Feature(id)",
164 :     [$genomeID]);
165 :     # Loop through the query results. The same feature may appear multiple times,
166 :     # but all the multiples will be grouped together.
167 : parrello 1.5 my $savedRow;
168 : parrello 1.1 while (my $row = $query->Fetch()) {
169 :     # Get the feature ID;
170 : parrello 1.5 my $newFid = $row->PrimaryValue('Feature(id)');
171 : parrello 1.1 # Check to see if we have a new feature coming in. Note we check for undef
172 :     # to avoid a run-time warning.
173 :     if (! defined($fid) || $newFid ne $fid) {
174 :     if (defined($fid)) {
175 :     # Here we have an old feature to output.
176 : parrello 1.5 $self->DumpFeature($rhelp, $savedRow, \@extraCols);
177 : parrello 1.1 $retVal++;
178 :     }
179 : parrello 1.5 # Clear the property value list.
180 : parrello 1.1 @extraCols = ();
181 : parrello 1.5 # Save this as the currently-active feature.
182 :     $savedRow = $row;
183 : parrello 1.1 $fid = $newFid;
184 :     }
185 :     # Get this row's property data for the extra column.
186 :     my ($name, $value, $url) = $row->Values(['Property(property-name)',
187 :     'Property(property-value)',
188 :     'HasProperty(evidence)']);
189 :     # If the evidence is a URL, format it as a link; otherwise, ignore it.
190 :     if ($url =~ m!http://!) {
191 :     push @extraCols, $cgi->a({href => $url}, $value);
192 :     } else {
193 :     push @extraCols, $value;
194 :     }
195 :     }
196 :     # If there's a feature still in the buffer, write it here.
197 :     if (defined $fid) {
198 : parrello 1.5 $self->DumpFeature($rhelp, $savedRow, \@extraCols);
199 : parrello 1.1 $retVal++;
200 :     }
201 :     # Close the session file.
202 :     $self->CloseSession();
203 :     }
204 :     }
205 :     # Return the result count.
206 :     return $retVal;
207 :     }
208 :    
209 :     =head3 DumpFeature
210 :    
211 : parrello 1.5 C<< $shelp->DumpFeature($rhelp, $record, \@extraCols); >>
212 : parrello 1.1
213 :     Write the data for the current feature to the output.
214 :    
215 :     =over 4
216 :    
217 : parrello 1.5 =item rhelp
218 :    
219 :     Feature result helper.
220 :    
221 :     =item record
222 : parrello 1.1
223 : parrello 1.5 B<ERDBObject> containing the feature.
224 : parrello 1.1
225 :     =item extraCols
226 :    
227 :     Reference to a list of extra column data.
228 :    
229 :     =back
230 :    
231 :     =cut
232 :    
233 :     sub DumpFeature {
234 :     # Get the parameters.
235 : parrello 1.5 my ($self, $rhelp, $record, $extraCols) = @_;
236 : parrello 1.1 # Format the extra column data.
237 :     my $extraColumn = join(", ", @{$extraCols});
238 :     # Add the extra column data.
239 : parrello 1.5 $rhelp->PutExtraColumns(values => $extraColumn);
240 :     # Compute the sort key and the feature ID.
241 :     my $sortKey = $rhelp->SortKey($record);
242 :     my $fid = $record->PrimaryValue('Feature(id)');
243 : parrello 1.1 # Put everything to the output.
244 : parrello 1.5 $rhelp->PutData($sortKey, $fid, $record);
245 : parrello 1.1 }
246 :    
247 :     =head3 Description
248 :    
249 :     C<< my $htmlText = $shelp->Description(); >>
250 :    
251 :     Return a description of this search. The description is used for the table of contents
252 :     on the main search tools page. It may contain HTML, but it should be character-level,
253 :     not block-level, since the description is going to appear in a list.
254 :    
255 :     =cut
256 :    
257 :     sub Description {
258 :     # Get the parameters.
259 :     my ($self) = @_;
260 :     # Return the result.
261 : parrello 1.4 return "Search for genes in a specific genome with specified property values.";
262 : parrello 1.1 }
263 :    
264 :     1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3