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

Annotation of /Sprout/SHPropSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (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.7 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 : parrello 1.7 my $resultCount = $shelp->Find();
87 : parrello 1.1
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 variable to store the property value HTML.
155 :     my @extraCols = ();
156 :     # Denote that we currently don't have a feature.
157 :     my $fid = undef;
158 :     # Create the query.
159 :     my $query = $sprout->Get(['HasFeature', 'Feature', 'HasProperty', 'Property'],
160 :     "Property(id) IN (" . join(",", @propIDs) .
161 :     ") AND HasFeature(from-link) = ? ORDER BY Feature(id)",
162 :     [$genomeID]);
163 :     # Loop through the query results. The same feature may appear multiple times,
164 :     # but all the multiples will be grouped together.
165 : parrello 1.5 my $savedRow;
166 : parrello 1.1 while (my $row = $query->Fetch()) {
167 :     # Get the feature ID;
168 : parrello 1.5 my $newFid = $row->PrimaryValue('Feature(id)');
169 : parrello 1.1 # Check to see if we have a new feature coming in. Note we check for undef
170 :     # to avoid a run-time warning.
171 :     if (! defined($fid) || $newFid ne $fid) {
172 :     if (defined($fid)) {
173 :     # Here we have an old feature to output.
174 : parrello 1.5 $self->DumpFeature($rhelp, $savedRow, \@extraCols);
175 : parrello 1.1 $retVal++;
176 :     }
177 : parrello 1.5 # Clear the property value list.
178 : parrello 1.1 @extraCols = ();
179 : parrello 1.5 # Save this as the currently-active feature.
180 :     $savedRow = $row;
181 : parrello 1.1 $fid = $newFid;
182 :     }
183 :     # Get this row's property data for the extra column.
184 :     my ($name, $value, $url) = $row->Values(['Property(property-name)',
185 :     'Property(property-value)',
186 :     'HasProperty(evidence)']);
187 :     # If the evidence is a URL, format it as a link; otherwise, ignore it.
188 :     if ($url =~ m!http://!) {
189 :     push @extraCols, $cgi->a({href => $url}, $value);
190 :     } else {
191 :     push @extraCols, $value;
192 :     }
193 :     }
194 :     # If there's a feature still in the buffer, write it here.
195 :     if (defined $fid) {
196 : parrello 1.5 $self->DumpFeature($rhelp, $savedRow, \@extraCols);
197 : parrello 1.1 $retVal++;
198 :     }
199 :     # Close the session file.
200 :     $self->CloseSession();
201 :     }
202 :     }
203 :     # Return the result count.
204 :     return $retVal;
205 :     }
206 :    
207 :     =head3 DumpFeature
208 :    
209 : parrello 1.7 $shelp->DumpFeature($rhelp, $record, \@extraCols);
210 : parrello 1.1
211 :     Write the data for the current feature to the output.
212 :    
213 :     =over 4
214 :    
215 : parrello 1.5 =item rhelp
216 :    
217 :     Feature result helper.
218 :    
219 :     =item record
220 : parrello 1.1
221 : parrello 1.5 B<ERDBObject> containing the feature.
222 : parrello 1.1
223 :     =item extraCols
224 :    
225 :     Reference to a list of extra column data.
226 :    
227 :     =back
228 :    
229 :     =cut
230 :    
231 :     sub DumpFeature {
232 :     # Get the parameters.
233 : parrello 1.5 my ($self, $rhelp, $record, $extraCols) = @_;
234 : parrello 1.1 # Format the extra column data.
235 :     my $extraColumn = join(", ", @{$extraCols});
236 :     # Add the extra column data.
237 : parrello 1.5 $rhelp->PutExtraColumns(values => $extraColumn);
238 :     # Compute the sort key and the feature ID.
239 :     my $sortKey = $rhelp->SortKey($record);
240 :     my $fid = $record->PrimaryValue('Feature(id)');
241 : parrello 1.1 # Put everything to the output.
242 : parrello 1.5 $rhelp->PutData($sortKey, $fid, $record);
243 : parrello 1.1 }
244 :    
245 :     =head3 Description
246 :    
247 : parrello 1.7 my $htmlText = $shelp->Description();
248 : parrello 1.1
249 :     Return a description of this search. The description is used for the table of contents
250 :     on the main search tools page. It may contain HTML, but it should be character-level,
251 :     not block-level, since the description is going to appear in a list.
252 :    
253 :     =cut
254 :    
255 :     sub Description {
256 :     # Get the parameters.
257 :     my ($self) = @_;
258 :     # Return the result.
259 : parrello 1.4 return "Search for genes in a specific genome with specified property values.";
260 : parrello 1.1 }
261 :    
262 : parrello 1.7 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3