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

Annotation of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.55 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3