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

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (view) (download)

1 : overbeek 1.2
2 : efrank 1.1 use FIG;
3 :     my $fig = new FIG;
4 :    
5 :     use HTML;
6 :     use strict;
7 :     use CGI;
8 :     my $cgi = new CGI;
9 :    
10 :     my($map,@orgs,$user,$map,$org);
11 :    
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 : efrank 1.5 my @ver = `cat $FIG_Config::fig_disk/CURRENT_RELEASE`;
33 :     chop $ver[0];
34 :     push(@$html,
35 :     "You are currently running SEED version <b>$ver[0]</b><br>",
36 :     "To start a peer-to-peer update, <a href=$FIG_Config::cgi_url/seed_update_page.cgi>click here</a><br>\n"
37 :     );
38 :    
39 : efrank 1.1
40 :     my($pattern,$seq_pat,$tool);
41 :     my $user = $cgi->param('user');
42 :     if (! $user) { $user = "" }
43 :    
44 :     if ($cgi->param('Search for Genes Matching an Occurrence Profile'))
45 :     {
46 :    
47 :     my $url = $cgi->url;
48 :     $ENV{"REQUEST_METHOD"} = "GET";
49 :     $ENV{"QUERY_STRING"} = "user=$user";
50 :     my @out = `./sigs.cgi`;
51 :     &HTML::trim_output(\@out);
52 :     push(@$html,@out);
53 :     }
54 :     elsif (($pattern = $cgi->param('pattern')) && ($cgi->param('Search') || $cgi->param('Find Genes in Org that Might Play the Role')))
55 :     {
56 :     if ($cgi->param('Find Genes in Org that Might Play the Role') &&
57 :     (@orgs = $cgi->param('korgs')) && (@orgs == 1))
58 :     {
59 :     @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
60 :     $ENV{"REQUEST_METHOD"} = "GET";
61 :     $ENV{"QUERY_STRING"} = "user=$user&request=find_in_org&role=$pattern&org=$orgs[0]";
62 :     my @out = `./pom.cgi`;
63 :     print join("",@out);
64 :     exit;
65 :     }
66 :     else
67 :     {
68 :     &show_indexed_objects($fig,$cgi,$html,$pattern);
69 :     }
70 :     }
71 :     elsif (($map = $cgi->param('kmap')) && $cgi->param('Metabolic Overview'))
72 :     {
73 :     $map =~ s/^.*\((MAP\d+)\).*$/$1/;
74 :     @orgs = $cgi->param('korgs');
75 :     @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
76 :     $ENV{"REQUEST_METHOD"} = "GET";
77 :     if (@orgs > 0)
78 :     {
79 :     $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$orgs[0]";
80 :     }
81 :     else
82 :     {
83 :     $ENV{"QUERY_STRING"} = "user=$user&map=$map";
84 :     }
85 :    
86 :     my @out = `./show_kegg_map.cgi`;
87 :     &HTML::trim_output(\@out);
88 :     push(@$html,@out);
89 :     }
90 :     elsif (($seq_pat = $cgi->param('seq_pat')) &&
91 :     (@orgs = $cgi->param('korgs')) &&
92 :     ($tool = $cgi->param('Tool')) &&
93 :     $cgi->param('Search for Matches'))
94 :     {
95 :     @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
96 :     if ($tool =~ /blast/)
97 :     {
98 :     &run_blast($fig,$cgi,$html,$orgs[0],$tool,$seq_pat);
99 :     }
100 :     elsif ($tool =~ /Protein scan_for_matches/)
101 :     {
102 :     &run_prot_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
103 :     }
104 :     elsif ($tool =~ /DNA scan_for_matches/)
105 :     {
106 :     &run_dna_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
107 :     }
108 :     }
109 :     else
110 :     {
111 :     &show_initial($fig,$cgi,$html);
112 :     }
113 :     &HTML::show_page($cgi,$html,1);
114 :    
115 :     sub show_initial {
116 :     my($fig,$cgi,$html) = @_;
117 :     my($map,$name,$olrg,$gs);
118 :    
119 : overbeek 1.2 my($a,$b,$e,$v) = $fig->genome_counts;
120 : overbeek 1.6 push(@$html,$cgi->h2("Contains $a archaeal, $b bacterial, $e eukaryotic, and $v viral genomes"));
121 :     my($a,$b,$e,$v) = $fig->genome_counts("complete");
122 :     push(@$html,$cgi->h2("Of these, $a archaeal, $b bacterial, and $e eukaryotic genomes are more-or-less complete"),$cgi->hr);
123 : overbeek 1.2
124 : efrank 1.1 my @maps = sort map { $map = $_; $name = $fig->map_name($map); "$name ($map)" } $fig->all_maps;
125 : overbeek 1.6 my @orgs = sort map { $org = $_; $gs = $fig->genus_species($org); "$gs ($org)" } $fig->genomes("complete",undef);
126 : efrank 1.1
127 :     push(@$html,
128 :     $cgi->start_form(-action => "index.cgi"),
129 :     $cgi->h1('Searching for Genes or Functional Roles Using Text'),
130 :     "Search Pattern: ",
131 :     $cgi->textfield(-name => "pattern", -size => 50),
132 :     $cgi->br,
133 :     $cgi->br,
134 :     "User ID: &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ",
135 :     $cgi->textfield(-name => "user", -size => 20),
136 :     "&nbsp; [optional]",
137 :     $cgi->br,
138 :     $cgi->br,
139 :     $cgi->submit('Search'),
140 :     $cgi->reset('Clear'),
141 :     $cgi->hr,
142 :     $cgi->h1('If You Need to Pick an Organism for Options Below'),
143 :     $cgi->scrolling_list(-name => 'korgs',
144 :     -values => [@orgs],
145 :     -size => 10
146 :     ),
147 :     $cgi->hr,
148 :     $cgi->h1('Finding Candidates for a Functional Role'),
149 :     "Make sure that you type the functional role you want to search for in the Search Pattern above",
150 :     $cgi->br,
151 :     $cgi->submit('Find Genes in Org that Might Play the Role'),
152 :     $cgi->hr,
153 :     $cgi->h1('Metabolic Overviews (via KEGG) - Choose KEGG Map'),
154 :     $cgi->submit('Metabolic Overview'),
155 :     $cgi->br,
156 :     $cgi->br,
157 :     $cgi->scrolling_list(-name => 'kmap',
158 :     -values => [@maps],
159 :     -size => 10
160 :     ),
161 :     $cgi->hr,
162 :     $cgi->h1('Searching DNA or Protein Sequences (in a selected organism)'),
163 :     "Sequence/Pattern: ",
164 :     $cgi->textarea(-name => 'seq_pat', -rows => 20, -cols => 70),
165 :     $cgi->popup_menu(-name => 'Tool', -values => ['blastp','blastx','blastn','tblastn','Protein scan_for_matches','DNA scan_for_matches'], -default => 'blastp'),
166 :     $cgi->submit('Search for Matches'),
167 :     $cgi->hr,
168 :     $cgi->h1('Searching for Interesting Genes'),
169 :     $cgi->submit('Search for Genes Matching an Occurrence Profile'),
170 :     $cgi->end_form,
171 :     $cgi->end_html
172 :     );
173 :    
174 :     }
175 :    
176 :     sub show_indexed_objects {
177 :     my($fig,$cgi,$html,$pattern) = @_;
178 :     my($msg,$i);
179 :    
180 :     if ($pattern =~ /^\s*(fig\|\d+\.\d+\.peg\.\d+)\s*$/)
181 :     {
182 :     my $peg = $1;
183 :     my $user = $cgi->param('user');
184 :     $user = $user ? $user : "";
185 :     $ENV{'REQUEST_METHOD'} = "GET";
186 :     $ENV{"QUERY_STRING"} = "prot=$peg\&user=$user";
187 :     $ENV{"REQUEST_URI"} =~ s/index.cgi/protein.cgi/;
188 :     my @prot_out = `./protein.cgi`;
189 :     &HTML::trim_output(\@prot_out);
190 :     push(@$html,@prot_out);
191 :     return;
192 :     }
193 :    
194 :     my($peg_index_data,$role_index_data) = $fig->search_index($pattern);
195 :     my $n = @$peg_index_data;
196 :     if ($n > 100)
197 :     {
198 :     $msg = "Showing First 100 Out of $n PEGs";
199 :     $#{$peg_index_data} = 99;
200 :     }
201 :     else
202 :     {
203 :     $msg = "Showing $n PEGs";
204 :     }
205 :    
206 :     my $col_hdrs = ["PEG","Organism","Aliases","Function","Who"];
207 :     my $tab = [ map { &format_peg_entry($fig,$cgi,$_) } @$peg_index_data ];
208 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$msg), $cgi->hr);
209 :    
210 :     $n = @$role_index_data;
211 :     if ($n > 100)
212 :     {
213 :     $msg = "Showing First 100 Out of $n Roles";
214 :     $#{$role_index_data} = 99;
215 :     }
216 :     else
217 :     {
218 :     $msg = "Showing $n Roles";
219 :     }
220 :    
221 :     $col_hdrs = ["Role"];
222 :     $tab = [ map { &format_role_entry($fig,$cgi,$_) } @$role_index_data ];
223 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$msg));
224 :     }
225 :    
226 :     sub format_peg_entry {
227 :     my($fig,$cgi,$entry) = @_;
228 :     my($i,$function,$who);
229 :    
230 :     my($peg,$gs,$aliases,@funcs) = @$entry;
231 :     my $user = $cgi->param('user');
232 :     $user = $user ? $user : "";
233 :    
234 :     @funcs = map { $_ =~ s/^function:\s*//; $_ } @funcs;
235 :    
236 :     if ($aliases)
237 :     {
238 :     $aliases =~ s/^aliases://;
239 :     }
240 :     else
241 :     {
242 :     $aliases = "";
243 :     }
244 :    
245 :     if ($user)
246 :     {
247 :     for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#$user/); $i++) {}
248 :     if ($i < @funcs)
249 :     {
250 :     ($function,$who) = split(/\#/,$funcs[$i]);
251 :     }
252 :     }
253 :     if (! $function)
254 :     {
255 :     for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#master/); $i++) {}
256 :     if ($i < @funcs)
257 :     {
258 :     ($function,$who) = split(/\#/,$funcs[$i]);
259 :     }
260 :     }
261 :    
262 :     if ((! $function) && (@funcs > 0))
263 :     {
264 :     ($function,$who) = split(/\#/,$funcs[0]);
265 :     }
266 :     return [&HTML::fid_link($cgi,$peg),$gs,$aliases,$function,$who];
267 :     }
268 :    
269 :     sub format_role_entry {
270 :     my($fig,$cgi,$entry) = @_;
271 :    
272 :     return [&HTML::role_link($cgi,$entry)];
273 :     }
274 :    
275 :     sub run_prot_scan_for_matches {
276 :     my($fig,$cgi,$html,$org,$pat) = @_;
277 :     my($string,$peg,$beg,$end,$user,$col_hdrs,$tab,$i);
278 :    
279 :     my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
280 :     open(PAT,">$tmp_pat")
281 :     || die "could not open $tmp_pat";
282 :     $pat =~ s/[\s\012\015]+/ /g;
283 :     print PAT "$pat\n";
284 :     close(PAT);
285 :     my @out = `$FIG_Config::ext_bin/scan_for_matches -p $tmp_pat < $FIG_Config::organisms/$org/Features/peg/fasta`;
286 :     if (@out < 1)
287 :     {
288 :     push(@$html,$cgi->h1("Sorry, no hits"));
289 :     }
290 :     else
291 :     {
292 :     if (@out > 2000)
293 :     {
294 :     push(@$html,$cgi->h1("truncating to the first 1000 hits"));
295 :     $#out = 1999;
296 :     }
297 :    
298 :     push(@$html,$cgi->pre);
299 :     $user = $cgi->param('user');
300 :     $col_hdrs = ["peg","begin","end","string","function of peg"];
301 :     for ($i=0; ($i < @out); $i += 2)
302 :     {
303 :     if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
304 :     {
305 :     $peg = $1;
306 :     $beg = $2;
307 :     $end = $3;
308 :     $string = $out[$i+1];
309 :     chop $string;
310 :     push(@$tab,[&HTML::fid_link($cgi,$peg,1),$beg,$end,$string,scalar $fig->function_of($peg,$user)]);
311 :     }
312 :     }
313 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
314 :     push(@$html,$cgi->end_pre);
315 :     }
316 :     unlink($tmp_pat);
317 :     }
318 :    
319 :     sub run_dna_scan_for_matches {
320 :     my($fig,$cgi,$html,$org,$pat) = @_;
321 :     my($string,$contig,$beg,$end,$col_hdrs,$tab,$i);
322 :    
323 :     my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
324 :     open(PAT,">$tmp_pat")
325 :     || die "could not open $tmp_pat";
326 :     $pat =~ s/[\s\012\015]+/ /g;
327 :     print PAT "$pat\n";
328 :     close(PAT);
329 :     my @out = `cat $FIG_Config::organisms/$org/contigs | $FIG_Config::ext_bin/scan_for_matches -c $tmp_pat`;
330 :     if (@out < 1)
331 :     {
332 :     push(@$html,$cgi->h1("Sorry, no hits"));
333 :     }
334 :     else
335 :     {
336 :     if (@out > 2000)
337 :     {
338 :     push(@$html,$cgi->h1("truncating to the first 1000 hits"));
339 :     $#out = 1999;
340 :     }
341 :    
342 :     push(@$html,$cgi->pre);
343 :     $col_hdrs = ["contig","begin","end","string"];
344 :     for ($i=0; ($i < @out); $i += 2)
345 :     {
346 :     if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
347 :     {
348 :     $contig = $1;
349 :     $beg = $2;
350 :     $end = $3;
351 :     $string = $out[$i+1];
352 :     chop $string;
353 :     push(@$tab,[$contig,$beg,$end,$string]);
354 :     }
355 :     }
356 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
357 :     push(@$html,$cgi->end_pre);
358 :     }
359 :     unlink($tmp_pat);
360 :     }
361 :    
362 :     sub run_blast {
363 :     my($fig,$cgi,$html,$org,$tool,$seq) = @_;
364 :     my($query,@out);
365 :    
366 :     my $tmp_seq = "$FIG_Config::temp/tmp$$.seq";
367 :    
368 :     if ($seq =~ /^\s*([a-zA-Z]{2,4}\|\S+)/)
369 :     {
370 :     my $id = $1;
371 :     $seq = "";
372 :     if (($tool eq "blastp") || ($tool eq "tblastn"))
373 :     {
374 :     $seq = $fig->get_translation($id);
375 :     }
376 :     elsif ($id =~ /^fig/)
377 :     {
378 :     my @locs;
379 :     if ((@locs = $fig->feature_location($id)) && (@locs > 0))
380 :     {
381 :     $seq = $fig->dna_seq($fig->genome_of($id),@locs);
382 :     }
383 :     }
384 :     if (! $seq)
385 :     {
386 :     push(@$html,$cgi->h1("Sorry, could not get sequence for $id"));
387 :     return;
388 :     }
389 :     }
390 :     elsif ($seq =~ s/^>(\S+)[^\n\012\015]*//)
391 :     {
392 :     $query = $1;
393 :     }
394 :     else
395 :     {
396 :     $query = "query";
397 :     }
398 :     $seq =~ s/\s//g;
399 :     open(SEQ,">$tmp_seq")
400 :     || die "could not open $tmp_seq";
401 :     print SEQ ">$query\n$seq\n";
402 :     close(SEQ);
403 :    
404 :     if (! $ENV{"BLASTMAT"}) { $ENV{"BLASTMAT"} = "$FIG_Config::blastmat" }
405 :    
406 :     if ($tool eq "blastp")
407 :     {
408 :     &verify_db("$FIG_Config::organisms/$org/Features/peg/fasta","p");
409 :     @out = map { &HTML::set_prot_links($cgi,$_) } `$FIG_Config::ext_bin/blastall -i $tmp_seq -d $FIG_Config::organisms/$org/Features/peg/fasta -p blastp`;
410 :     }
411 :     elsif ($tool eq "blastx")
412 :     {
413 :     &verify_db("$FIG_Config::organisms/$org/Features/peg/fasta","p");
414 :     @out = map { &HTML::set_prot_links($cgi,$_) } `$FIG_Config::ext_bin/blastall -i $tmp_seq -d $FIG_Config::organisms/$org/Features/peg/fasta -p blastx`;
415 :     }
416 :     elsif ($tool eq "blastn")
417 :     {
418 :     &verify_db("$FIG_Config::organisms/$org/contigs","n"); ### fix to get all contigs
419 :     @out = `$FIG_Config::ext_bin/blastall -i $tmp_seq -d $FIG_Config::organisms/$org/contigs -p blastn`;
420 :     }
421 :     elsif ($tool eq "tblastn")
422 :     {
423 :     &verify_db("$FIG_Config::organisms/$org/contigs","n"); ### fix to get all contigs
424 :     @out = `$FIG_Config::ext_bin/blastall -i $tmp_seq -d $FIG_Config::organisms/$org/contigs -p tblastn`;
425 :     }
426 :    
427 :     if (@out < 1)
428 :     {
429 :     push(@$html,$cgi->h1("Sorry, no hits"));
430 :     }
431 :     else
432 :     {
433 :     push(@$html,$cgi->pre);
434 :     push(@$html,@out);
435 :     push(@$html,$cgi->end_pre);
436 :     }
437 :     unlink($tmp_seq);
438 :     }
439 :    
440 :     sub verify_db {
441 :     my($db,$type) = @_;
442 :    
443 :     if ($type =~ /p/i)
444 :     {
445 :     if ((! -s "$db.psq") || (-M "$db.psq" > -M $db))
446 :     {
447 :     system "$FIG_Config::ext_bin/formatdb -p T -i $db";
448 :     }
449 :     }
450 :     else
451 :     {
452 :     if ((! -s "$db.nsq") || (-M "$db.nsq" > -M $db))
453 :     {
454 :     system "$FIG_Config::ext_bin/formatdb -p F -i $db";
455 :     }
456 :     }
457 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3