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

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.47 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3