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

Annotation of /Sprout/SHPropSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package SHPropSearch;
4 :    
5 :     use strict;
6 :     use Tracer;
7 : parrello 1.8 use CGI qw(-nosticky);
8 : parrello 1.1 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 : parrello 1.8 push @rows, CGI::Tr(CGI::td({valign => "top"}, "Genome"),
61 :     CGI::td({colspan => 2}, $genomeMenu));
62 : parrello 1.1 # 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 : parrello 1.8 push @rows, CGI::Tr(CGI::td("Name=Value ($i)"),
69 :     CGI::td({colspan => 2}, CGI::textfield(-name => 'propertyPair',
70 : parrello 1.1 -value => $thisPair,
71 :     -size => 40)));
72 :     }
73 :     # Finally, the submit row.
74 :     push @rows, $self->SubmitRow();
75 :     # Build the form table.
76 :     $retVal .= $self->MakeTable(\@rows);
77 :     # Close the form.
78 :     $retVal .= $self->FormEnd();
79 :     # Return the result.
80 :     return $retVal;
81 :     }
82 :    
83 :     =head3 Find
84 :    
85 : parrello 1.7 my $resultCount = $shelp->Find();
86 : parrello 1.1
87 :     Conduct a search based on the current CGI query parameters. The search results will
88 :     be written to the session cache file and the number of results will be
89 :     returned. If the search parameters are invalid, a result count of C<undef> will be
90 :     returned and a result message will be stored in this object describing the problem.
91 :    
92 :     =cut
93 :    
94 :     sub Find {
95 :     my ($self) = @_;
96 :     # Get the CGI and Sprout objects.
97 :     my $cgi = $self->Q();
98 :     my $sprout = $self->DB();
99 :     # Declare the return variable. If it remains undefined, the caller will
100 :     # know that an error occurred.
101 :     my $retVal;
102 :     # Insure we have a genome.
103 :     my ($genomeID) = $self->GetGenomes('genome');
104 :     if (! $genomeID) {
105 :     $self->SetMessage("No genome was specified.");
106 :     } else {
107 :     # Now we verify the property filters. First we get the specified pairs.
108 :     my @props = $cgi->param('propertyPair');
109 :     # We'll put the property IDs found into this list.
110 :     my @propIDs = ();
111 :     # We'll accumulate error messages in this list.
112 :     my @errors = ();
113 :     # Loop through the specified pairs.
114 :     for my $prop (@props) {
115 :     # Only proceed if we have something.
116 :     if ($prop) {
117 :     # Separate the name and value.
118 :     if ($prop =~ /^\s*(\w+)\s*=\s*(.*)\s*$/) {
119 :     my ($name, $value) = ($1, $2);
120 :     # Verify that they exist.
121 :     my ($id) = $sprout->GetFlat(['Property'],
122 :     "Property(property-name) = ? AND Property(property-value) = ?",
123 :     [$name, $value], 'Property(id)');
124 :     # If they do, save the ID.
125 :     if ($id) {
126 :     push @propIDs, $id;
127 :     }
128 :     } else {
129 :     # Here the format is wrong.
130 :     push @errors, "Could not parse \"$prop\" into a name-value pair.";
131 :     }
132 :     }
133 :     }
134 :     # Insure we have some values and that there are no errors.
135 :     if (@errors) {
136 :     $self->SetMessage(join(" ", @errors));
137 :     } elsif (! @propIDs) {
138 :     $self->SetMessage("None of the name-value pairs specified exist in the database.");
139 :     } else {
140 :     # If we are here, then we have a genome ($genomeID) and a list
141 :     # of desired property IDs (@propIDs). That means we can search.
142 : parrello 1.5 # Create the result helper.
143 :     my $rhelp = RHFeatures->new($self);
144 :     # Set the default columns.
145 :     $self->DefaultColumns($rhelp);
146 :     # Add the value columm at the front.
147 :     $rhelp->AddExtraColumn(values => 0, title => 'Values', download => 'list',
148 :     style => 'leftAlign');
149 : parrello 1.1 # Initialize the session file.
150 : parrello 1.5 $self->OpenSession($rhelp);
151 : parrello 1.1 # Initialize the result counter.
152 :     $retVal = 0;
153 :     # Create a variable to store the property value HTML.
154 :     my @extraCols = ();
155 :     # Denote that we currently don't have a feature.
156 :     my $fid = undef;
157 :     # Create the query.
158 :     my $query = $sprout->Get(['HasFeature', 'Feature', 'HasProperty', 'Property'],
159 :     "Property(id) IN (" . join(",", @propIDs) .
160 :     ") AND HasFeature(from-link) = ? ORDER BY Feature(id)",
161 :     [$genomeID]);
162 :     # Loop through the query results. The same feature may appear multiple times,
163 :     # but all the multiples will be grouped together.
164 : parrello 1.5 my $savedRow;
165 : parrello 1.1 while (my $row = $query->Fetch()) {
166 :     # Get the feature ID;
167 : parrello 1.5 my $newFid = $row->PrimaryValue('Feature(id)');
168 : parrello 1.1 # Check to see if we have a new feature coming in. Note we check for undef
169 :     # to avoid a run-time warning.
170 :     if (! defined($fid) || $newFid ne $fid) {
171 :     if (defined($fid)) {
172 :     # Here we have an old feature to output.
173 : parrello 1.5 $self->DumpFeature($rhelp, $savedRow, \@extraCols);
174 : parrello 1.1 $retVal++;
175 :     }
176 : parrello 1.5 # Clear the property value list.
177 : parrello 1.1 @extraCols = ();
178 : parrello 1.5 # Save this as the currently-active feature.
179 :     $savedRow = $row;
180 : parrello 1.1 $fid = $newFid;
181 :     }
182 :     # Get this row's property data for the extra column.
183 :     my ($name, $value, $url) = $row->Values(['Property(property-name)',
184 :     'Property(property-value)',
185 :     'HasProperty(evidence)']);
186 :     # If the evidence is a URL, format it as a link; otherwise, ignore it.
187 :     if ($url =~ m!http://!) {
188 : parrello 1.8 push @extraCols, CGI::a({href => $url}, $value);
189 : parrello 1.1 } else {
190 :     push @extraCols, $value;
191 :     }
192 :     }
193 :     # If there's a feature still in the buffer, write it here.
194 :     if (defined $fid) {
195 : parrello 1.5 $self->DumpFeature($rhelp, $savedRow, \@extraCols);
196 : parrello 1.1 $retVal++;
197 :     }
198 :     # Close the session file.
199 :     $self->CloseSession();
200 :     }
201 :     }
202 :     # Return the result count.
203 :     return $retVal;
204 :     }
205 :    
206 :     =head3 DumpFeature
207 :    
208 : parrello 1.7 $shelp->DumpFeature($rhelp, $record, \@extraCols);
209 : parrello 1.1
210 :     Write the data for the current feature to the output.
211 :    
212 :     =over 4
213 :    
214 : parrello 1.5 =item rhelp
215 :    
216 :     Feature result helper.
217 :    
218 :     =item record
219 : parrello 1.1
220 : parrello 1.5 B<ERDBObject> containing the feature.
221 : parrello 1.1
222 :     =item extraCols
223 :    
224 :     Reference to a list of extra column data.
225 :    
226 :     =back
227 :    
228 :     =cut
229 :    
230 :     sub DumpFeature {
231 :     # Get the parameters.
232 : parrello 1.5 my ($self, $rhelp, $record, $extraCols) = @_;
233 : parrello 1.1 # Format the extra column data.
234 :     my $extraColumn = join(", ", @{$extraCols});
235 :     # Add the extra column data.
236 : parrello 1.5 $rhelp->PutExtraColumns(values => $extraColumn);
237 :     # Compute the sort key and the feature ID.
238 :     my $sortKey = $rhelp->SortKey($record);
239 :     my $fid = $record->PrimaryValue('Feature(id)');
240 : parrello 1.1 # Put everything to the output.
241 : parrello 1.5 $rhelp->PutData($sortKey, $fid, $record);
242 : parrello 1.1 }
243 :    
244 :     =head3 Description
245 :    
246 : parrello 1.7 my $htmlText = $shelp->Description();
247 : parrello 1.1
248 :     Return a description of this search. The description is used for the table of contents
249 :     on the main search tools page. It may contain HTML, but it should be character-level,
250 :     not block-level, since the description is going to appear in a list.
251 :    
252 :     =cut
253 :    
254 :     sub Description {
255 :     # Get the parameters.
256 :     my ($self) = @_;
257 :     # Return the result.
258 : parrello 1.4 return "Search for genes in a specific genome with specified property values.";
259 : parrello 1.1 }
260 :    
261 : parrello 1.7 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3