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

Annotation of /Sprout/SHDrugSearch.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 SHDrugSearch;
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 : parrello 1.7 =head1 Drug Target PDB Docking Results Search Helper
17 : parrello 1.1
18 :     =head2 Introduction
19 :    
20 : parrello 1.7 This search helper will display all the docking results for a particular
21 :     PDB. Most search helpers return a list of features. This one returns
22 :     a list of ligands. As a result, it is structurally very different. In
23 :     particular, all the columns are returned as extras.
24 : parrello 1.1
25 : parrello 1.7 This search has the following extra parameters.
26 : parrello 1.1
27 :     =over 4
28 :    
29 : parrello 1.7 =item PDB
30 : parrello 1.1
31 : parrello 1.7 ID of the PDB whose information is to be displayed.
32 : parrello 1.3
33 : parrello 1.1 =back
34 :    
35 : parrello 1.2 =cut
36 :    
37 :     # Table of drug topic category codes.
38 :     my %CodeTable = (
39 : parrello 1.5 'ES' => 'Essential',
40 : parrello 1.6 'ES-X' => 'Essential',
41 :     'ES-L' => 'Essential',
42 :     'KA-T' => 'Antibiotic Target',
43 :     'KA-I' => 'Antibiotic Inhibitor',
44 : parrello 1.5 'VA' => 'Virulence Associated',
45 : parrello 1.6 'VA-K' => 'Virulence Associated',
46 :     'VA-P' => 'Virulence Assocated',
47 :     'TX-K' => 'Toxin',
48 :     'TX-B' => 'Toxin',
49 :     'SA-A' => 'Surface Associated',
50 : parrello 1.5 'SA-P' => 'Surface Associated',
51 :     'SA-S' => 'Surface Associated',
52 :     'SA' => 'Surface Associated',
53 : parrello 1.6 'SE-P' => 'Secreted Protein',
54 : parrello 1.5 'SE' => 'Secreted Protein',
55 : parrello 1.2 );
56 :    
57 : parrello 1.5 =head3 GetCategory
58 :    
59 :     C<< my $description = SHDrugSearch::GetCategory($code); >>
60 :    
61 :     Return the description of the specified category code.
62 :    
63 :     =over 4
64 :    
65 :     =item code
66 :    
67 :     Category code to convert.
68 :    
69 :     =item RETURN
70 :    
71 :     Returns the description of the specified category code, as taken from the C<CodeTable> hash.
72 :    
73 :     =back
74 :    
75 :     =cut
76 :    
77 :     sub GetCategory {
78 :     # Get the parameters.
79 :     my ($code) = @_;
80 :     # Convert to upper case.
81 :     my $catCode = uc $code;
82 :     # Trim spaces.
83 :     $catCode =~ s/\s+//g;
84 :     # Extract it from the hash table.
85 :     my $retVal = $CodeTable{$catCode};
86 :     # Check for a not-found condition.
87 :     if (! $retVal) {
88 :     $retVal = "Unknown Code $catCode";
89 :     }
90 :     # Return the result.
91 :     return $retVal;
92 :     }
93 :    
94 : parrello 1.7 =head3 PDBLink
95 :    
96 :     C<< my $pdbHtml = SHDrugSearch::PDBLink($cgi, $pdbID); >>
97 :    
98 :     This method converts a PDB ID to a hyperlink into the PDB web site.
99 :    
100 :     =over 4
101 :    
102 :     =item cgi
103 :    
104 :     CGI object to be used to create the HTML.
105 :    
106 :     =item pdbID
107 :    
108 :     ID of the PDB to be hyperlinked.
109 :    
110 :     =item RETURN
111 :    
112 :     Returns a hyperlinked PDB ID that points to the PDB's page on the RCSB web site.
113 :    
114 :     =back
115 :    
116 :     =cut
117 :    
118 :     sub PDBLink {
119 :     # Get the parameters.
120 :     my ($cgi, $pdbID) = @_;
121 :     # Compose the link.
122 :     my $retVal = $cgi->a({href => "http://www.rcsb.org/pdb/explore.do?structureId=$pdbID",
123 :     title => "display this protein's page in the Protein Data Bank",
124 :     alt => "display this protein's page in the Protein Data Bank",
125 :     target => "_blank"}, $pdbID);
126 :    
127 :     # Return the result.
128 :     return $retVal;
129 :     }
130 :    
131 : parrello 1.1 =head2 Virtual Methods
132 :    
133 :     =head3 Form
134 :    
135 : parrello 1.3 C<< my $html = $shelp->Form(); >>
136 : parrello 1.1
137 :     Generate the HTML for a form to request a new search.
138 :    
139 :     =cut
140 :    
141 :     sub Form {
142 :     # Get the parameters.
143 :     my ($self) = @_;
144 :     # Get the CGI and sprout objects.
145 :     my $cgi = $self->Q();
146 :     my $sprout = $self->DB();
147 :     # Start the form.
148 : parrello 1.7 my $retVal = $self->FormStart("Select PDB");
149 :     # Get a list of all the PDBs with docking results.
150 :     my @pdbData = $sprout->GetAll(['PDB'], "PDB(docking-count) > 0 ORDER BY PDB(docking-count) DESC",
151 :     [], ['PDB(id)', 'PDB(docking-count)']);
152 :     # See if there's already a PDB selected.
153 :     my $defaultPDB = $cgi->param('PDB');
154 :     # Create the PDB selection strings.
155 : parrello 1.8 my %pdbStrings = map { $_->[0] => "$_->[0], $_->[1] docking results" } @pdbData;
156 :     my @pdbNames = map { $_->[0] } @pdbData;
157 : parrello 1.7 # Compute the number of rows to display in the selection list.
158 : parrello 1.8 my $rowCount = (scalar(@pdbNames) < 20 ? scalar(@pdbNames) : 20);
159 : parrello 1.7 # Convert the PDB list into a selection list.
160 : parrello 1.8 my $menu = $cgi->popup_menu(-name => 'PDB', -values => \@pdbNames,
161 :     -labels => \%pdbStrings,
162 : parrello 1.7 -default => $defaultPDB, -rows => $rowCount);
163 :     # Build a table from the PDB list and the submit row.
164 : parrello 1.1 my @rows = ($cgi->Tr($cgi->th('Project'), $cgi->td($menu)),
165 : parrello 1.3 $self->SubmitRow()
166 :     );
167 : parrello 1.1 $retVal .= $self->MakeTable(\@rows);
168 :     # Close the form.
169 :     $retVal .= $self->FormEnd();
170 :     # Return the result.
171 :     return $retVal;
172 :     }
173 :    
174 :     =head3 Find
175 :    
176 :     C<< my $resultCount = $shelp->Find(); >>
177 :    
178 :     Conduct a search based on the current CGI query parameters. The search results will
179 :     be written to the session cache file and the number of results will be
180 :     returned. If the search parameters are invalid, a result count of C<undef> will be
181 :     returned and a result message will be stored in this object describing the problem.
182 : parrello 1.7 This search does not return features, so it calls B<WriteColumnHeaders> and
183 :     B<WriteColumnData> instead of the handier B<PutFeature>
184 : parrello 1.1
185 :     =cut
186 :    
187 :     sub Find {
188 :     my ($self) = @_;
189 :     # Get the CGI and Sprout objects.
190 :     my $cgi = $self->Q();
191 :     my $sprout = $self->DB();
192 :     # Declare the return variable. If it remains undefined, the caller will
193 :     # know that an error occurred.
194 :     my $retVal;
195 : parrello 1.7 # Insure a PDB is selected.
196 :     my $pdbID = $cgi->param('PDB');
197 :     if (! $pdbID) {
198 :     $self->SetMessage("No PDB specified.");
199 : parrello 1.1 } else {
200 :     # Initialize the session file.
201 :     $self->OpenSession();
202 :     # Initialize the result counter.
203 :     $retVal = 0;
204 : parrello 1.8 $self->PrintLine("Finding docking results for $pdbID.");
205 : parrello 1.7 # Get a query that will return the docking results for this PDB.
206 :     my $query= $sprout->Get(['DocksWith', 'Ligand'],
207 : parrello 1.8 "DocksWith(from-link) = ? ORDER BY DocksWith(total-energy)",
208 : parrello 1.7 [$pdbID]);
209 :     # Write the column headers.
210 : parrello 1.8 $self->WriteColumnHeaders("ZINC ID", "Total Energy", "Electrostatic", "Van der Waals", "Tool");
211 :     $self->PrintLine("Processing results.");
212 : parrello 1.1 # Loop through the results.
213 :     while (my $record = $query->Fetch()) {
214 : parrello 1.7 # Get the data for this row.
215 : parrello 1.8 my ($id, $name, $total, $electro, $vander, $tool) = $record->Values(['Ligand(id)', 'Ligand(name)',
216 :     'DocksWith(total-energy)',
217 :     'DocksWith(electrostatic-energy)',
218 :     'DocksWith(vanderwalls-energy)',
219 :     'DocksWith(tool)']);
220 :     # Format the energy results so they don't look so awful.
221 :     my @data = map { sprintf('%.2f', $_) } ($total, $electro, $vander);
222 :     # Create a tooltip for the ligand name.
223 :     my $linkedID = $cgi->a({ href => "http://blaster.docking.org/zinc/srchdbk.pl?zinc=$id;go=Query",
224 :     title => $name }, $id);
225 :     # Finally, we must compute the sort key. We're getting the records in the correct order, so
226 :     # the sort key is the ordinal of this record, which we are keeping in $retVal.
227 :     my $key = $retVal;
228 :     # Write everything to the session file.
229 :     $self->WriteColumnData($retVal, $id, $linkedID, @data, $tool);
230 : parrello 1.7 # See if we need to update the user.
231 : parrello 1.8 $retVal++;
232 :     if ($retVal % 1000 == 0) {
233 :     $self->PrintLine("$retVal ligands processed.");
234 : parrello 1.1 }
235 :     }
236 : parrello 1.8 Trace("$retVal rows processed.") if T(3);
237 : parrello 1.1 # Close the session file.
238 :     $self->CloseSession();
239 :     }
240 :     # Return the result count.
241 :     return $retVal;
242 :     }
243 :    
244 :     =head3 DefaultFeatureColumns
245 :    
246 :     C<< my @cols = $shelp->DefaultFeatureColumns(); >>
247 :    
248 :     This method returns a list of the descriptors for the columns to be
249 :     displayed by this search, overriding the standard column set.
250 :    
251 :     =cut
252 :    
253 :     sub DefaultFeatureColumns {
254 :     # Get the parameters.
255 :     my ($self) = @_;
256 :     # Return the result.
257 :     return qw(orgName function protlink);
258 :     }
259 :    
260 :     =head3 Description
261 :    
262 :     C<< my $htmlText = $shelp->Description(); >>
263 :    
264 :     Return a description of this search. The description is used for the table of contents
265 :     on the main search tools page. It may contain HTML, but it should be character-level,
266 :     not block-level, since the description is going to appear in a list.
267 :    
268 :     =cut
269 :    
270 :     sub Description {
271 :     # Get the parameters.
272 :     my ($self) = @_;
273 :     # Return the result.
274 : parrello 1.8 return "Show the docking results for a specific PDB.";
275 : parrello 1.1 }
276 :    
277 : parrello 1.7 =head3 SearchTitle
278 :    
279 :     C<< my $titleHtml = $shelp->SearchTitle(); >>
280 :    
281 :     Return the display title for this search. The display title appears above the search results.
282 :     If no result is returned, no title will be displayed. The result should be an html string
283 :     that can be legally put inside a block tag such as C<h3> or C<p>.
284 :    
285 :     =cut
286 :    
287 :     sub SearchTitle {
288 :     # Get the parameters.
289 :     my ($self) = @_;
290 :     # Compute the title. We extract the PDB ID from the query parameters.
291 :     my $cgi = $self->Q();
292 :     my $pdbID = $cgi->param('PDB');
293 :     my $retVal = "Docking Results for $pdbID";
294 :     # Return it.
295 :     return $retVal;
296 :     }
297 :    
298 :     =head3 DownloadFormatAvailable
299 :    
300 :     C<< my $okFlag = $shelp->DownloadFormatAvailable($format); >>
301 :    
302 :     This method returns TRUE if a specified download format is legal for this type of search
303 :     and FALSE otherwise. For any feature-based search, there is no need to override this
304 :     method.
305 :    
306 :     =over 4
307 :    
308 :     =item format
309 :    
310 :     Download format type code.
311 :    
312 :     =item RETURN
313 :    
314 :     Returns TRUE if the download format is legal for this search and FALSE otherwise.
315 :    
316 :     =back
317 :    
318 :     =cut
319 :    
320 :     sub DownloadFormatAvailable {
321 :     # Get the parameters.
322 :     my ($self, $format) = @_;
323 :     # Declare the return variable.
324 :     my $retVal = ($format eq 'tbl');
325 :     # Return the result.
326 :     return $retVal;
327 :     }
328 :    
329 : parrello 1.8 =head3 ColumnTitle
330 :    
331 :     C<< my $title = $shelp->ColumnTitle($colName); >>
332 :    
333 :     Return the column heading title to be used for the specified column name.
334 :     In this case, we just return the column name unmodified.
335 :    
336 :     =over 4
337 :    
338 :     =item colName
339 :    
340 :     Name of the desired column.
341 :    
342 :     =item RETURN
343 :    
344 :     Returns the title to be used as the column header for the named column.
345 :    
346 :     =back
347 :    
348 :     =cut
349 :    
350 :     sub ColumnTitle {
351 :     my ($self, $colName) = @_;
352 :     return $colName;
353 :     }
354 :    
355 : parrello 1.7
356 : parrello 1.1 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3