[Bio] / FigWebServices / index.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.30 - (view) (download)

1 : efrank 1.1 use FIG;
2 :     my $fig = new FIG;
3 :    
4 :     use HTML;
5 :     use strict;
6 :     use CGI;
7 :     my $cgi = new CGI;
8 :    
9 : overbeek 1.28 my($map,@orgs,$user,$map,$org,$made_by,$from_func,$to_func);
10 : efrank 1.1
11 :     if (0)
12 :     {
13 :     print $cgi->header;
14 :     my @params = $cgi->param;
15 :     print "<pre>\n";
16 :     foreach $_ (@params)
17 :     {
18 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
19 :     }
20 :     print "=======\n";
21 :     foreach $_ (sort keys(%ENV))
22 :     {
23 :     print "$_\t$ENV{$_}\n";
24 :     }
25 :     exit;
26 :     }
27 :    
28 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
29 :    
30 :     my $html = [];
31 : golsen 1.23
32 : efrank 1.5 my @ver = `cat $FIG_Config::fig_disk/CURRENT_RELEASE`;
33 : golsen 1.21 chomp $ver[0];
34 : disz 1.26 my $p2p_url = &FIG::cgi_url . "/p2p/seed_update_page.cgi";
35 :     my $new_p2p_url = &FIG::cgi_url . "/p2p/new_seed_update_page.cgi";
36 : olson 1.24 my $host = $fig->get_local_hostname();
37 : efrank 1.5 push(@$html,
38 : olson 1.24 "You are currently running SEED version <b>$ver[0]</b> on $host<br>",
39 : disz 1.26 "To start a peer-to-peer update, <a href=$p2p_url>click here</a><br>\n",
40 :     "To start a new peer-to-peer update, <a href=$new_p2p_url>click here</a><br>\n"
41 : efrank 1.5 );
42 :    
43 : overbeek 1.30 my($pattern,$seq_pat,$tool,$ids);
44 : efrank 1.1 my $user = $cgi->param('user');
45 :     if (! $user) { $user = "" }
46 :    
47 : overbeek 1.28 if ($cgi->param('Search for Genes Matching an Occurrence Profile or Common to a Set of Organisms'))
48 : efrank 1.1 {
49 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Phylogenetic Signatures</TITLE>\n";
50 : efrank 1.1 my $url = $cgi->url;
51 :     $ENV{"REQUEST_METHOD"} = "GET";
52 :     $ENV{"QUERY_STRING"} = "user=$user";
53 :     my @out = `./sigs.cgi`;
54 :     &HTML::trim_output(\@out);
55 :     push(@$html,@out);
56 :     }
57 : overbeek 1.17 #-----------------------------------------------------------------------
58 :     # Search (text) || Find Genes in Org that Might Play the Role
59 :     #-----------------------------------------------------------------------
60 : efrank 1.1 elsif (($pattern = $cgi->param('pattern')) && ($cgi->param('Search') || $cgi->param('Find Genes in Org that Might Play the Role')))
61 :     {
62 : overbeek 1.17 # Remove leading and trailing spaces from pattern -- GJO:
63 :     $pattern =~ s/^\s+//;
64 :     $pattern =~ s/\s+$//;
65 : efrank 1.1 if ($cgi->param('Find Genes in Org that Might Play the Role') &&
66 :     (@orgs = $cgi->param('korgs')) && (@orgs == 1))
67 :     {
68 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Genes in that Might Play Specific Role</TITLE>\n";
69 : efrank 1.1 @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
70 :     $ENV{"REQUEST_METHOD"} = "GET";
71 :     $ENV{"QUERY_STRING"} = "user=$user&request=find_in_org&role=$pattern&org=$orgs[0]";
72 :     my @out = `./pom.cgi`;
73 :     print join("",@out);
74 :     exit;
75 :     }
76 :     else
77 :     {
78 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Search Results</TITLE>\n";
79 : golsen 1.22 &show_indexed_objects($fig, $cgi, $html, $pattern);
80 : efrank 1.1 }
81 :     }
82 : overbeek 1.17 #-----------------------------------------------------------------------
83 :     # Metabolic Overview
84 :     #-----------------------------------------------------------------------
85 : efrank 1.1 elsif (($map = $cgi->param('kmap')) && $cgi->param('Metabolic Overview'))
86 :     {
87 :     $map =~ s/^.*\((MAP\d+)\).*$/$1/;
88 :     @orgs = $cgi->param('korgs');
89 :     @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
90 :     $ENV{"REQUEST_METHOD"} = "GET";
91 :     if (@orgs > 0)
92 :     {
93 :     $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$orgs[0]";
94 :     }
95 :     else
96 :     {
97 :     $ENV{"QUERY_STRING"} = "user=$user&map=$map";
98 :     }
99 :    
100 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Metabolic Overview</TITLE>\n";
101 : efrank 1.1 my @out = `./show_kegg_map.cgi`;
102 :     &HTML::trim_output(\@out);
103 : golsen 1.23 push( @$html, "<br>\n", @out );
104 : efrank 1.1 }
105 : overbeek 1.17
106 :     #-----------------------------------------------------------------------
107 :     # Search for Matches (sequence or pattern)
108 :     #-----------------------------------------------------------------------
109 : efrank 1.1 elsif (($seq_pat = $cgi->param('seq_pat')) &&
110 :     ($tool = $cgi->param('Tool')) &&
111 :     $cgi->param('Search for Matches'))
112 :     {
113 : overbeek 1.30 @orgs = $cgi->param('korgs');
114 :     if (@orgs > 0)
115 :     {
116 :     @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
117 :     }
118 :     else
119 :     {
120 :     @orgs = ("");
121 :     }
122 :    
123 : efrank 1.1 if ($tool =~ /blast/)
124 :     {
125 : golsen 1.23 unshift @$html, "<TITLE>The SEED: BLAST Search Results</TITLE>\n";
126 : efrank 1.1 &run_blast($fig,$cgi,$html,$orgs[0],$tool,$seq_pat);
127 :     }
128 :     elsif ($tool =~ /Protein scan_for_matches/)
129 :     {
130 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Protein Pattern Match Results</TITLE>\n";
131 : efrank 1.1 &run_prot_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
132 :     }
133 :     elsif ($tool =~ /DNA scan_for_matches/)
134 :     {
135 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Nucleotide Pattern Match Results</TITLE>\n";
136 : efrank 1.1 &run_dna_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
137 :     }
138 :     }
139 : overbeek 1.7 elsif (($made_by = $cgi->param('made_by')) && $cgi->param('Extract Assignments'))
140 :     {
141 :     &export_assignments($fig,$cgi,$html,$made_by);
142 :     }
143 : overbeek 1.28 elsif ($cgi->param('Generate Assignments via Translation') &&
144 :     ($from_func = $cgi->param('from_func')) &&
145 :     ($to_func = $cgi->param('to_func')))
146 :     {
147 :     &translate_assignments($fig,$cgi,$html,$from_func,$to_func);
148 :     }
149 : overbeek 1.30 elsif ($cgi->param('Extract Matched Sequences') && ($ids = $cgi->param('ids')))
150 :     {
151 :     my @ids = split(/,/,$ids);
152 :     my($list_to,$i);
153 :     if ($list_to = $cgi->param('list_to'))
154 :     {
155 :     for ($i=0; ($i < @ids) && ($ids[$i] ne $list_to); $i++) {}
156 :     if ($i < @ids)
157 :     {
158 :     $#ids = $i;
159 :     }
160 :     }
161 :    
162 :     my($id,$seq,$i,$func);
163 :     push(@$html,$cgi->pre);
164 :    
165 :     foreach $id (@ids)
166 :     {
167 :     if ($seq = $fig->get_translation($id))
168 :     {
169 :     $func = $fig->function_of($id);
170 :     push(@$html,">$id $func\n");
171 :     for ($i=0; ($i < length($seq)); $i += 60)
172 :     {
173 :     if ($i > (length($seq) - 60))
174 :     {
175 :     push(@$html,substr($seq,$i) . "\n");
176 :     }
177 :     else
178 :     {
179 :     push(@$html,substr($seq,$i,60) . "\n");
180 :     }
181 :     }
182 :     }
183 :     }
184 :     push(@$html,$cgi->end_pre);
185 :     }
186 : overbeek 1.17
187 :     #-----------------------------------------------------------------------
188 :     # Initial search page
189 :     #-----------------------------------------------------------------------
190 : efrank 1.1 else
191 :     {
192 : golsen 1.23 unshift @$html, "<TITLE>The SEED: Entry Page</TITLE>\n";
193 : efrank 1.1 &show_initial($fig,$cgi,$html);
194 :     }
195 :     &HTML::show_page($cgi,$html,1);
196 :    
197 : overbeek 1.17
198 :     #==============================================================================
199 :     # Initial page (alias search)
200 :     #==============================================================================
201 :    
202 : efrank 1.1 sub show_initial {
203 :     my($fig,$cgi,$html) = @_;
204 :     my($map,$name,$olrg,$gs);
205 :    
206 : overbeek 1.2 my($a,$b,$e,$v) = $fig->genome_counts;
207 : overbeek 1.6 push(@$html,$cgi->h2("Contains $a archaeal, $b bacterial, $e eukaryotic, and $v viral genomes"));
208 :     my($a,$b,$e,$v) = $fig->genome_counts("complete");
209 :     push(@$html,$cgi->h2("Of these, $a archaeal, $b bacterial, and $e eukaryotic genomes are more-or-less complete"),$cgi->hr);
210 : overbeek 1.2
211 : efrank 1.1 my @maps = sort map { $map = $_; $name = $fig->map_name($map); "$name ($map)" } $fig->all_maps;
212 : overbeek 1.6 my @orgs = sort map { $org = $_; $gs = $fig->genus_species($org); "$gs ($org)" } $fig->genomes("complete",undef);
213 : efrank 1.1
214 :     push(@$html,
215 :     $cgi->start_form(-action => "index.cgi"),
216 :     $cgi->h1('Searching for Genes or Functional Roles Using Text'),
217 : overbeek 1.17 "<table><tr>",
218 :     "<td>Search Pattern: </td><td>",
219 :     $cgi->textfield(-name => "pattern", -size => 65),
220 :     "</td></tr><tr>",
221 :     "<td>User ID:</td><td>",
222 : efrank 1.1 $cgi->textfield(-name => "user", -size => 20),
223 : overbeek 1.17 " [optional] ",
224 :     "&nbsp; &nbsp; Max Genes: ",
225 :     $cgi->textfield(-name => "maxpeg", -size => 6, -value => 100),
226 :     "&nbsp; &nbsp; Max Roles: ",
227 :     $cgi->textfield(-name => "maxrole", -size => 6, -value => 100),
228 :     "</td></td></table>",
229 : efrank 1.1 $cgi->submit('Search'),
230 :     $cgi->reset('Clear'),
231 :     $cgi->hr,
232 : overbeek 1.17
233 : efrank 1.1 $cgi->h1('If You Need to Pick an Organism for Options Below'),
234 :     $cgi->scrolling_list(-name => 'korgs',
235 :     -values => [@orgs],
236 :     -size => 10
237 :     ),
238 :     $cgi->hr,
239 : overbeek 1.17
240 : efrank 1.1 $cgi->h1('Finding Candidates for a Functional Role'),
241 :     "Make sure that you type the functional role you want to search for in the Search Pattern above",
242 :     $cgi->br,
243 :     $cgi->submit('Find Genes in Org that Might Play the Role'),
244 :     $cgi->hr,
245 : overbeek 1.17
246 : efrank 1.1 $cgi->h1('Metabolic Overviews (via KEGG) - Choose KEGG Map'),
247 :     $cgi->submit('Metabolic Overview'),
248 :     $cgi->br,
249 :     $cgi->br,
250 :     $cgi->scrolling_list(-name => 'kmap',
251 :     -values => [@maps],
252 :     -size => 10
253 :     ),
254 :     $cgi->hr,
255 : overbeek 1.17
256 : efrank 1.1 $cgi->h1('Searching DNA or Protein Sequences (in a selected organism)'),
257 : golsen 1.29 "<TABLE>\n",
258 :     " <TR>\n",
259 :     " <TD>Sequence/Pattern: </TD>",
260 :     " <TD>", $cgi->textarea(-name => 'seq_pat', -rows => 10, -cols => 70), "</TD>\n",
261 :     " </TR>\n",
262 :     " <TR>\n",
263 :     " <TD>Search Program: </TD>",
264 : overbeek 1.30 " <TD>", $cgi->popup_menu(-name => 'Tool', -values => ['blastp','blastx','blastn','tblastn','blastp against complete genomes','Protein scan_for_matches','DNA scan_for_matches'], -default => 'blastp'), "</TD>",
265 : golsen 1.29 " </TR>\n",
266 :     "</TABLE>\n",
267 : efrank 1.1 $cgi->submit('Search for Matches'),
268 :     $cgi->hr,
269 : overbeek 1.17
270 : overbeek 1.7 $cgi->h1('Exporting Assignments'),
271 :     "Extract assignments made by ",
272 :     $cgi->textfield(-name => "made_by", -size => 50),
273 :     $cgi->br,
274 : overbeek 1.15 "Save as user: ",
275 :     $cgi->textfield(-name => "save_user", -size => 50),
276 :     $cgi->br,
277 : overbeek 1.10 "After date (MM/DD/YYYY) ",
278 :     $cgi->textfield(-name => "after_date", -size => 15),
279 :     $cgi->br,
280 : overbeek 1.11 $cgi->checkbox(-label => 'tab-delimited Spreadsheet: ', -name => 'tabs', -value => 1),
281 :     $cgi->br,
282 :     $cgi->checkbox(-label => 'Save Assignments: ', -name => 'save_assignments', -value => 1),
283 : overbeek 1.7 $cgi->br,
284 :     $cgi->submit('Extract Assignments'),
285 : overbeek 1.28 $cgi->br, $cgi->br,
286 :     "Alternatively, you can generate a set of assignments as translations of existing assignments.",
287 :     $cgi->br,
288 :     "From: ",$cgi->textfield(-name => "from_func", -size => 60),
289 :     $cgi->br,
290 :     "To:&nbsp;&nbsp;&nbsp;&nbsp; ",$cgi->textfield(-name => "to_func", -size => 60),
291 :     $cgi->br,
292 :     $cgi->submit('Generate Assignments via Translation'),
293 : overbeek 1.7 $cgi->hr,
294 : efrank 1.1 $cgi->h1('Searching for Interesting Genes'),
295 : overbeek 1.28 $cgi->submit('Search for Genes Matching an Occurrence Profile or Common to a Set of Organisms'),
296 : overbeek 1.17 $cgi->end_form
297 : overbeek 1.14 );
298 :    
299 :     push(@$html,
300 :     $cgi->hr,
301 :     $cgi->h1('Process Saved Assignments Sets'),
302 :     $cgi->start_form(-action => "assignments.cgi"),
303 : overbeek 1.19 "Enter user: ",
304 : overbeek 1.14 $cgi->textfield(-name => "user", -size => 20),
305 :     $cgi->submit('Process Assignment Sets'),
306 : overbeek 1.17 $cgi->end_form
307 : efrank 1.1 );
308 :    
309 : overbeek 1.19 push(@$html,
310 :     $cgi->hr,
311 :     $cgi->h1('Work on Subsystems'),
312 :     $cgi->start_form(-action => "ssa.cgi"),
313 :     "Enter user: ",
314 :     $cgi->textfield(-name => "user", -size => 20),
315 :     $cgi->submit('Work on Subsystems'),
316 : overbeek 1.27 $cgi->end_form,
317 :     $cgi->h2('Try the New, Somewhat Experimental, Version'),
318 :     $cgi->start_form(-action => "ssa2.cgi"),
319 :     "Enter user: ",
320 :     $cgi->textfield(-name => "user", -size => 20),
321 :     $cgi->submit('Work on Subsystems'),
322 :     $cgi->end_form,
323 : overbeek 1.19 );
324 :    
325 : efrank 1.1 }
326 :    
327 : overbeek 1.17
328 :     #==============================================================================
329 :     # Indexed objects (text search)
330 :     #==============================================================================
331 :    
332 : efrank 1.1 sub show_indexed_objects {
333 : golsen 1.22 my($fig, $cgi, $html, $pattern) = @_;
334 :     my($msg, $i);
335 : efrank 1.1
336 :     if ($pattern =~ /^\s*(fig\|\d+\.\d+\.peg\.\d+)\s*$/)
337 :     {
338 :     my $peg = $1;
339 :     my $user = $cgi->param('user');
340 :     $user = $user ? $user : "";
341 :     $ENV{'REQUEST_METHOD'} = "GET";
342 :     $ENV{"QUERY_STRING"} = "prot=$peg\&user=$user";
343 :     $ENV{"REQUEST_URI"} =~ s/index.cgi/protein.cgi/;
344 :     my @prot_out = `./protein.cgi`;
345 :     &HTML::trim_output(\@prot_out);
346 :     push(@$html,@prot_out);
347 :     return;
348 :     }
349 :    
350 : overbeek 1.17 push( @$html, $cgi->br );
351 :     my( $peg_index_data, $role_index_data ) = $fig->search_index($pattern);
352 :     my $maxpeg = defined( $cgi->param("maxpeg") ) ? $cgi->param("maxpeg") : 100;
353 :     my $maxrole = defined( $cgi->param("maxrole") ) ? $cgi->param("maxrole") : 100;
354 : golsen 1.22 my $check_all = $cgi->param('Select all') || 0;
355 : overbeek 1.17
356 :     if ($maxpeg > 0)
357 :     {
358 :     push( @$html, $cgi->start_form(-action => "index.cgi"),
359 :     $cgi->hidden(-name => 'user', -value => $user),
360 :     $cgi->hidden(-name => 'pattern', -value => $pattern),
361 :     $cgi->hidden(-name => 'maxpeg', -value => $maxpeg),
362 : golsen 1.21 $cgi->hidden(-name => 'maxrole', -value => $maxrole),
363 : overbeek 1.17 $cgi->hidden(-name => 'Search', -value => 'Search'),
364 :     $cgi->submit( $check_all ? 'Deselect all' : 'Select all'),
365 :     $cgi->end_form
366 :     );
367 :    
368 :     push( @$html, $cgi->start_form( -method => 'post',
369 :     -target => "window$$",
370 :     -action => 'fid_checked.cgi'
371 :     ),
372 :     $cgi->hidden(-name => 'user', -value => $user),
373 : golsen 1.21 "For Selected (checked) sequences: ",
374 : overbeek 1.17 $cgi->submit('get sequences'),
375 :     $cgi->submit('view annotations'),
376 :     $cgi->br, $cgi->br
377 :     );
378 : efrank 1.1
379 : overbeek 1.17 my $n = @$peg_index_data;
380 :     if ($n > $maxpeg)
381 :     {
382 :     $msg = "Showing First $maxpeg Out of $n PEGs";
383 :     $#{$peg_index_data} = $maxpeg-1;
384 :     }
385 :     else
386 :     {
387 :     $msg = "Showing $n PEGs";
388 :     }
389 : efrank 1.1
390 : overbeek 1.17 my $col_hdrs = ["Sel","PEG","Organism","Aliases","Function","Who"];
391 :     my $tab = [ map { &format_peg_entry($fig,$cgi,$_,$check_all) } @$peg_index_data ];
392 :     push( @$html, &HTML::make_table($col_hdrs,$tab,$msg),
393 :     $cgi->br,
394 :     "For SELECTed (checked) sequences: ",
395 :     $cgi->submit('get sequences'),
396 :     $cgi->submit('view annotations'),
397 :     $cgi->br,
398 :     $cgi->end_form
399 :     );
400 : efrank 1.1 }
401 : overbeek 1.17
402 :     if ($maxrole > 0)
403 : efrank 1.1 {
404 : overbeek 1.17 my $n = @$role_index_data;
405 :     if ($n > $maxrole)
406 :     {
407 :     $msg = "Showing First $maxrole Out of $n Roles";
408 :     $#{$role_index_data} = $maxrole - 1;
409 :     }
410 :     else
411 :     {
412 :     $msg = "Showing $n Roles";
413 :     }
414 :    
415 :     if ( $maxpeg > 0 ) { push( @$html, $cgi->hr ) }
416 :     my $col_hdrs = ["Role"];
417 :     my $tab = [ map { &format_role_entry($fig,$cgi,$_) } @$role_index_data ];
418 :     push( @$html, &HTML::make_table($col_hdrs,$tab,$msg) );
419 : efrank 1.1 }
420 :     }
421 :    
422 :     sub format_peg_entry {
423 : overbeek 1.17 my( $fig, $cgi, $entry, $checked) = @_;
424 : efrank 1.1 my($i,$function,$who);
425 :    
426 :     my($peg,$gs,$aliases,@funcs) = @$entry;
427 : overbeek 1.17
428 : golsen 1.21 $gs =~ s/\s+\d+$//; # Org name comes with taxon_id appended (why?) -- GJO
429 : efrank 1.1
430 :     @funcs = map { $_ =~ s/^function:\s*//; $_ } @funcs;
431 :    
432 :     if ($aliases)
433 :     {
434 :     $aliases =~ s/^aliases://;
435 :     }
436 :     else
437 :     {
438 :     $aliases = "";
439 :     }
440 :    
441 : golsen 1.21 my $user = $cgi->param('user');
442 :     $user = $user ? $user : "";
443 :    
444 : efrank 1.1 if ($user)
445 :     {
446 :     for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#$user/); $i++) {}
447 :     if ($i < @funcs)
448 :     {
449 :     ($function,$who) = split(/\#/,$funcs[$i]);
450 :     }
451 :     }
452 : golsen 1.21
453 : efrank 1.1 if (! $function)
454 :     {
455 :     for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#master/); $i++) {}
456 :     if ($i < @funcs)
457 :     {
458 :     ($function,$who) = split(/\#/,$funcs[$i]);
459 :     }
460 :     }
461 :    
462 :     if ((! $function) && (@funcs > 0))
463 :     {
464 :     ($function,$who) = split(/\#/,$funcs[0]);
465 :     }
466 : golsen 1.21 my $box = "<input type=checkbox name=checked value=\"$peg\""
467 :     . ($checked ? " checked=1" : "")
468 : overbeek 1.17 . ">";
469 :     return [ $box, &HTML::fid_link($cgi,$peg), $gs, $aliases, $function, $who ];
470 : efrank 1.1 }
471 :    
472 :     sub format_role_entry {
473 :     my($fig,$cgi,$entry) = @_;
474 :    
475 :     return [&HTML::role_link($cgi,$entry)];
476 :     }
477 :    
478 :     sub run_prot_scan_for_matches {
479 :     my($fig,$cgi,$html,$org,$pat) = @_;
480 :     my($string,$peg,$beg,$end,$user,$col_hdrs,$tab,$i);
481 :    
482 :     my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
483 :     open(PAT,">$tmp_pat")
484 :     || die "could not open $tmp_pat";
485 :     $pat =~ s/[\s\012\015]+/ /g;
486 :     print PAT "$pat\n";
487 :     close(PAT);
488 :     my @out = `$FIG_Config::ext_bin/scan_for_matches -p $tmp_pat < $FIG_Config::organisms/$org/Features/peg/fasta`;
489 :     if (@out < 1)
490 :     {
491 :     push(@$html,$cgi->h1("Sorry, no hits"));
492 :     }
493 :     else
494 :     {
495 :     if (@out > 2000)
496 :     {
497 :     push(@$html,$cgi->h1("truncating to the first 1000 hits"));
498 :     $#out = 1999;
499 :     }
500 :    
501 :     push(@$html,$cgi->pre);
502 :     $user = $cgi->param('user');
503 :     $col_hdrs = ["peg","begin","end","string","function of peg"];
504 :     for ($i=0; ($i < @out); $i += 2)
505 :     {
506 :     if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
507 :     {
508 :     $peg = $1;
509 :     $beg = $2;
510 :     $end = $3;
511 :     $string = $out[$i+1];
512 : golsen 1.21 chomp $string;
513 : overbeek 1.17 push( @$tab, [ &HTML::fid_link($cgi,$peg,1),
514 :     $beg,
515 :     $end,
516 :     $string,
517 :     scalar $fig->function_of( $peg, $user )
518 :     ]
519 :     );
520 : efrank 1.1 }
521 :     }
522 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
523 :     push(@$html,$cgi->end_pre);
524 :     }
525 :     unlink($tmp_pat);
526 :     }
527 :    
528 : overbeek 1.17 #==============================================================================
529 :     # Scan for matches
530 :     #==============================================================================
531 :    
532 : efrank 1.1 sub run_dna_scan_for_matches {
533 :     my($fig,$cgi,$html,$org,$pat) = @_;
534 :     my($string,$contig,$beg,$end,$col_hdrs,$tab,$i);
535 :    
536 :     my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
537 :     open(PAT,">$tmp_pat")
538 :     || die "could not open $tmp_pat";
539 :     $pat =~ s/[\s\012\015]+/ /g;
540 :     print PAT "$pat\n";
541 :     close(PAT);
542 :     my @out = `cat $FIG_Config::organisms/$org/contigs | $FIG_Config::ext_bin/scan_for_matches -c $tmp_pat`;
543 :     if (@out < 1)
544 :     {
545 :     push(@$html,$cgi->h1("Sorry, no hits"));
546 :     }
547 :     else
548 :     {
549 :     if (@out > 2000)
550 :     {
551 :     push(@$html,$cgi->h1("truncating to the first 1000 hits"));
552 :     $#out = 1999;
553 :     }
554 :    
555 :     push(@$html,$cgi->pre);
556 :     $col_hdrs = ["contig","begin","end","string"];
557 :     for ($i=0; ($i < @out); $i += 2)
558 :     {
559 :     if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
560 :     {
561 :     $contig = $1;
562 :     $beg = $2;
563 :     $end = $3;
564 :     $string = $out[$i+1];
565 : golsen 1.21 chomp $string;
566 : efrank 1.1 push(@$tab,[$contig,$beg,$end,$string]);
567 :     }
568 :     }
569 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
570 :     push(@$html,$cgi->end_pre);
571 :     }
572 :     unlink($tmp_pat);
573 :     }
574 :    
575 : overbeek 1.17 #==============================================================================
576 :     # BLAST search
577 :     #==============================================================================
578 :    
579 : efrank 1.1 sub run_blast {
580 :     my($fig,$cgi,$html,$org,$tool,$seq) = @_;
581 :     my($query,@out);
582 :    
583 :     my $tmp_seq = "$FIG_Config::temp/tmp$$.seq";
584 :    
585 : overbeek 1.17 #--------------------------------------------------------------------------
586 :     # Is the request for an id? Get the sequence
587 :     #--------------------------------------------------------------------------
588 : efrank 1.1 if ($seq =~ /^\s*([a-zA-Z]{2,4}\|\S+)/)
589 :     {
590 : golsen 1.23 # Replaced $id with $query so that output inherits label -- GJO
591 :     $query = $1;
592 : efrank 1.1 $seq = "";
593 :     if (($tool eq "blastp") || ($tool eq "tblastn"))
594 :     {
595 : golsen 1.23 $seq = $fig->get_translation($query);
596 : efrank 1.1 }
597 : golsen 1.23 elsif ($query =~ /^fig/)
598 : efrank 1.1 {
599 :     my @locs;
600 : golsen 1.23 if ((@locs = $fig->feature_location($query)) && (@locs > 0))
601 : efrank 1.1 {
602 : golsen 1.23 $seq = $fig->dna_seq($fig->genome_of($query),@locs);
603 : efrank 1.1 }
604 :     }
605 :     if (! $seq)
606 :     {
607 : golsen 1.23 push(@$html,$cgi->h1("Sorry, could not get sequence for $query"));
608 : efrank 1.1 return;
609 :     }
610 :     }
611 : overbeek 1.17 #--------------------------------------------------------------------------
612 :     # Is it a fasta format? Get the query name
613 :     #--------------------------------------------------------------------------
614 : efrank 1.1 elsif ($seq =~ s/^>(\S+)[^\n\012\015]*//)
615 :     {
616 :     $query = $1;
617 :     }
618 : overbeek 1.17 #--------------------------------------------------------------------------
619 :     # Take it as plain text
620 :     #--------------------------------------------------------------------------
621 : efrank 1.1 else
622 :     {
623 :     $query = "query";
624 :     }
625 : golsen 1.23 $seq =~ s/\s+//g;
626 : efrank 1.1 open(SEQ,">$tmp_seq")
627 :     || die "could not open $tmp_seq";
628 :     print SEQ ">$query\n$seq\n";
629 :     close(SEQ);
630 :    
631 :     if (! $ENV{"BLASTMAT"}) { $ENV{"BLASTMAT"} = "$FIG_Config::blastmat" }
632 :    
633 : overbeek 1.17 my $blastall = "$FIG_Config::ext_bin/blastall";
634 : efrank 1.1 if ($tool eq "blastp")
635 :     {
636 : overbeek 1.17 my $db = "$FIG_Config::organisms/$org/Features/peg/fasta";
637 :     &verify_db($db,"p");
638 :     @out = map { &HTML::set_prot_links($cgi,$_) } `$blastall -i $tmp_seq -d $db -p blastp`;
639 : efrank 1.1 }
640 :     elsif ($tool eq "blastx")
641 :     {
642 : overbeek 1.17 my $db = "$FIG_Config::organisms/$org/Features/peg/fasta";
643 :     &verify_db($db,"p");
644 :     @out = map { &HTML::set_prot_links($cgi,$_) } `$blastall -i $tmp_seq -d $db -p blastx`;
645 : efrank 1.1 }
646 :     elsif ($tool eq "blastn")
647 :     {
648 : overbeek 1.17 # Typo fixed by GJO
649 :     # my $db = "$$FIG_Config::organisms/$org/contigs";
650 :     my $db = "$FIG_Config::organisms/$org/contigs";
651 :     &verify_db($db,"n"); ### fix to get all contigs
652 :     # Matrix changed by GJO for greater sensitivity
653 :     # @out = `$blastall -i $tmp_seq -d $db -p blastn`;
654 :     @out = `$blastall -i $tmp_seq -d $db -p blastn -r 1 -q -1`;
655 : efrank 1.1 }
656 :     elsif ($tool eq "tblastn")
657 :     {
658 : overbeek 1.17 my $db = "$FIG_Config::organisms/$org/contigs";
659 :     &verify_db($db,"n"); ### fix to get all contigs
660 :     @out = `$blastall -i $tmp_seq -d $db -p tblastn`;
661 : efrank 1.1 }
662 : overbeek 1.30 elsif ($tool eq 'blastp against complete genomes') ### this tool gets nonstandard treatment: RAO
663 :     {
664 :     &blast_complete($fig,$cgi,$html,$tmp_seq,$blastall);
665 :     unlink($tmp_seq);
666 :     return;
667 :     }
668 : overbeek 1.17 if (@out < 1) # This is really a bigger problem than no hits (GJO)
669 : efrank 1.1 {
670 :     push(@$html,$cgi->h1("Sorry, no hits"));
671 :     }
672 :     else
673 :     {
674 :     push(@$html,$cgi->pre);
675 :     push(@$html,@out);
676 :     push(@$html,$cgi->end_pre);
677 :     }
678 :     unlink($tmp_seq);
679 :     }
680 :    
681 : overbeek 1.30 sub blast_complete {
682 :     my($fig,$cgi,$html,$seq_file,$blastall) = @_;
683 :     my($genome,@sims);
684 :    
685 :     @sims = ();
686 :     foreach $genome ($fig->genomes("complete"))
687 :     {
688 :     my $db = "$FIG_Config::organisms/$genome/Features/peg/fasta";
689 :     next if (! -s $db);
690 :    
691 :     &verify_db($db,"p");
692 :     my $sim;
693 :     push(@sims,map { chop;
694 :     $sim = [split(/\t/,$_)];
695 :     $sim->[10] = ($sim->[10] =~ /^e-/) ? "1.0" . $sim->[10] : $sim->[10];
696 :     $sim }
697 :     `$blastall -i $seq_file -d $db -m 8 -FF -e 1.0e-5 -p blastp`);
698 :     }
699 :     @sims = sort { $a->[10] <=> $b->[10] } @sims;
700 :     &format_sims($fig,$cgi,$html,\@sims);
701 :     }
702 :    
703 :     sub format_sims {
704 :     my($fig,$cgi,$html,$sims) = @_;
705 :     my($col_hdrs,$table,@ids,$ids,$sim,%seen);
706 :    
707 :     $col_hdrs = [ "Select up to here",
708 :     "Similar sequence",
709 :     "E-val",
710 :     "Function",
711 :     "Organism",
712 :     "Aliases"
713 :     ];
714 :    
715 :     $table = [];
716 :     @ids = ();
717 :     if (@$sims > 1000) { $#{$sims} = 999 }
718 :     foreach $sim (@$sims)
719 :     {
720 :     if (! $seen{$sim->[1]})
721 :     {
722 :     push(@$table,[$cgi->checkbox(-name => 'list_to', -value => $sim->[1], -override => 1, -checked => 0, -label => ""),
723 :     &HTML::fid_link($cgi,$sim->[1]),
724 :     $sim->[10],
725 :     scalar $fig->function_of($sim->[1]),
726 :     $fig->genus_species(&FIG::genome_of($sim->[1])),
727 :     scalar $fig->feature_aliases($sim->[1])
728 :     ]);
729 :     push(@ids,$sim->[1]);
730 :     }
731 :     }
732 :     $ids = join(",",@ids);
733 :     my $target = "window$$";
734 :     push(@$html, $cgi->start_form( -method => 'post',
735 :     -target => $target,
736 :     -action => 'index.cgi'
737 :     ),
738 :     $cgi->hidden(-name => 'ids', -value => $ids),
739 :     &HTML::make_table($col_hdrs,$table,"Best Hits"),
740 :     $cgi->submit('Extract Matched Sequences'),
741 :     $cgi->end_form);
742 :     }
743 : overbeek 1.17
744 : efrank 1.1 sub verify_db {
745 :     my($db,$type) = @_;
746 :    
747 : overbeek 1.17 if ($type =~ /^p/i)
748 : efrank 1.1 {
749 :     if ((! -s "$db.psq") || (-M "$db.psq" > -M $db))
750 :     {
751 :     system "$FIG_Config::ext_bin/formatdb -p T -i $db";
752 :     }
753 :     }
754 :     else
755 :     {
756 :     if ((! -s "$db.nsq") || (-M "$db.nsq" > -M $db))
757 :     {
758 :     system "$FIG_Config::ext_bin/formatdb -p F -i $db";
759 :     }
760 :     }
761 :     }
762 : overbeek 1.7
763 :     sub export_assignments {
764 :     my($fig,$cgi,$html,$who) = @_;
765 :     my($genome,$x);
766 :    
767 :     my @genomes = map { $_ =~ /\((\d+\.\d+)\)/; $1 } $cgi->param('korgs');
768 :    
769 :     if (@genomes == 0)
770 :     {
771 :     @genomes = $fig->genomes;
772 :     }
773 :    
774 : overbeek 1.10 my @assignments = $fig->assignments_made(\@genomes,$who,$cgi->param('after_date'));
775 : overbeek 1.7 if (@assignments == 0)
776 :     {
777 :     push(@$html,$cgi->h1("Sorry, no assignments where made by $who"));
778 :     }
779 :     else
780 :     {
781 :     my $col_hdrs = ["FIG id", "External ID", "Genus/Species","Assignment"];
782 :     my $tab = [];
783 :     my($x,$peg,$func);
784 :     foreach $x (@assignments)
785 :     {
786 :     ($peg,$func) = @$x;
787 :     push(@$tab,[$peg,&ext_id($fig,$peg),$fig->genus_species($fig->genome_of($peg)),$func]);
788 :     }
789 : overbeek 1.11
790 :     if ($cgi->param('save_assignments'))
791 :     {
792 : overbeek 1.15 my $user = $cgi->param('save_user');
793 : overbeek 1.13 if ($user)
794 :     {
795 :     &FIG::verify_dir("$FIG_Config::data/Assignments/$user");
796 : overbeek 1.15 my $file = &FIG::epoch_to_readable(time) . ":$who:exported_from_local_SEED";
797 : overbeek 1.13 if (open(TMP,">$FIG_Config::data/Assignments/$user/$file"))
798 :     {
799 :     print TMP join("",map { join("\t",@$_) . "\n" } map { [$_->[0],$_->[3]] } @$tab);
800 :     close(TMP);
801 :     }
802 :     push(@$html,$cgi->h1("Saved Assignment Set $file"));
803 :     }
804 :     else
805 : overbeek 1.11 {
806 : overbeek 1.13 push(@$html,$cgi->h1("You need to specify a user to save an assignment set"));
807 : overbeek 1.11 }
808 :     }
809 : overbeek 1.13
810 : overbeek 1.7 if ($cgi->param('tabs'))
811 :     {
812 :     print $cgi->header;
813 :     print "<pre>\n";
814 :     print join("",map { join("\t",@$_) . "\n" } @$tab);
815 :     print "</pre>\n";
816 :     exit;
817 :     }
818 :     else
819 :     {
820 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Assignments Made by $who"));
821 :     }
822 :     }
823 :     }
824 :    
825 :     sub ext_id {
826 :     my($fig,$peg) = @_;
827 :    
828 :     my @mapped = grep { $_ !~ /^fig/ } map { $_->[0] } $fig->mapped_prot_ids($peg);
829 :     if (@mapped == 0)
830 :     {
831 :     return $peg;
832 :     }
833 :    
834 :     my @tmp = ();
835 :     if ((@tmp = grep { $_ =~ /^sp/ } @mapped) && (@tmp > 0)) { return $tmp[0] }
836 :     if ((@tmp = grep { $_ =~ /^pir/ } @mapped) && (@tmp > 0)) { return $tmp[0] }
837 :     if ((@tmp = grep { $_ =~ /^gi/ } @mapped) && (@tmp > 0)) { return $tmp[0] }
838 :     if ((@tmp = grep { $_ =~ /^tr/ } @mapped) && (@tmp > 0)) { return $tmp[0] }
839 :     if ((@tmp = grep { $_ =~ /^tn/ } @mapped) && (@tmp > 0)) { return $tmp[0] }
840 :     if ((@tmp = grep { $_ =~ /^kegg/ } @mapped) && (@tmp > 0)) { return $tmp[0] }
841 :    
842 :     return $peg;
843 :     }
844 :    
845 : overbeek 1.28 sub translate_assignments {
846 :     my($fig,$cgi,$html,$from_func,$to_func) = @_;
847 :    
848 :     my $user = $cgi->param('save_user');
849 :     if ($user)
850 :     {
851 :     &FIG::verify_dir("$FIG_Config::data/Assignments/$user");
852 :     my $file = &FIG::epoch_to_readable(time) . ":$user:translation";
853 :     if (open(TMP,">$FIG_Config::data/Assignments/$user/$file"))
854 :     {
855 :     my($peg,$from_funcQ,$to_funcQ,$func,$to);
856 :     $from_funcQ = quotemeta $from_func;
857 :    
858 :     foreach $peg ($fig->seqs_with_role($from_func))
859 :     {
860 :     if ($peg =~ /^fig\|/)
861 :     {
862 :     $func = $fig->function_of($peg);
863 :     $to = $func;
864 :     if ($to =~ s/$from_funcQ/$to_func/)
865 :     {
866 :     print TMP "$peg\t$to\n";
867 :     }
868 :     }
869 :     }
870 :     close(TMP);
871 :     }
872 :     push(@$html,$cgi->h1("Saved Assignment Set $file"));
873 :     }
874 :     else
875 :     {
876 :     push(@$html,$cgi->h1("You need to specify a user to save an assignment set"));
877 :     }
878 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3