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

Annotation of /FigWebServices/align_and_tree.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : golsen 1.1 # -*- perl -*-
2 :     #
3 :     # Copyright (c) 2003-2011 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :     use strict;
20 :     use HTML;
21 :     use FIG_CGI;
22 :     use FIGgjo; # colorize_roles, colorize_functions
23 :     use gjoseqlib; # read_fasta, print_alignment_as_fasta
24 :     use gjoalign2html; # repad_alignment, color_alignment_by_consensus
25 :     use gjonewicklib;
26 :     use SAPserver;
27 :     use AlignsAndTreesServer qw( peg_alignment_metadata
28 :     peg_alignment_by_ID
29 :     peg_tree_by_ID
30 :     aligns_with_pegID
31 :     );
32 :    
33 :     use Data::Dumper;
34 :     use Carp;
35 :    
36 :     my( $fig, $cgi, $user ) = FIG_CGI::init( debug_save => 0,
37 :     debug_load => 0,
38 :     print_params => 0 );
39 :    
40 :     # Incoming information:
41 :    
42 :     my $ali_tree_id = $cgi->param( 'ali_tree_id' );
43 :     my @ali_tree_ids = $cgi->param( 'at_ids' );
44 :     my $align_format = $cgi->param( 'align_format' );
45 : golsen 1.2 my $align_id = $cgi->param( 'align_id' );
46 : golsen 1.1 my @checked = $cgi->param( 'checked' );
47 :     my $color_aln_by = $cgi->param( 'color_aln_by' ) || 'consensus';
48 :     my $fid = $cgi->param( 'fid' );
49 :     my $show_aliases = $cgi->param( 'show_aliases' );
50 :     my $show_align = $cgi->param( 'show_align' );
51 :     my $show_tree = $cgi->param( 'show_tree' );
52 :     my $tree_format = $cgi->param( 'tree_format' );
53 : golsen 1.2 my $tree_id = $cgi->param( 'tree_id' );
54 : golsen 1.1
55 :     # Let's see if we can work out missing values from other data:
56 :    
57 :     $fid ||= $checked[0] if @checked == 1;
58 :     $ali_tree_id ||= $align_id || $tree_id;
59 :     if ( ( ! $ali_tree_id ) && $fid )
60 :     {
61 :     @ali_tree_ids = AlignsAndTreesServer::aligns_with_pegID( $fid ) if ! @ali_tree_ids;
62 :     $ali_tree_id = $ali_tree_ids[0] if @ali_tree_ids == 1;
63 :     }
64 :    
65 :     # Move alignment and tree selection information into one id and two booleans
66 :    
67 :     $show_align = ( $ali_tree_id && $show_align ) || $align_id;
68 :     $show_tree = ( $ali_tree_id && $show_tree ) || $tree_id;
69 :     $align_id = undef;
70 :     $tree_id = undef;
71 :    
72 :    
73 :     # The html will be assembled here.
74 :    
75 :     print $cgi->header;
76 :    
77 :     my @html = ();
78 :     if ( $show_align )
79 :     {
80 :     if ( $show_tree )
81 :     {
82 :     push @html, page_head_html( "The SEED: Protein Alignment $ali_tree_id" );
83 :     }
84 :     else
85 :     {
86 :     push @html, page_head_html( "The SEED: Protein Alignment and Tree $ali_tree_id" );
87 :     }
88 :     }
89 :     else
90 :     {
91 :     if ( $show_tree )
92 :     {
93 :     push @html, page_head_html( "The SEED: Protein Tree $ali_tree_id" );
94 :     }
95 :     elsif ( $fid )
96 :     {
97 :     push @html, page_head_html( "The SEED: Protein Alignment and Tree Selector for '$fid'" );
98 :     }
99 :     else
100 :     {
101 :     push @html, page_head_html( "The SEED: Protein Alignment and Tree Selector" );
102 :     }
103 :     }
104 :    
105 :     #==============================================================================
106 :     # Alignment and tree format controls:
107 :     #==============================================================================
108 :    
109 :     push @html, join( "\n",
110 :     $cgi->start_form( -method => 'post',
111 :     -action => 'align_and_tree.cgi',
112 :     -name => 'alignment'
113 :     ),
114 :     $cgi->hidden( -name => 'fid', -value => $fid ),
115 :     $cgi->hidden( -name => 'user', -value => $user ),
116 :    
117 :     @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),
118 :     $ali_tree_id ? $cgi->hidden( -name => 'ali_tree_id', -value => $ali_tree_id ) : (),
119 :    
120 :     $cgi->checkbox( -name => 'show_align',
121 :     -label => 'Show alignment',
122 :     -override => 1,
123 :     -checked => $show_align
124 :     ),
125 :    
126 :     $cgi->checkbox( -name => 'show_tree',
127 :     -label => 'Show tree',
128 :     -override => 1,
129 :     -checked => $show_tree
130 :     ),
131 :     $cgi->br,
132 :    
133 :     'Color alignment by: ',
134 :     $cgi->radio_group( -name => 'color_aln_by',
135 :     -override => 1,
136 :     -values => [ 'consensus', 'residue' ],
137 :     -default => $color_aln_by
138 :     ),
139 :     $cgi->br,
140 :    
141 :     'Alignment format: ',
142 :     $cgi->radio_group( -name => 'align_format',
143 :     -override => 1,
144 :     -values => [ 'default', 'fasta', 'clustal' ],
145 :     -default => $align_format || 'default'
146 :     ),
147 :     $cgi->br,
148 :    
149 :     'Tree format: ',
150 :     $cgi->radio_group( -name => 'tree_format',
151 :     -override => 1,
152 :     -values => [ 'default', 'newick', 'png' ],
153 :     -default => $tree_format || 'default'
154 :     ),
155 :     $cgi->br,
156 :    
157 :     $cgi->checkbox( -name => 'show_aliases',
158 :     -label => 'Show aliases in tree',
159 :     -override => 1,
160 :     -checked => $show_aliases
161 :     ),
162 :     $cgi->br,
163 :    
164 :     $cgi->submit( 'update' ),
165 :     $cgi->br,
166 :     $cgi->end_form,
167 :     "\n"
168 :     ) if $ali_tree_id && ( $show_align || $show_tree );
169 :    
170 :    
171 :     #------------------------------------------------------------------------------
172 :     # Get the metadata for the alignment and/or tree.
173 :     # The per sequence metadata are:
174 :     #
175 :     # [ $peg_id, $peg_length, $trim_beg, $trim_end, $location_string ]
176 :     #
177 :     #------------------------------------------------------------------------------
178 :    
179 : golsen 1.2 my ( $align, $tree, $metaH, @uids, %fid_of_uid, @fids, $fid_funcH, $orgH, $aliasH );
180 : golsen 1.1 if ( $ali_tree_id && ( $show_align || $show_tree ) )
181 :     {
182 : golsen 1.2 if ( $show_align )
183 :     {
184 :     ( $align, $metaH ) = AlignsAndTreesServer::peg_alignment_by_ID( $ali_tree_id );
185 :     }
186 :     elsif ( $show_tree )
187 :     {
188 :     ( $tree, $metaH ) = AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );
189 :     }
190 :     else
191 :     {
192 :     $metaH = AlignsAndTreesServer::peg_alignment_metadata( $ali_tree_id );
193 :     }
194 :    
195 : golsen 1.1 $metaH && %$metaH
196 :     or push @html, cgi->h2( "No data for alignment and tree '$ali_tree_id'." );
197 :    
198 :     @uids = keys %$metaH; # Ids of alignment line and tree tips
199 :     %fid_of_uid = map { $_ => $metaH->{$_}->[0] } @uids;
200 :    
201 :     my %peg_seen = {};
202 :     @fids = grep { ! $peg_seen{$_}++ } values %fid_of_uid;
203 :    
204 :     #--------------------------------------------------------------------------
205 :     # Find the current functions:
206 :     #--------------------------------------------------------------------------
207 :    
208 :     my $sapObject = SAPserver->new();
209 : golsen 1.2 $fid_funcH = $sapObject->ids_to_functions( -ids => \@fids ) || {};
210 : golsen 1.1
211 :     #--------------------------------------------------------------------------
212 :     # Get the organism names:
213 :     #--------------------------------------------------------------------------
214 :    
215 : golsen 1.2 $orgH = $sapObject->ids_to_genomes( -ids => \@fids, -name => 1 );
216 : golsen 1.1
217 :     #------------------------------------------------------------------
218 :     # Aliases
219 :     #------------------------------------------------------------------
220 :     my %alias;
221 :     if ( $show_aliases ) { 0 }
222 :     $aliasH = \%alias;
223 : golsen 1.2 # push @html, '<PRE>', Dumper( $fid_funcH, $orgH ), '</PRE>';
224 : golsen 1.1 }
225 :    
226 :    
227 :     #==============================================================================
228 :     # Alignment. The alignment is triples: [ $seq_id, $def, $aligned_seq ]
229 :     #==============================================================================
230 :    
231 :     if ( $show_align )
232 :     {
233 :     #----------------------------------------------------------------------
234 : golsen 1.2 # Got the alignment above
235 : golsen 1.1 #----------------------------------------------------------------------
236 :     $align && @$align
237 :     or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );
238 :    
239 :     # This defines the ordering.
240 :     my @seq_ids = map { $_->[0] } @$align;
241 :    
242 :     push @html, "<h2>Alignment $ali_tree_id</h2>\n";
243 :    
244 :     if ( $align && @$align && ( $align_format eq "fasta" ) )
245 :     {
246 :     my ( $id, $peg );
247 :     my %def = map { $id = $_->[0];
248 :     $peg = $fid_of_uid{ $id };
249 :     $id => join( ' ', $id,
250 : golsen 1.2 ( $fid_funcH->{ $id } ? $fid_funcH->{$id} : () ),
251 : golsen 1.1 ( $orgH->{ $id } ? "[$orgH->{$id}]" : () )
252 :     )
253 :     }
254 :     @$align;
255 : golsen 1.2
256 : golsen 1.1 push @html, join( "\n",
257 :     "<PRE>",
258 :     ( map { ( ">$def{$_->[0]}", $_->[2] =~ m/(.{1,60})/g ) } @$align ),
259 :     "</PRE>\n"
260 :     );
261 :     }
262 :    
263 :     elsif ( $align && @$align && ( $align_format eq "clustal" ) )
264 :     {
265 :     push @html, "<PRE>\n", &to_clustal( $align ), "</PRE>\n";
266 :     }
267 :    
268 :     elsif ( $align && @$align )
269 :     {
270 :     my ( $align2, $legend );
271 :    
272 :     # Color by residue type:
273 :    
274 :     if ( $color_aln_by eq 'residue' )
275 :     {
276 :     my %param1 = ( align => $align, protein => 1 );
277 :     $align2 = gjoalign2html::color_alignment_by_residue( \%param1 );
278 :     }
279 :    
280 :     # Color by consensus:
281 :    
282 :     else
283 :     {
284 :     my %param1 = ( align => $align );
285 :     ( $align2, $legend ) = gjoalign2html::color_alignment_by_consensus( \%param1 );
286 :     }
287 :    
288 :     # Add organism names:
289 :    
290 : golsen 1.2 foreach ( @$align2 ) { $_->[1] = $orgH->{ $_->[0] || '' } }
291 : golsen 1.1
292 :     # Build a tool tip with organism names and functions:
293 :    
294 :     my %tips = map { $_ => [ $_, join( $cgi->hr, $orgH->{ $_ }, $fid_funcH->{ $_ } ) ] }
295 : golsen 1.2 map { $_->[0] }
296 :     @$align2;
297 : golsen 1.1 $tips{ 'Consen1' } = [ 'Consen1', 'Primary consensus residue' ];
298 :     $tips{ 'Consen2' } = [ 'Consen2', 'Secondary consensus residue' ];
299 :    
300 :     my %param2 = ( align => $align2,
301 :     tooltip => \%tips
302 :     );
303 : golsen 1.2 $param2{ legend } = $legend if $legend;
304 : golsen 1.1
305 :     push @html, join( "\n",
306 :     scalar gjoalign2html::alignment_2_html_table( \%param2 ),
307 :     $cgi->br,
308 :     );
309 :     }
310 :     }
311 :    
312 :    
313 :     #==============================================================================
314 :     # Tree:
315 :     #==============================================================================
316 :    
317 :     if ( $show_tree )
318 :     {
319 : golsen 1.2 $tree ||= AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );
320 :     $tree or push @html, cgi->h2( "No data for tree '$ali_tree_id'." );
321 : golsen 1.1
322 :     push @html, "<h2>Tree $ali_tree_id</h2>\n" if $tree;
323 :    
324 :     #------------------------------------------------------------------
325 :     # Newick tree
326 :     #------------------------------------------------------------------
327 :     if ( $tree && ( $tree_format eq "newick" ) )
328 :     {
329 :     push @html, "<pre>\n" . &gjonewicklib::formatNewickTree( $tree ) . "</pre>\n";
330 :     }
331 :    
332 :     #------------------------------------------------------------------
333 :     # PNG tree
334 :     #------------------------------------------------------------------
335 :     elsif ( $tree && ( $tree_format eq "png" ) )
336 :     {
337 :     my $okay;
338 :     eval { require gd_tree_0; $okay = 1 };
339 :     my $fmt;
340 :     if ( $okay && ( $fmt = ( gd_tree::gd_has_png() ? 'png' :
341 :     gd_tree::gd_has_jpg() ? 'jpeg' :
342 :     undef
343 :     ) ) )
344 :     {
345 :     #------------------------------------------------------------------
346 :     # Formulate the desired labels
347 :     #------------------------------------------------------------------
348 :     my %labels;
349 : golsen 1.2 foreach my $id ( @uids )
350 : golsen 1.1 {
351 :     my $peg = $fid_of_uid{ $id };
352 :     my @label;
353 :     push @label, $id;
354 : golsen 1.2 push @label, $fid_funcH->{ $peg } if $fid_funcH->{ $peg };
355 : golsen 1.1 push @label, "[$orgH->{$peg}]" if $orgH->{ $peg };
356 :     push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };
357 :    
358 :     $labels{ $id } = join( ' ', @label );
359 :     }
360 : golsen 1.2
361 : golsen 1.1 #------------------------------------------------------------------
362 :     # Relabel the tips, midpoint root, pretty it up and draw
363 :     # the tree as printer plot
364 :     #
365 :     # Adjustable parameters on text_plot_newick:
366 :     #
367 :     # @lines = text_plot_newick( $node, $width, $min_dx, $dy )
368 :     #------------------------------------------------------------------
369 :     my $tree2 = newick_relabel_nodes( $tree, \%labels );
370 :     my $tree3 = reroot_newick_to_midpoint_w( $tree2 );
371 :    
372 :     $tree = aesthetic_newick_tree( $tree3 );
373 :     my $options = { thickness => 2,
374 :     dy => 15,
375 :     };
376 :     my $gd = gd_tree::gd_plot_newick( $tree, $options );
377 :    
378 :     my $name = sprintf( "align_and_tree_%d_%08d.$fmt", $$, int(1e8*rand()) );
379 :     my $file = "$FIG_Config::temp/$name";
380 :     open TREE, ">$file";
381 :     binmode TREE;
382 :     print TREE $gd->$fmt;
383 :     close TREE;
384 :     chmod 0644, $file;
385 :    
386 :     my $url = &FIG::temp_url() . "/$name";
387 :     push @html, $cgi->br . "\n"
388 :     . "<img src='$url' border=0>\n"
389 :     . $cgi->br . "\n";
390 :     }
391 :     else
392 :     {
393 :     push @html, "<h3>Failed to convert tree to PNG. Sorry.</h3>\n"
394 :     . "<h3>Please choose another format above.</h3>\n";
395 :     }
396 :     }
397 :    
398 :     #------------------------------------------------------------------
399 :     # Printer plot tree
400 :     #------------------------------------------------------------------
401 :     else
402 :     {
403 :     #------------------------------------------------------------------
404 :     # Formulate the desired labels:
405 :     #------------------------------------------------------------------
406 : golsen 1.2 # Build a function-to-color translation table based on frequency of
407 :     # function. Normally white is reserved for the current function, but
408 :     # there is none here. Assign colors until we run out, then go gray.
409 :     # Undefined function is not in %func_color, and so is not in
410 :     # %formatted_func
411 :     #----------------------------------------------------------------------
412 : golsen 1.1 my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );
413 : golsen 1.2
414 : golsen 1.1 my %labels;
415 : golsen 1.2 foreach my $id ( @uids )
416 : golsen 1.1 {
417 : golsen 1.2 my $peg = $fid_of_uid{ $id };
418 : golsen 1.1 my @label;
419 :     push @label, &HTML::fid_link( $cgi, $peg ) . '&nbsp;';
420 : golsen 1.2 push @label, qq(<INPUT Type=checkbox Name=checked Value="$peg">);
421 :     push @label, qq(<INPUT Type=radio Name=from Value="$peg">) if $fid_funcH->{ $peg };
422 :     push @label, $formatted_func{ $fid_funcH->{ $peg } } if $fid_funcH->{ $peg };
423 :     push @label, "[$orgH->{$peg}]" if $orgH->{ $peg };
424 :     push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };
425 : golsen 1.1
426 : golsen 1.2 $labels{ $id } = join( ' ', @label );
427 : golsen 1.1 }
428 :    
429 :     #------------------------------------------------------------------
430 :     # Relabel the tips, midpoint root, and pretty it up.
431 :     #------------------------------------------------------------------
432 :    
433 :     my $tree2 = newick_relabel_nodes( $tree, \%labels );
434 :     my $tree3 = reroot_newick_to_midpoint_w( $tree2 );
435 :     $tree = aesthetic_newick_tree( $tree3 );
436 :    
437 :     #------------------------------------------------------------------
438 :     # Form and JavaScript added by RAE, 2004-Jul-22, 2004-Aug-23.
439 :     # Modified by GDP to make it DWWM, 2004-Jul-23, 2004-Aug-04.
440 :     #------------------------------------------------------------------
441 :    
442 :     push @html, join( "\n",
443 :     $cgi->start_form( -method => 'post',
444 :     -target => '_blank',
445 :     -action => 'fid_checked.cgi',
446 :     -name => 'protein_tree'
447 :     ),
448 :     $cgi->hidden( -name => 'align_format', -value => $align_format ),
449 :     $cgi->hidden( -name => 'color_aln_by', -value => $color_aln_by ),
450 :     $cgi->hidden( -name => 'fid', -value => $fid ),
451 :     $cgi->hidden( -name => 'show_aliases', -value => $show_aliases ),
452 :     $cgi->hidden( -name => 'tree_format', -value => $tree_format ),
453 :     $cgi->hidden( -name => 'user', -value => $user ),
454 :     ""
455 :     );
456 :    
457 :     #------------------------------------------------------------------
458 :     # Draw the tree as printer plot.
459 :     #------------------------------------------------------------------
460 :    
461 :     my $plot_options = { chars => 'html', # html-encoded unicode box set
462 :     format => 'tree_lbl', # line = [ $graphic, $label ]
463 :     dy => 1,
464 :     min_dx => 1,
465 :     width => 64
466 :     };
467 :     push @html, join( "\n",
468 :     '',
469 :     '<DIV Class="tree">',
470 :     ( map { my ( $line, $lbl ) = @$_;
471 :     # Fix white space for even spacing:
472 :     $line =~ s/((&nbsp;)+)/<SPAN Class=w>$1<\/SPAN>/g;
473 :     $line =~ s/&nbsp;/&#9474;/g;
474 :     # Output line, with or without label:
475 :     $lbl ? "<PRE>$line</PRE> $lbl<BR />"
476 :     : "<PRE>$line</PRE><BR />"
477 :     }
478 :     gjonewicklib::text_plot_newick( $tree, $plot_options )
479 :     ),
480 :     '</DIV>',
481 :     '', ''
482 :     );
483 :    
484 :     push @html, join ("\n", $cgi->br, &HTML::java_buttons("protein_tree", "checked"), $cgi->br, "");
485 :    
486 :     push @html, join("\n",
487 :     "For selected (checked) sequences: "
488 :     , $cgi->submit('align'),
489 :     , $cgi->submit('view annotations')
490 :     , $cgi->submit('show regions')
491 :     , $cgi->br
492 :     , ""
493 :     );
494 :    
495 :     if ( $user )
496 :     {
497 :     push @html, $cgi->submit('assign/annotate') . "\n";
498 :    
499 :     push @html, join( "\n",
500 :     $cgi->br,
501 :     "<A HRef='Html/help_for_assignments_and_rules.html' Target=_blank>Help on Assignments, Rules, and Checkboxes</A>",
502 :     ""
503 :     );
504 :     }
505 :    
506 :     push @html, $cgi->end_form, "\n";
507 :     }
508 :    
509 :     }
510 :    
511 :     #==============================================================================
512 :     # Find alignments and trees with fid
513 :     #==============================================================================
514 :    
515 :     if ( ! $show_align && ! $show_tree )
516 :     {
517 :     if ( $fid && ! @ali_tree_ids )
518 :     {
519 :     @ali_tree_ids = AlignsAndTreesServer::aligns_with_pegID( $fid );
520 :     push @html, "Sorry, no alignments with protein id '$fid'\n<BR /><BR />\n" if ! @ali_tree_ids;
521 :     }
522 :    
523 :     if ( @ali_tree_ids )
524 :     {
525 :     push @html, $cgi->h2( "Select an Alignment and/or Tree" );
526 :    
527 :     push @html, join( "\n",
528 : golsen 1.2 'Select an alignment/tree ID: ',
529 : golsen 1.1 $cgi->start_form( -method => 'post',
530 :     -action => 'align_and_tree.cgi',
531 :     -name => 'align_and_tree'
532 :     ),
533 :     $cgi->hidden( -name => 'fid', -value => $fid ),
534 :     $cgi->hidden( -name => 'user', -value => $user ),
535 :     @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),
536 :    
537 :     $cgi->scrolling_list( -name => 'ali_tree_id',
538 :     -values => \@ali_tree_ids,
539 :     -size => scalar @ali_tree_ids
540 :     ),
541 :     $cgi->br,
542 :    
543 :     $cgi->checkbox( -name => 'show_align',
544 :     -label => 'Show alignment',
545 :     -override => 1,
546 :     -checked => $show_align
547 :     ),
548 :    
549 :     $cgi->checkbox( -name => 'show_tree',
550 :     -label => 'Show tree',
551 :     -override => 1,
552 :     -checked => $show_tree
553 :     ),
554 :     $cgi->br,
555 :    
556 :     'Color alignment by: ',
557 :     $cgi->radio_group( -name => 'color_aln_by',
558 :     -override => 1,
559 :     -values => [ 'consensus', 'residue' ],
560 :     -default => $color_aln_by
561 :     ),
562 :     $cgi->br,
563 :    
564 :     'Alignment format: ',
565 :     $cgi->radio_group( -name => 'align_format',
566 :     -override => 1,
567 :     -values => [ 'default', 'fasta', 'clustal' ],
568 :     -default => $align_format || 'default'
569 :     ),
570 :     $cgi->br,
571 :    
572 :     'Tree format: ',
573 :     $cgi->radio_group( -name => 'tree_format',
574 :     -override => 1,
575 :     -values => [ 'default', 'newick', 'png' ],
576 :     -default => $tree_format || 'default'
577 :     ),
578 :     $cgi->br,
579 :    
580 :     $cgi->checkbox( -name => 'show_aliases',
581 :     -label => 'Show aliases in tree',
582 :     -override => 1,
583 :     -checked => $show_aliases
584 :     ),
585 :     $cgi->br,
586 :    
587 :     $cgi->submit( 'show' ),
588 :     $cgi->br,
589 :     $cgi->end_form,
590 :     ''
591 :     );
592 :     }
593 :    
594 :     #==============================================================================
595 :     # Request a fid
596 :     #==============================================================================
597 :    
598 :     else
599 :     {
600 :     push @html, $cgi->h2( "Enter a Protein ID for an Alignment and/or Tree" );
601 :    
602 :     push @html, join( "\n",
603 :     $cgi->start_form( -method => 'post',
604 :     -action => 'align_and_tree.cgi',
605 :     -name => 'align_and_tree'
606 :     ),
607 :     $cgi->hidden( -name => 'user', -value => $user ),
608 :     @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),
609 :    
610 :     'Enter a SEED protein id: ',
611 :     $cgi->textfield( -name => "fid", -size => 32 ),
612 :     $cgi->br,
613 :    
614 :     $cgi->checkbox( -name => 'show_align',
615 :     -label => 'Show alignment',
616 :     -override => 1,
617 :     -checked => $show_align
618 :     ),
619 :    
620 :     $cgi->checkbox( -name => 'show_tree',
621 :     -label => 'Show tree',
622 :     -override => 1,
623 :     -checked => $show_tree
624 :     ),
625 :     $cgi->br,
626 :    
627 :     'Color alignment by: ',
628 :     $cgi->radio_group( -name => 'color_aln_by',
629 :     -override => 1,
630 :     -values => [ 'consensus', 'residue' ],
631 :     -default => $color_aln_by
632 :     ),
633 :     $cgi->br,
634 :    
635 :     'Alignment format: ',
636 :     $cgi->radio_group( -name => 'align_format',
637 :     -override => 1,
638 :     -values => [ 'default', 'fasta', 'clustal' ],
639 :     -default => $align_format || 'default'
640 :     ),
641 :     $cgi->br,
642 :    
643 :     'Tree format: ',
644 :     $cgi->radio_group( -name => 'tree_format',
645 :     -override => 1,
646 :     -values => [ 'default', 'newick', 'png' ],
647 :     -default => $tree_format || 'default'
648 :     ),
649 :     $cgi->br,
650 :    
651 :     $cgi->checkbox( -name => 'show_aliases',
652 :     -label => 'Show aliases in tree',
653 :     -override => 1,
654 :     -checked => $show_aliases
655 :     ),
656 :     $cgi->br,
657 :    
658 :     $cgi->submit( 'show' ),
659 :     $cgi->br,
660 :     $cgi->end_form,
661 :     ''
662 :     );
663 :     }
664 :     }
665 :    
666 :     #==============================================================================
667 :     # Report the output
668 :     #==============================================================================
669 :    
670 :     print join( '', @html, "\n" );
671 :     exit;
672 :    
673 :    
674 :     #==============================================================================
675 :     # Only subroutines below
676 :     #==============================================================================
677 :     # This is a sufficient set of escaping for text in HTML (function and alias):
678 :     #
679 :     # $html = html_esc( $text )
680 :     #------------------------------------------------------------------------------
681 :    
682 :     sub html_esc { local $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
683 :    
684 :    
685 :     sub to_clustal
686 :     {
687 :     my($alignment) = @_;
688 :    
689 :     my($tuple,$seq,$i);
690 :     my $len_name = 0;
691 :     foreach $tuple (@$alignment)
692 :     {
693 :     my $sz = length($tuple->[0]);
694 :     $len_name = ($sz > $len_name) ? $sz : $len_name;
695 :     }
696 :    
697 :     my @seq = map { $_->[2] } @$alignment;
698 :     my $seq1 = shift @seq;
699 :     my $cons = "\377" x length($seq1);
700 :     foreach $seq (@seq)
701 :     {
702 :     $seq = ~($seq ^ $seq1);
703 :     $seq =~ tr/\377/\000/c;
704 :     $cons &= $seq;
705 :     }
706 :     $cons =~ tr/\000/ /;
707 :     $cons =~ tr/\377/*/;
708 :    
709 :     push(@$alignment,["","",$cons]);
710 :    
711 :     my @out = ();
712 :     for ($i=0; ($i < length($seq1)); $i += 50)
713 :     {
714 :     foreach $tuple (@$alignment)
715 :     {
716 :     my($id,undef,$seq) = @$tuple;
717 :     my $line = sprintf("\%-${len_name}s %s\n", $id, substr($seq,$i,50));
718 :     push(@out,$line);
719 :     }
720 :     push(@out,"\n");
721 :     }
722 :     return join("","CLUSTAL W (1.8.3) multiple sequence alignment\n\n\n",@out);
723 :     }
724 :    
725 :    
726 :     sub page_head_html
727 :     {
728 :     my ( $title ) = @_;
729 :    
730 :     $title ||= 'The SEED: Alignments and Trees';
731 :    
732 :     # This stuff is because different browsers render the contents differently.
733 :    
734 :     my $agent = $ENV{ HTTP_USER_AGENT } || '';
735 :     my $height = $agent =~ /Safari/i ? '110%'
736 :     : $agent =~ /Firefox/i ? '100%'
737 :     : '100%';
738 :     my $lsize = $agent =~ /Safari/i ? '160%'
739 :     : $agent =~ /Firefox/i ? '130%'
740 :     : '140%';
741 :    
742 :     return <<"End_of_Head";
743 :     <HTML>
744 :     <HEAD>
745 :     <TITLE>$title</TITLE>
746 :    
747 :     <STYLE Type="text/css">
748 :     /* Support for HTML printer graphics tree */
749 :     DIV.tree {
750 :     border-spacing: 0px;
751 :     font-size: 100%;
752 :     line-height: $height;
753 :     white-space: nowrap;
754 :     }
755 :     DIV.tree A {
756 :     text-decoration: none;
757 :     }
758 :     DIV.tree PRE {
759 :     padding: 0px;
760 :     margin: 0px;
761 :     font-size: $lsize;
762 :     display: inline;
763 :     }
764 :     DIV.tree INPUT {
765 :     padding: 0px;
766 :     margin: 0px;
767 :     height: 10px; /* ignored by Firefox */
768 :     width: 10px; /* ignored by Firefox */
769 :     }
770 :     DIV.tree SPAN.w { /* used for tree white space */
771 :     color: white;
772 :     }
773 :     </STYLE>
774 :    
775 :     </HEAD>
776 :     <BODY>
777 :     End_of_Head
778 :    
779 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3