[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.1 - (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 :     my $align_id = $cgi->param( 'align' );
46 :     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 :     my $tree_id = $cgi->param( 'tree' );
54 :    
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 :     my ( $metaH, @uids, %fid_of_uid, @fids, $fid_funcH, $orgH, $aliasH );
180 :     if ( $ali_tree_id && ( $show_align || $show_tree ) )
181 :     {
182 :     $metaH = AlignsAndTreesServer::peg_alignment_metadata( $ali_tree_id );
183 :     $metaH && %$metaH
184 :     or push @html, cgi->h2( "No data for alignment and tree '$ali_tree_id'." );
185 :    
186 :     @uids = keys %$metaH; # Ids of alignment line and tree tips
187 :     %fid_of_uid = map { $_ => $metaH->{$_}->[0] } @uids;
188 :    
189 :     my %peg_seen = {};
190 :     @fids = grep { ! $peg_seen{$_}++ } values %fid_of_uid;
191 :    
192 :     #--------------------------------------------------------------------------
193 :     # Find the current functions:
194 :     #--------------------------------------------------------------------------
195 :    
196 :     my $sapObject = SAPserver->new();
197 :     my $fid_funcH = $sapObject->ids_to_functions( -ids => \@fids ) || {};
198 :    
199 :     #--------------------------------------------------------------------------
200 :     # Get the organism names:
201 :     #--------------------------------------------------------------------------
202 :    
203 :     my $orgH = $sapObject->ids_to_genomes( -ids => \@fids, -name => 1 );
204 :    
205 :     #------------------------------------------------------------------
206 :     # Aliases
207 :     #------------------------------------------------------------------
208 :     my %alias;
209 :     if ( $show_aliases ) { 0 }
210 :     $aliasH = \%alias;
211 :     }
212 :    
213 :    
214 :     #==============================================================================
215 :     # Alignment. The alignment is triples: [ $seq_id, $def, $aligned_seq ]
216 :     #==============================================================================
217 :    
218 :     if ( $show_align )
219 :     {
220 :     #----------------------------------------------------------------------
221 :     # Get the alignment.
222 :     #----------------------------------------------------------------------
223 :    
224 :     my $align = AlignsAndTreesServer::peg_alignment_by_ID( $ali_tree_id );
225 :     $align && @$align
226 :     or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );
227 :    
228 :     # This defines the ordering.
229 :     my @seq_ids = map { $_->[0] } @$align;
230 :    
231 :     push @html, "<h2>Alignment $ali_tree_id</h2>\n";
232 :    
233 :     if ( $align && @$align && ( $align_format eq "fasta" ) )
234 :     {
235 :     my ( $id, $peg );
236 :     my %def = map { $id = $_->[0];
237 :     $peg = $fid_of_uid{ $id };
238 :     $id => join( ' ', $id,
239 :     ( $fid_funcH->{ $id } ? $fid_funcH->{ $id } : () ),
240 :     ( $orgH->{ $id } ? "[$orgH->{$id}]" : () )
241 :     )
242 :     }
243 :     @$align;
244 :     push @html, join( "\n",
245 :     "<PRE>",
246 :     ( map { ( ">$def{$_->[0]}", $_->[2] =~ m/(.{1,60})/g ) } @$align ),
247 :     "</PRE>\n"
248 :     );
249 :     }
250 :    
251 :     elsif ( $align && @$align && ( $align_format eq "clustal" ) )
252 :     {
253 :     push @html, "<PRE>\n", &to_clustal( $align ), "</PRE>\n";
254 :     }
255 :    
256 :     elsif ( $align && @$align )
257 :     {
258 :     #----------------------------------------------------------------------
259 :     # Build a function-to-color translation table based on frequency of
260 :     # function. Normally white is reserved for the current function, but
261 :     # there is none here. Assign colors until we run out, then go gray.
262 :     # Undefined function is not in %func_color, and so is not in
263 :     # %formatted_func
264 :     #----------------------------------------------------------------------
265 :    
266 :     my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );
267 :     # my %formatted_func = &FIGgjo::colorize_functions( $fid_funcH );
268 :    
269 :     my ( $align2, $legend );
270 :    
271 :     # Color by residue type:
272 :    
273 :     if ( $color_aln_by eq 'residue' )
274 :     {
275 :     my %param1 = ( align => $align, protein => 1 );
276 :     $align2 = gjoalign2html::color_alignment_by_residue( \%param1 );
277 :     }
278 :    
279 :     # Color by consensus:
280 :    
281 :     else
282 :     {
283 :     my %param1 = ( align => $align );
284 :     ( $align2, $legend ) = gjoalign2html::color_alignment_by_consensus( \%param1 );
285 :     }
286 :    
287 :     # Add organism names:
288 :    
289 :     foreach ( @$align2 ) { $_->[1] = $orgH->{ $_->[0] } }
290 :    
291 :     # Build a tool tip with organism names and functions:
292 :    
293 :     my %tips = map { $_ => [ $_, join( $cgi->hr, $orgH->{ $_ }, $fid_funcH->{ $_ } ) ] }
294 :     @checked;
295 :     $tips{ 'Consen1' } = [ 'Consen1', 'Primary consensus residue' ];
296 :     $tips{ 'Consen2' } = [ 'Consen2', 'Secondary consensus residue' ];
297 :    
298 :     my %param2 = ( align => $align2,
299 :     ( $legend ? ( legend => $legend ) : () ),
300 :     tooltip => \%tips
301 :     );
302 :    
303 :     push @html, join( "\n",
304 :     scalar gjoalign2html::alignment_2_html_table( \%param2 ),
305 :     $cgi->br,
306 :     );
307 :     }
308 :     }
309 :    
310 :    
311 :     #==============================================================================
312 :     # Tree:
313 :     #==============================================================================
314 :    
315 :     if ( $show_tree )
316 :     {
317 :     my $tree = AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );
318 :     $tree or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );
319 :    
320 :     push @html, "<h2>Tree $ali_tree_id</h2>\n" if $tree;
321 :    
322 :     my @tips = $tree ? gjonewicklib::newick_tip_list( $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 :     #------------------------------------------------------------------
347 :     # Formulate the desired labels
348 :     #------------------------------------------------------------------
349 :     my %labels;
350 :     foreach my $id ( @tips )
351 :     {
352 :     my $peg = $fid_of_uid{ $id };
353 :     my @label;
354 :     push @label, $id;
355 :     push @label, "[$orgH->{$peg}]" if $orgH->{ $peg };
356 :     push @label, $fid_funcH->{ $peg } if $fid_funcH->{ $peg };
357 :     push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };
358 :    
359 :     $labels{ $id } = join( ' ', @label );
360 :     }
361 :    
362 :     #------------------------------------------------------------------
363 :     # Relabel the tips, midpoint root, pretty it up and draw
364 :     # the tree as printer plot
365 :     #
366 :     # Adjustable parameters on text_plot_newick:
367 :     #
368 :     # @lines = text_plot_newick( $node, $width, $min_dx, $dy )
369 :     #------------------------------------------------------------------
370 :     my $tree2 = newick_relabel_nodes( $tree, \%labels );
371 :     my $tree3 = reroot_newick_to_midpoint_w( $tree2 );
372 :    
373 :     $tree = aesthetic_newick_tree( $tree3 );
374 :     my $options = { thickness => 2,
375 :     dy => 15,
376 :     };
377 :     my $gd = gd_tree::gd_plot_newick( $tree, $options );
378 :    
379 :     my $name = sprintf( "align_and_tree_%d_%08d.$fmt", $$, int(1e8*rand()) );
380 :     my $file = "$FIG_Config::temp/$name";
381 :     open TREE, ">$file";
382 :     binmode TREE;
383 :     print TREE $gd->$fmt;
384 :     close TREE;
385 :     chmod 0644, $file;
386 :    
387 :     my $url = &FIG::temp_url() . "/$name";
388 :     push @html, $cgi->br . "\n"
389 :     . "<img src='$url' border=0>\n"
390 :     . $cgi->br . "\n";
391 :     }
392 :     else
393 :     {
394 :     push @html, "<h3>Failed to convert tree to PNG. Sorry.</h3>\n"
395 :     . "<h3>Please choose another format above.</h3>\n";
396 :     }
397 :     }
398 :    
399 :     #------------------------------------------------------------------
400 :     # Printer plot tree
401 :     #------------------------------------------------------------------
402 :     else
403 :     {
404 :     #------------------------------------------------------------------
405 :     # Build checkboxes and radio buttons for appropriate sequences:
406 :     #------------------------------------------------------------------
407 :    
408 :     my %check;
409 :     my @translatable = grep { $fig->translatable( $_ ) } @checked;
410 :     %check = map { $_ => qq(<INPUT Type=checkbox Name=checked Value="$_">) }
411 :     @translatable;
412 :    
413 :     my %from;
414 :     if ( $user )
415 :     {
416 :     %from = map { m/value=\"([^\"]+)\"/; $1 => $_ }
417 :     $cgi->radio_group( -name => 'from',
418 :     -nolabels => 1,
419 :     -override => 1,
420 :     -values => [ @translatable ],
421 :     -default => $fid
422 :     );
423 :     }
424 :    
425 :     #------------------------------------------------------------------
426 :     # Formulate the desired labels:
427 :     #------------------------------------------------------------------
428 :     my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );
429 :     my %labels;
430 :     foreach my $peg ( @checked )
431 :     {
432 :     my @label;
433 :     push @label, &HTML::fid_link( $cgi, $peg ) . '&nbsp;';
434 :     push @label, $check{ $peg } if $check{ $peg };
435 :     push @label, $from{ $peg } if $from{ $peg };
436 :     push @label, $formatted_func{ $fid_funcH->{ $peg } } if $fid_funcH->{ $peg };
437 :     push @label, "[$orgH->{$peg}]" if $orgH->{ $peg };
438 :     push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };
439 :    
440 :     $labels{ $peg } = join( ' ', @label );
441 :     }
442 :    
443 :     #------------------------------------------------------------------
444 :     # Relabel the tips, midpoint root, and pretty it up.
445 :     #------------------------------------------------------------------
446 :    
447 :     my $tree2 = newick_relabel_nodes( $tree, \%labels );
448 :     my $tree3 = reroot_newick_to_midpoint_w( $tree2 );
449 :     $tree = aesthetic_newick_tree( $tree3 );
450 :    
451 :     #------------------------------------------------------------------
452 :     # Form and JavaScript added by RAE, 2004-Jul-22, 2004-Aug-23.
453 :     # Modified by GDP to make it DWWM, 2004-Jul-23, 2004-Aug-04.
454 :     #------------------------------------------------------------------
455 :    
456 :     push @html, join( "\n",
457 :     $cgi->start_form( -method => 'post',
458 :     -target => '_blank',
459 :     -action => 'fid_checked.cgi',
460 :     -name => 'protein_tree'
461 :     ),
462 :     $cgi->hidden( -name => 'align_format', -value => $align_format ),
463 :     $cgi->hidden( -name => 'color_aln_by', -value => $color_aln_by ),
464 :     $cgi->hidden( -name => 'fid', -value => $fid ),
465 :     $cgi->hidden( -name => 'show_aliases', -value => $show_aliases ),
466 :     $cgi->hidden( -name => 'tree_format', -value => $tree_format ),
467 :     $cgi->hidden( -name => 'user', -value => $user ),
468 :     ""
469 :     );
470 :    
471 :     #------------------------------------------------------------------
472 :     # Draw the tree as printer plot.
473 :     #------------------------------------------------------------------
474 :    
475 :     my $plot_options = { chars => 'html', # html-encoded unicode box set
476 :     format => 'tree_lbl', # line = [ $graphic, $label ]
477 :     dy => 1,
478 :     min_dx => 1,
479 :     width => 64
480 :     };
481 :     push @html, join( "\n",
482 :     '',
483 :     '<DIV Class="tree">',
484 :     ( map { my ( $line, $lbl ) = @$_;
485 :     # Fix white space for even spacing:
486 :     $line =~ s/((&nbsp;)+)/<SPAN Class=w>$1<\/SPAN>/g;
487 :     $line =~ s/&nbsp;/&#9474;/g;
488 :     # Output line, with or without label:
489 :     $lbl ? "<PRE>$line</PRE> $lbl<BR />"
490 :     : "<PRE>$line</PRE><BR />"
491 :     }
492 :     gjonewicklib::text_plot_newick( $tree, $plot_options )
493 :     ),
494 :     '</DIV>',
495 :     '', ''
496 :     );
497 :    
498 :     push @html, join ("\n", $cgi->br, &HTML::java_buttons("protein_tree", "checked"), $cgi->br, "");
499 :    
500 :     push @html, join("\n",
501 :     "For selected (checked) sequences: "
502 :     , $cgi->submit('align'),
503 :     , $cgi->submit('view annotations')
504 :     , $cgi->submit('show regions')
505 :     , $cgi->br
506 :     , ""
507 :     );
508 :    
509 :     if ( $user )
510 :     {
511 :     push @html, $cgi->submit('assign/annotate') . "\n";
512 :    
513 :     push @html, join( "\n",
514 :     $cgi->br,
515 :     "<A HRef='Html/help_for_assignments_and_rules.html' Target=_blank>Help on Assignments, Rules, and Checkboxes</A>",
516 :     ""
517 :     );
518 :     }
519 :    
520 :     push @html, $cgi->end_form, "\n";
521 :     }
522 :    
523 :     }
524 :    
525 :     #==============================================================================
526 :     # Find alignments and trees with fid
527 :     #==============================================================================
528 :    
529 :     if ( ! $show_align && ! $show_tree )
530 :     {
531 :     if ( $fid && ! @ali_tree_ids )
532 :     {
533 :     @ali_tree_ids = AlignsAndTreesServer::aligns_with_pegID( $fid );
534 :     push @html, "Sorry, no alignments with protein id '$fid'\n<BR /><BR />\n" if ! @ali_tree_ids;
535 :     }
536 :    
537 :     if ( @ali_tree_ids )
538 :     {
539 :     push @html, $cgi->h2( "Select an Alignment and/or Tree" );
540 :    
541 :     push @html, join( "\n",
542 :     'Select an alignment: ',
543 :     $cgi->start_form( -method => 'post',
544 :     -action => 'align_and_tree.cgi',
545 :     -name => 'align_and_tree'
546 :     ),
547 :     $cgi->hidden( -name => 'fid', -value => $fid ),
548 :     $cgi->hidden( -name => 'user', -value => $user ),
549 :     @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),
550 :    
551 :     $cgi->scrolling_list( -name => 'ali_tree_id',
552 :     -values => \@ali_tree_ids,
553 :     -size => scalar @ali_tree_ids
554 :     ),
555 :     $cgi->br,
556 :    
557 :     $cgi->checkbox( -name => 'show_align',
558 :     -label => 'Show alignment',
559 :     -override => 1,
560 :     -checked => $show_align
561 :     ),
562 :    
563 :     $cgi->checkbox( -name => 'show_tree',
564 :     -label => 'Show tree',
565 :     -override => 1,
566 :     -checked => $show_tree
567 :     ),
568 :     $cgi->br,
569 :    
570 :     'Color alignment by: ',
571 :     $cgi->radio_group( -name => 'color_aln_by',
572 :     -override => 1,
573 :     -values => [ 'consensus', 'residue' ],
574 :     -default => $color_aln_by
575 :     ),
576 :     $cgi->br,
577 :    
578 :     'Alignment format: ',
579 :     $cgi->radio_group( -name => 'align_format',
580 :     -override => 1,
581 :     -values => [ 'default', 'fasta', 'clustal' ],
582 :     -default => $align_format || 'default'
583 :     ),
584 :     $cgi->br,
585 :    
586 :     'Tree format: ',
587 :     $cgi->radio_group( -name => 'tree_format',
588 :     -override => 1,
589 :     -values => [ 'default', 'newick', 'png' ],
590 :     -default => $tree_format || 'default'
591 :     ),
592 :     $cgi->br,
593 :    
594 :     $cgi->checkbox( -name => 'show_aliases',
595 :     -label => 'Show aliases in tree',
596 :     -override => 1,
597 :     -checked => $show_aliases
598 :     ),
599 :     $cgi->br,
600 :    
601 :     $cgi->submit( 'show' ),
602 :     $cgi->br,
603 :     $cgi->end_form,
604 :     ''
605 :     );
606 :     }
607 :    
608 :     #==============================================================================
609 :     # Request a fid
610 :     #==============================================================================
611 :    
612 :     else
613 :     {
614 :     push @html, $cgi->h2( "Enter a Protein ID for an Alignment and/or Tree" );
615 :    
616 :     push @html, join( "\n",
617 :     $cgi->start_form( -method => 'post',
618 :     -action => 'align_and_tree.cgi',
619 :     -name => 'align_and_tree'
620 :     ),
621 :     $cgi->hidden( -name => 'user', -value => $user ),
622 :     @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),
623 :    
624 :     'Enter a SEED protein id: ',
625 :     $cgi->textfield( -name => "fid", -size => 32 ),
626 :     $cgi->br,
627 :    
628 :     $cgi->checkbox( -name => 'show_align',
629 :     -label => 'Show alignment',
630 :     -override => 1,
631 :     -checked => $show_align
632 :     ),
633 :    
634 :     $cgi->checkbox( -name => 'show_tree',
635 :     -label => 'Show tree',
636 :     -override => 1,
637 :     -checked => $show_tree
638 :     ),
639 :     $cgi->br,
640 :    
641 :     'Color alignment by: ',
642 :     $cgi->radio_group( -name => 'color_aln_by',
643 :     -override => 1,
644 :     -values => [ 'consensus', 'residue' ],
645 :     -default => $color_aln_by
646 :     ),
647 :     $cgi->br,
648 :    
649 :     'Alignment format: ',
650 :     $cgi->radio_group( -name => 'align_format',
651 :     -override => 1,
652 :     -values => [ 'default', 'fasta', 'clustal' ],
653 :     -default => $align_format || 'default'
654 :     ),
655 :     $cgi->br,
656 :    
657 :     'Tree format: ',
658 :     $cgi->radio_group( -name => 'tree_format',
659 :     -override => 1,
660 :     -values => [ 'default', 'newick', 'png' ],
661 :     -default => $tree_format || 'default'
662 :     ),
663 :     $cgi->br,
664 :    
665 :     $cgi->checkbox( -name => 'show_aliases',
666 :     -label => 'Show aliases in tree',
667 :     -override => 1,
668 :     -checked => $show_aliases
669 :     ),
670 :     $cgi->br,
671 :    
672 :     $cgi->submit( 'show' ),
673 :     $cgi->br,
674 :     $cgi->end_form,
675 :     ''
676 :     );
677 :     }
678 :     }
679 :    
680 :     #==============================================================================
681 :     # Report the output
682 :     #==============================================================================
683 :    
684 :     print join( '', @html, "\n" );
685 :     exit;
686 :    
687 :    
688 :     #==============================================================================
689 :     # Only subroutines below
690 :     #==============================================================================
691 :     # This is a sufficient set of escaping for text in HTML (function and alias):
692 :     #
693 :     # $html = html_esc( $text )
694 :     #------------------------------------------------------------------------------
695 :    
696 :     sub html_esc { local $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
697 :    
698 :    
699 :     sub to_clustal
700 :     {
701 :     my($alignment) = @_;
702 :    
703 :     my($tuple,$seq,$i);
704 :     my $len_name = 0;
705 :     foreach $tuple (@$alignment)
706 :     {
707 :     my $sz = length($tuple->[0]);
708 :     $len_name = ($sz > $len_name) ? $sz : $len_name;
709 :     }
710 :    
711 :     my @seq = map { $_->[2] } @$alignment;
712 :     my $seq1 = shift @seq;
713 :     my $cons = "\377" x length($seq1);
714 :     foreach $seq (@seq)
715 :     {
716 :     $seq = ~($seq ^ $seq1);
717 :     $seq =~ tr/\377/\000/c;
718 :     $cons &= $seq;
719 :     }
720 :     $cons =~ tr/\000/ /;
721 :     $cons =~ tr/\377/*/;
722 :    
723 :     push(@$alignment,["","",$cons]);
724 :    
725 :     my @out = ();
726 :     for ($i=0; ($i < length($seq1)); $i += 50)
727 :     {
728 :     foreach $tuple (@$alignment)
729 :     {
730 :     my($id,undef,$seq) = @$tuple;
731 :     my $line = sprintf("\%-${len_name}s %s\n", $id, substr($seq,$i,50));
732 :     push(@out,$line);
733 :     }
734 :     push(@out,"\n");
735 :     }
736 :     return join("","CLUSTAL W (1.8.3) multiple sequence alignment\n\n\n",@out);
737 :     }
738 :    
739 :    
740 :     sub page_head_html
741 :     {
742 :     my ( $title ) = @_;
743 :    
744 :     $title ||= 'The SEED: Alignments and Trees';
745 :    
746 :     # This stuff is because different browsers render the contents differently.
747 :    
748 :     my $agent = $ENV{ HTTP_USER_AGENT } || '';
749 :     my $height = $agent =~ /Safari/i ? '110%'
750 :     : $agent =~ /Firefox/i ? '100%'
751 :     : '100%';
752 :     my $lsize = $agent =~ /Safari/i ? '160%'
753 :     : $agent =~ /Firefox/i ? '130%'
754 :     : '140%';
755 :    
756 :     return <<"End_of_Head";
757 :     <HTML>
758 :     <HEAD>
759 :     <TITLE>$title</TITLE>
760 :    
761 :     <STYLE Type="text/css">
762 :     /* Support for HTML printer graphics tree */
763 :     DIV.tree {
764 :     border-spacing: 0px;
765 :     font-size: 100%;
766 :     line-height: $height;
767 :     white-space: nowrap;
768 :     }
769 :     DIV.tree A {
770 :     text-decoration: none;
771 :     }
772 :     DIV.tree PRE {
773 :     padding: 0px;
774 :     margin: 0px;
775 :     font-size: $lsize;
776 :     display: inline;
777 :     }
778 :     DIV.tree INPUT {
779 :     padding: 0px;
780 :     margin: 0px;
781 :     height: 10px; /* ignored by Firefox */
782 :     width: 10px; /* ignored by Firefox */
783 :     }
784 :     DIV.tree SPAN.w { /* used for tree white space */
785 :     color: white;
786 :     }
787 :     </STYLE>
788 :    
789 :     </HEAD>
790 :     <BODY>
791 :     End_of_Head
792 :    
793 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3