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

Annotation of /Sprout/SHPropSearch.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3