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

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3