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

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3