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

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.49 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3