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

Diff of /FigWebServices/align_and_tree.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Sat Nov 12 00:01:44 2011 UTC revision 1.3, Mon Nov 14 01:44:00 2011 UTC
# Line 28  Line 28 
28                               peg_alignment_by_ID                               peg_alignment_by_ID
29                               peg_tree_by_ID                               peg_tree_by_ID
30                               aligns_with_pegID                               aligns_with_pegID
31                                 get_md5_projections
32                             );                             );
33    
34  use Data::Dumper;  use Data::Dumper;
# Line 37  Line 38 
38                                           debug_load   => 0,                                           debug_load   => 0,
39                                           print_params => 0 );                                           print_params => 0 );
40    
41  #  Incoming information:  my $sapObject = SAPserver->new();
42    
43    # The html will be assembled here.
44    
45    print $cgi->header;
46    my @html = ();
47    
48    #------------------------------------------------------------------------------
49    #  Convert the cgi paramater values to a local summary of the work to be done
50    #------------------------------------------------------------------------------
51    
52  my $ali_tree_id  = $cgi->param( 'ali_tree_id' );  my $action        = $cgi->param( 'action' );        # assign is the only special action
53    my $ali_tree_id   = $cgi->param( 'ali_tree_id' )  || '';
54  my @ali_tree_ids = $cgi->param( 'at_ids' );  my @ali_tree_ids = $cgi->param( 'at_ids' );
55  my $align_format = $cgi->param( 'align_format' );  my $align_format  = $cgi->param( 'align_format' );  # default || fasta || clustal
56  my $align_id     = $cgi->param( 'align_id' );  my $align_id     = $cgi->param( 'align_id' );
57    my $au            = $cgi->param( 'assign_using' );
58    my $assign_using  = ( $au =~ /^Sap/i ) ? 'Sapling' : 'SEED';
59  my @checked      = $cgi->param( 'checked' );  my @checked      = $cgi->param( 'checked' );
60  my $color_aln_by = $cgi->param( 'color_aln_by' ) || 'consensus';  my $color_aln_by  = $cgi->param( 'color_aln_by' ) || 'consensus'; # consensus || residue
61  my $fid          = $cgi->param( 'fid' );  my $fid           = $cgi->param( 'fid' )          || '';
62  my $show_aliases = $cgi->param( 'show_aliases' );  my $from          = $cgi->param( 'from' )         || '';     # assignment to propagate
63    my $rep_pegs      = $cgi->param( 'rep_pegs' )     || 'all';  # all || roles || dlit || paralog
64    my $show_aliases  = $cgi->param( 'show_aliases' ) || '';
65  my $show_align   = $cgi->param( 'show_align' );  my $show_align   = $cgi->param( 'show_align' );
66  my $show_tree    = $cgi->param( 'show_tree' );  my $show_tree    = $cgi->param( 'show_tree' );
67  my $tree_format  = $cgi->param( 'tree_format' );  my $tree_format   = $cgi->param( 'tree_format' );   # default || newick || png
68  my $tree_id      = $cgi->param( 'tree_id' );  my $tree_id      = $cgi->param( 'tree_id' );
69    
70  #  Let's see if we can work out missing values from other data:  #  Let's see if we can work out missing values from other data:
71    
72  $fid         ||= $checked[0] if @checked == 1;  $fid         ||= $checked[0] if @checked == 1;
73  $ali_tree_id ||= $align_id || $tree_id;  $ali_tree_id ||= $align_id || $tree_id || '';
74  if ( ( ! $ali_tree_id ) && $fid )  $ali_tree_id   = '' if $action =~ /ali.* tree.* with.* prot/;  #  Forced update of list
75    if ( ( ! $ali_tree_id ) && ( ! @ali_tree_ids ) && $fid )
76  {  {
77      @ali_tree_ids = AlignsAndTreesServer::aligns_with_pegID( $fid ) if ! @ali_tree_ids;      @ali_tree_ids = AlignsAndTreesServer::aligns_with_pegID( $sapObject, $fid );
     $ali_tree_id  = $ali_tree_ids[0] if @ali_tree_ids == 1;  
78  }  }
79    $ali_tree_id ||= $ali_tree_ids[0] if @ali_tree_ids == 1;
80    
81  #  Move alignment and tree selection information into one id and two booleans  #  Move alignment and tree selection information into one id and two booleans
82    
83  $show_align = ( $ali_tree_id && $show_align ) || $align_id;  $show_align ||= $align_id;
84  $show_tree  = ( $ali_tree_id && $show_tree  ) || $tree_id;  $show_tree  ||= $tree_id;
 $align_id   = undef;  
 $tree_id    = undef;  
85    
86    #------------------------------------------------------------------------------
87    #  We have the analysis paramaters.  Put them in a local hash so they can be passed to
88    #  subroutines.
89    #------------------------------------------------------------------------------
90    
91  # The html will be assembled here.  my $data = {};
92    
93  print $cgi->header;  $data->{ fig }          =  $fig;
94    $data->{ sap }          =  $sapObject;
95    $data->{ cgi }          =  $cgi;
96    $data->{ html }         = \@html;
97    $data->{ user }         =  $user;
98    
99    $data->{ action }       =  $action;
100    $data->{ ali_tree_id }  =  $ali_tree_id;
101    $data->{ ali_tree_ids } = \@ali_tree_ids;
102    $data->{ align_format } =  $align_format;
103    $data->{ assign_using } =  $assign_using;
104    $data->{ can_assign }   =  $user && ( $assign_using =~ /SEED/i );
105    $data->{ checked }      = \@checked;
106    $data->{ color_aln_by } =  $color_aln_by;
107    $data->{ fid }          =  $fid;
108    $data->{ from }         =  $from;
109    $data->{ rep_pegs }     =  $rep_pegs;
110    $data->{ show_aliases } =  $show_aliases;
111    $data->{ show_align }   =  $show_align;
112    $data->{ show_tree }    =  $show_tree;
113    $data->{ tree_format }  =  $tree_format;
114    
115  my @html = ();  #------------------------------------------------------------------------------
116  if ( $show_align )  #  Start the page:
117    #------------------------------------------------------------------------------
118    
119    page_head_html( $data );
120    
121    
122    #------------------------------------------------------------------------------
123    #  Deal with assignments:
124    #------------------------------------------------------------------------------
125    
126    if ( $data->{ action } =~ /assign/i )
127  {  {
128      if ( $show_tree )      make_assignments( $data );
129    }
130    
131    #------------------------------------------------------------------------------
132    #  Change the focus peg:
133    #------------------------------------------------------------------------------
134    
135    if ( $data->{ action } =~ /focus/i && $from )
136      {      {
137          push @html, page_head_html( "The SEED: Protein Alignment $ali_tree_id" );      $fid = $from;
138      }      }
139      else  
140    #------------------------------------------------------------------------------
141    #  Start the form:
142    #------------------------------------------------------------------------------
143    
144    push @html, $cgi->start_form( -method => 'post',
145                                  -action => 'align_and_tree.cgi',
146                                  -name   => 'alignment'
147                                );
148    
149    #------------------------------------------------------------------------------
150    #  Alignment and tree format controls:
151    #------------------------------------------------------------------------------
152    
153    add_general_options( $data );
154    
155    #------------------------------------------------------------------------------
156    #  Collect all of the necessary alignment and/or tree data:
157    #------------------------------------------------------------------------------
158    
159    if ( $data->{ ali_tree_id } && ( $data->{ show_align } || $data->{ show_tree } ) )
160      {      {
161          push @html, page_head_html( "The SEED: Protein Alignment and Tree $ali_tree_id" );      compile_alignment_and_tree_data( $data );
162      }      }
163    
164    #------------------------------------------------------------------------------
165    #  Alignment dispaly
166    #------------------------------------------------------------------------------
167    
168    if ( $data->{ ali_tree_id } && $data->{ show_align } )
169    {
170        show_alignment( $data );
171  }  }
172  else  
173    #------------------------------------------------------------------------------
174    #  Tree display
175    #------------------------------------------------------------------------------
176    
177    if ( $data->{ ali_tree_id } && $data->{ show_tree } )
178    {
179        show_tree( $data );
180    }
181    
182    #------------------------------------------------------------------------------
183    #  Select alignments and trees with given fid
184    #------------------------------------------------------------------------------
185    
186    if ( ! $data->{ ali_tree_id } )
187    {
188        show_alignments_and_trees_with_fid( $data );
189    }
190    
191    #------------------------------------------------------------------------------
192    #  Finish form and page
193    #------------------------------------------------------------------------------
194    
195    push @html, join( "\n",
196                      $cgi->end_form,
197                      $cgi->br,
198                      '</BODY>',
199                      '</HTML>',
200                      ''
201                    );
202    
203    #------------------------------------------------------------------------------
204    #  Report the output
205    #------------------------------------------------------------------------------
206    
207    print join( '', @html, "\n" );
208    exit;
209    
210    
211    #==============================================================================
212    #  Only subroutines below
213    #==============================================================================
214    #  This is a sufficient set of escaping for text in HTML (function and alias):
215    #
216    #     $html = html_esc( $text )
217    #------------------------------------------------------------------------------
218    
219    sub html_esc { local $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }
220    
221    
222    #===============================================================================
223    #  Start the HTML
224    #===============================================================================
225    
226    sub page_head_html
227  {  {
228      if ( $show_tree )      my ( $data ) = @_;
229        my $html = $data->{ html } || [];
230    
231        my $ali_tree_id = $data->{ ali_tree_id };
232        my $fid         = $data->{ fid };
233        my $show_align  = $data->{ show_align };
234        my $show_tree   = $data->{ show_tree };
235    
236        my $title;
237        if ( $show_align && $ali_tree_id )
238      {      {
239          push @html, page_head_html( "The SEED: Protein Tree $ali_tree_id" );          if ( $show_tree ) { $title = "The SEED: Protein Alignment $ali_tree_id" }
240            else              { $title = "The SEED: Protein Alignment and Tree $ali_tree_id" }
241      }      }
242      elsif ( $fid )      elsif ( $show_tree && $ali_tree_id )
243      {      {
244          push @html, page_head_html( "The SEED: Protein Alignment and Tree Selector for '$fid'" );          $title = "The SEED: Protein Tree $ali_tree_id";
245      }      }
246      else      else
247      {      {
248          push @html, page_head_html( "The SEED: Protein Alignment and Tree Selector" );          if ( $fid ) { $title = "The SEED: Protein Alignment and Tree Selector for '$fid'" }
249            else        { $title = "The SEED: Protein Alignment and Tree Selector" }
250      }      }
251    
252        #  This stuff is because different browsers render the contents differently.
253    
254        my $agent  = $ENV{ HTTP_USER_AGENT } || '';
255        my $height = $agent =~ /Safari/i  ? '110%'
256                   : $agent =~ /Firefox/i ? '100%'
257                   :                        '100%';
258        my $lsize  = $agent =~ /Safari/i  ? '160%'
259                   : $agent =~ /Firefox/i ? '130%'
260                   :                        '140%';
261    
262        push @$html, <<"End_of_Head";
263    <HTML>
264    <HEAD>
265    <TITLE>$title</TITLE>
266    
267    <STYLE Type="text/css">
268      /* Support for HTML printer graphics tree */
269      DIV.tree {
270        border-spacing: 0px;
271        font-size:     100%;
272        line-height:    $height;
273        white-space: nowrap;
274      }
275      DIV.tree A {
276        text-decoration: none;
277      }
278      DIV.tree PRE {
279        padding:    0px;
280        margin:     0px;
281        font-size: $lsize;
282        display: inline;
283  }  }
284      DIV.tree INPUT {
285        padding: 0px;
286        margin:  0px;
287        height: 10px;    /* ignored by Firefox */
288        width:  10px;    /* ignored by Firefox */
289      }
290      DIV.tree SPAN.w {  /* used for tree white space */
291        color: white;
292      }
293    </STYLE>
294    
295  #==============================================================================  </HEAD>
296  #  Alignment and tree format controls:  <BODY>
297  #==============================================================================  End_of_Head
298    
299  push @html, join( "\n",      return @$html if wantarray;
300                    $cgi->start_form( -method => 'post',  }
301                                      -action => 'align_and_tree.cgi',  
302                                      -name   => 'alignment'  
303                                    ),  #===============================================================================
304                    $cgi->hidden( -name => 'fid',     -value =>  $fid ),  #  Make requested assignments.
305                    $cgi->hidden( -name => 'user',    -value =>  $user ),  #===============================================================================
306    
307    sub make_assignments
308    {
309        my ( $data ) = @_;
310    
311        my $fig  = $data->{ fig };
312        my $sap  = $data->{ sap };
313        my $cgi  = $data->{ cgi };
314        my $html = $data->{ html };
315        my $user = $data->{ user };
316        my $from = $data->{ from };
317    
318        my $func;
319        if ( defined( $from ) && ( $func = $fig->function_of( $from, $user ) ) && @{ $data->{ checked } } )
320        {
321            $func =~ s/\s+\#[^\#].*$//;       #  Remove single hash comments
322            # We now expand the pegs to all pegs with the same md5:
323            my $pegs_to_md5 = AlignsAndTreesServer::pegs_to_md5( $sap, @{ $data->{ checked } } );
324    
325                    @checked     ? $cgi->hidden( -name => 'checked',     -value => \@checked )    : (),          #***********************************************************************
326                    $ali_tree_id ? $cgi->hidden( -name => 'ali_tree_id', -value => $ali_tree_id ) : (),          #  Note: values %$pegs_to_md5 may include values that you do not want!!!
327            #***********************************************************************
328            my %seen_md5;
329            my @md5s = grep { ! $seen_md5{ $_ }++ }
330                       map  { $pegs_to_md5->{ $_ } }
331                       @{ $data->{ checked } };
332            my $md5s_to_pegs = AlignsAndTreesServer::md5s_to_pegs( $sap, @md5s );
333    
334            #***********************************************************************
335            #  Note: values %$md5s_to_pegs may include values that you do not want!!!
336            #***********************************************************************
337            my %seen_peg = ( $from => 1 );   #  Skip self assignment
338            my @pegs = grep { ! $seen_peg{ $_ }++ }
339                       map  { @{ $md5s_to_pegs->{ $_ } || [] } }
340                       @md5s;
341    
342            if (  $data->{ assign_using } =~ /SEED/i && $fig )
343            {
344                my ( $nsucc, $nfail );
345                foreach my $peg ( @pegs )
346                {
347                    if ( $fig->assign_function( $peg, $user, $func, "" ) )
348                    {
349                        $fig->add_annotation( $peg, $user, "Assigned based on tree proximity to $from\n" );
350                        $nsucc++;
351                    }
352                    else
353                    {
354                        $nfail++;
355                    }
356                }
357                push @$html, $cgi->h3( "$nsucc protein assignments made." )   if $nsucc;
358                push @$html, $cgi->h3( "$nfail attemped protein assignments ignored." ) if $nfail;
359            }
360        }
361    }
362    
363    
364    #===============================================================================
365    #  Push the general page options into the html.
366    #===============================================================================
367    
368    sub add_general_options
369    {
370        my ( $data ) = @_;
371        my $cgi  = $data->{ cgi };
372        my $html = $data->{ html } || [];
373    
374                    $cgi->checkbox( -name     => 'show_align',      if ( @{ $data->{ checked } } && ! $data->{ show_tree } )
375        {
376            push @$html, $cgi->hidden( -name => 'checked', -value => $data->{ checked } );
377        }
378    
379        if ( $data->{ ali_tree_id } )
380        {
381            push @$html, $cgi->hidden( -name => 'ali_tree_id', -value => $data->{ ali_tree_id } );
382        }
383    
384        push @$html, 'SEED user: ',
385                     $cgi->textfield( -name => "user", -value => $user, -size => 32 ),
386                     $cgi->br;
387    
388        if ( $data->{ ali_tree_id } || $data->{ fid } )
389        {
390            push @$html, 'Focus protein ID? ';
391        }
392        else
393        {
394            push @$html, $cgi->h2( 'Enter a SEED protein id: ' );
395        }
396    
397        push @$html, $cgi->textfield( -name => "fid", -size => 32, -value => $data->{ fid } ),
398                     $cgi->submit( -name => 'action', -value => 'list all alignments and trees with this protein' ),
399                     $cgi->br;
400    
401        if ( ! $data->{ show_align } && ! $data->{ show_tree } )
402        {
403            push @$html, $cgi->h2( 'Neither alignment nor tree are selected below.  Please select at least one.' );
404        }
405    
406        push @$html, $cgi->checkbox( -name     => 'show_align',
407                                    -label    => 'Show alignment',                                    -label    => 'Show alignment',
408                                    -override => 1,                                    -override => 1,
409                                    -checked  => $show_align                                   -checked  => $data->{ show_align }
410                                  ),                                  ),
411                     '&nbsp;',
412                    $cgi->checkbox( -name     => 'show_tree',                    $cgi->checkbox( -name     => 'show_tree',
413                                    -label    => 'Show tree',                                    -label    => 'Show tree',
414                                    -override => 1,                                    -override => 1,
415                                    -checked  => $show_tree                                   -checked  => $data->{ show_tree }
416                                  ),                                  ),
417                    $cgi->br,                   $cgi->br, $cgi->br;
418    
419        if ( $user )
420        {
421            push @$html, 'Use for functions and assignments: ',
422                         $cgi->radio_group( -name     => 'assign_using',
423                                            -override => 1,
424                                            -values   => [ 'Sapling', 'SEED' ],
425                                            -default  => $data->{ assign_using }
426                                          ),
427                         $cgi->br;
428        }
429    
430        push @$html, $cgi->br,
431                    'Color alignment by: ',                    'Color alignment by: ',
432                    $cgi->radio_group( -name     => 'color_aln_by',                    $cgi->radio_group( -name     => 'color_aln_by',
433                                       -override => 1,                                       -override => 1,
434                                       -values   => [ 'consensus', 'residue' ],                                       -values   => [ 'consensus', 'residue' ],
435                                       -default  => $color_aln_by                                      -default  => $data->{ color_aln_by }
436                                     ),                                     ),
437                    $cgi->br,                   $cgi->br;
438    
439                    'Alignment format: ',      push @$html, 'Alignment format: ',
440                    $cgi->radio_group( -name     => 'align_format',                    $cgi->radio_group( -name     => 'align_format',
441                                       -override => 1,                                       -override => 1,
442                                       -values   => [ 'default', 'fasta', 'clustal' ],                                       -values   => [ 'default', 'fasta', 'clustal' ],
443                                       -default  => $align_format || 'default'                                      -default  => $data->{ align_format } || 'default'
444                                     ),                                     ),
445                    $cgi->br,                   $cgi->br, $cgi->br;
446    
447                    'Tree format: ',      push @$html, 'Tree format: ',
448                    $cgi->radio_group( -name     => 'tree_format',                    $cgi->radio_group( -name     => 'tree_format',
449                                       -override => 1,                                       -override => 1,
450                                       -values   => [ 'default', 'newick', 'png' ],                                       -values   => [ 'default', 'newick', 'png' ],
451                                       -default  => $tree_format || 'default'                                      -default  => $data->{ tree_format } || 'default'
452                                     ),                                     ),
453                    $cgi->br,                   $cgi->br;
454    
455                    $cgi->checkbox( -name     => 'show_aliases',      push @$html, $cgi->checkbox( -name     => 'show_aliases',
456                                    -label    => 'Show aliases in tree',                                    -label    => 'Show aliases in tree',
457                                    -override => 1,                                    -override => 1,
458                                    -checked  => $show_aliases                                   -checked  => $data->{ show_aliases }
459                                  ),                                  ),
460                    $cgi->br,                   $cgi->br, $cgi->br;
461    
462                    $cgi->submit( 'update' ),      push @$html, $cgi->submit( -name => 'action', -value => 'update' ),
463                    $cgi->br,                   $cgi->br;
464                    $cgi->end_form,  
465                    "\n"      return @$html if wantarray;
466                  ) if $ali_tree_id && ( $show_align || $show_tree );  }
467    
468    
469  #------------------------------------------------------------------------------  #------------------------------------------------------------------------------
470  #  Get the metadata for the alignment and/or tree.  #  Compile all necessary data for alignments and trees.
471  #  The per sequence metadata are:  #  The per sequence metadata are:
472  #  #
473  #      [ $peg_id, $peg_length, $trim_beg, $trim_end, $location_string ]  #      [ $peg_id, $peg_length, $trim_beg, $trim_end, $location_string ]
474  #  #
475  #------------------------------------------------------------------------------  #------------------------------------------------------------------------------
476    
477  my ( $align, $tree, $metaH, @uids, %fid_of_uid, @fids, $fid_funcH, $orgH, $aliasH );  sub compile_alignment_and_tree_data
 if ( $ali_tree_id && ( $show_align || $show_tree ) )  
 {  
     if ( $show_align )  
478      {      {
479          ( $align, $metaH ) = AlignsAndTreesServer::peg_alignment_by_ID( $ali_tree_id );      my ( $data ) = @_;
480      }  
481      elsif ( $show_tree )      ( $data->{ ali_tree_id } && ( $data->{ show_align } || $data->{ show_tree } ) )
482            or return 0;
483    
484        my $html = $data->{ html } || [];
485        my $sap  = $data->{ sap };
486    
487        my $align = [];
488        my $tree  = undef;
489        my $metaH = {};
490    
491        if ( $data->{ show_align } )
492      {      {
493          ( $tree, $metaH ) = AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );          ( $align, $metaH ) = AlignsAndTreesServer::peg_alignment_by_ID( $data->{ ali_tree_id } );
494      }      }
495      else      if ( $data->{ show_tree } )
496      {      {
497          $metaH = AlignsAndTreesServer::peg_alignment_metadata( $ali_tree_id );          ( $tree, $metaH ) = AlignsAndTreesServer::peg_tree_by_ID( $data->{ ali_tree_id } );
498      }      }
499    
500      $metaH && %$metaH      $metaH && %$metaH
501          or push @html, cgi->h2( "No data for alignment and tree '$ali_tree_id'." );          or push @$html, $cgi->h2( "No data for alignment and tree '$data->{ali_tree_id}'." );
502    
503      @uids = keys %$metaH;    # Ids of alignment line and tree tips      my @uids = keys %$metaH;    # Ids of alignment line and tree tips
504      %fid_of_uid = map { $_ => $metaH->{$_}->[0] } @uids;      my %fid_of_uid = map { $_ => $metaH->{$_}->[0] } @uids;
505    
506      my %peg_seen = {};      my %peg_seen = {};
507      @fids = grep { ! $peg_seen{$_}++ } values %fid_of_uid;      my @fids = grep { ! $peg_seen{$_}++ } values %fid_of_uid;
508    
509      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
510      #  Find the current functions:      #  Find the current functions and organism names:
511      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
512    
513      my $sapObject = SAPserver->new();      my $fid_funcH = {};
514      $fid_funcH = $sapObject->ids_to_functions( -ids => \@fids ) || {};      my $orgH      = {};
515        if ( @fids && $data->{ assign_using } =~ /^SEED/i && $fig )
516        {
517            foreach my $peg ( @fids )
518            {
519                $fid_funcH->{ $peg } = $fig->function_of( $peg, $user ) || "";
520                $orgH->{ $peg }      = $fig->org_of( $peg );
521            }
522        }
523        elsif ( @fids )
524        {
525           $sap ||= SAPserver->new();
526           $fid_funcH = $sap->ids_to_functions( -ids => \@fids ) || {};
527           $orgH      = $sap->ids_to_genomes( -ids => \@fids, -name => 1 ) || {};
528        }
529    
530      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
531      #  Get the organism names:      #  Aliases
532      #--------------------------------------------------------------------------      #--------------------------------------------------------------------------
533    
534      $orgH = $sapObject->ids_to_genomes( -ids => \@fids, -name => 1 );      my $aliasH = {};
535        if ( $data->{ show_aliases } ) { 0 }
536    
537      #------------------------------------------------------------------      #--------------------------------------------------------------------------
538      #  Aliases      #  dlits
539      #------------------------------------------------------------------      #--------------------------------------------------------------------------
540      my %alias;  
541      if ( $show_aliases ) { 0 }      my $dlitH = $sap->dlits_for_ids( -ids => \@fids );
542      $aliasH = \%alias;  
543      # push @html, '<PRE>', Dumper( $fid_funcH, $orgH ), '</PRE>';      #--------------------------------------------------------------------------
544        #  Projections from peg of md5a:
545        #
546        #  [ $n_shared, $identity, $score ]
547        #--------------------------------------------------------------------------
548    
549        #  Get the projections
550        my $md5   = AlignsAndTreesServer::peg_to_md5( $sap, $fid ) || '';
551        my $projH = AlignsAndTreesServer::get_md5_projections( $md5, { details => 1 } ) || {};
552        my @projs = @{ $projH->{ $md5 } || [] };
553    
554        #  Expend the md5 values
555        my @proj_md5s   = map { $_->[0] } @projs;
556        my $md5_to_pegs = AlignsAndTreesServer::md5s_to_pegs( $sap, $md5, @proj_md5s );
557    
558        #  Expand the projections
559        my ( $proj, $md5b, @pegs );
560        my %projection;
561        foreach $proj ( @projs )
562        {
563            $md5b = $proj->[0];
564            @pegs = @{ $md5_to_pegs->{ $md5b } || [] };
565            foreach ( @pegs ) { $projection{ $_ } = [ @$proj[ 1 .. 3 ] ] }
566        }
567    
568        #  Projections to identical sequences
569        @pegs = @{ $md5_to_pegs->{ $md5 } || [] };
570        foreach ( @pegs ) { $projection{ $_ } = [ 10, 100, 1 ] }
571    
572        #--------------------------------------------------------------------------
573        #  Put in data hash
574        #--------------------------------------------------------------------------
575    
576        $data->{ alias }      =  $aliasH;
577        $data->{ align }      =  $align;
578        $data->{ dlits }      =  $dlitH;
579        $data->{ fid_func }   =  $fid_funcH;
580        $data->{ fid_of_uid } = \%fid_of_uid;
581        $data->{ fids }       = \@fids;
582        $data->{ org }        =  $orgH;
583        $data->{ projects }   = \%projection;
584        $data->{ seq_meta }   =  $metaH;
585        $data->{ tree }       =  $tree;
586        $data->{ uids }       = \@uids;
587    
588        return @$html if wantarray;
589  }  }
590    
591    
592  #==============================================================================  #==============================================================================
593  #  Alignment.  The alignment is triples: [ $seq_id, $def, $aligned_seq ]  #  Show an alignment
594  #==============================================================================  #==============================================================================
595    
596  if ( $show_align )  sub show_alignment
597  {  {
598      #----------------------------------------------------------------------      my ( $data ) = @_;
599      #  Got the alignment above      my $html = $data->{ html } || [];
600      #----------------------------------------------------------------------  
601        ( $data->{ ali_tree_id } && $data->{ show_align } ) or return;
602    
603        my $align = $data->{ align };
604      $align && @$align      $align && @$align
605          or push @html, cgi->h2( "No data for alignment '$ali_tree_id'." );          or push @$html, $cgi->h2( "No data for alignment '$data->{ali_tree_id}'." );
606    
607      #  This defines the ordering.      #  This defines the ordering.
608      my @seq_ids = map { $_->[0] } @$align;      my @seq_ids = map { $_->[0] } @$align;
609    
610      push @html, "<h2>Alignment $ali_tree_id</h2>\n";      push @$html, $cgi->h2( "Alignment $data->{ali_tree_id}" ) . "\n";
611    
612        my $fid_of_uid = $data->{ fid_of_uid };
613        my $fid_func   = $data->{ fid_func };
614        my $org        = $data->{ org };
615    
616      if ( $align && @$align && ( $align_format eq "fasta" ) )      if ( $align && @$align && ( $data->{ align_format } =~ /^fasta/i ) )
617      {      {
618          my ( $id, $peg );          my ( $id, $peg );
619          my %def = map { $id = $_->[0];          my %def = map { $id = $_->[0];
620                          $peg = $fid_of_uid{ $id };                          $peg = $fid_of_uid->{ $id };
621                          $id => join( ' ', $id,                          $id => join( ' ', $id,
622                                            ( $fid_funcH->{ $id } ? $fid_funcH->{$id} : () ),                                            ( $fid_func->{ $id } ? $fid_func->{$id} : () ),
623                                            ( $orgH->{ $id }      ? "[$orgH->{$id}]"    : () )                                            ( $org->{ $id }      ? "[$org->{$id}]"    : () )
624                                     )                                     )
625                        }                        }
626                    @$align;                    @$align;
627    
628          push @html, join( "\n",          push @$html, join( "\n",
629                            "<PRE>",                            "<PRE>",
630                            ( map { ( ">$def{$_->[0]}", $_->[2] =~ m/(.{1,60})/g ) } @$align ),                            ( map { ( ">$def{$_->[0]}", $_->[2] =~ m/(.{1,60})/g ) } @$align ),
631                            "</PRE>\n"                            "</PRE>\n"
632                          );                          );
633      }      }
634    
635      elsif ( $align && @$align && ( $align_format eq "clustal" ) )      elsif ( $align && @$align && ( $data->{ align_format } =~ /^clustal/i ) )
636      {      {
637          push @html, "<PRE>\n", &to_clustal( $align ), "</PRE>\n";          push @$html, "<PRE>\n", &to_clustal( $align ), "</PRE>\n";
638      }      }
639    
640      elsif ( $align && @$align )      elsif ( $align && @$align )
# Line 271  Line 643 
643    
644          #  Color by residue type:          #  Color by residue type:
645    
646          if ( $color_aln_by eq 'residue' )          if ( $data->{ color_aln_by } eq 'residue' )
647          {          {
648              my %param1 = ( align => $align, protein => 1 );              my %param1 = ( align => $align, protein => 1 );
649              $align2 = gjoalign2html::color_alignment_by_residue( \%param1 );              $align2 = gjoalign2html::color_alignment_by_residue( \%param1 );
# Line 287  Line 659 
659    
660          #  Add organism names:          #  Add organism names:
661    
662          foreach ( @$align2 ) { $_->[1] = $orgH->{ $_->[0] || '' } }          foreach ( @$align2 ) { $_->[1] = $org->{ $_->[0] || '' } }
663    
664          #  Build a tool tip with organism names and functions:          #  Build a tool tip with organism names and functions:
665    
666          my %tips = map { $_ => [ $_, join( $cgi->hr, $orgH->{ $_ }, $fid_funcH->{ $_ } ) ] }          my %tips = map { $_ => [ $_, join( $cgi->hr, $org->{ $_ }, $fid_func->{ $_ } ) ] }
667                     map { $_->[0] }                     map { $_->[0] }
668                     @$align2;                     @$align2;
669          $tips{ 'Consen1' } = [ 'Consen1', 'Primary consensus residue' ];          $tips{ 'Consen1' } = [ 'Consen1', 'Primary consensus residue' ];
670          $tips{ 'Consen2' } = [ 'Consen2', 'Secondary consensus residue' ];          $tips{ 'Consen2' } = [ 'Consen2', 'Secondary consensus residue' ];
671    
672          my %param2 = ( align   => $align2,          my %param2 = ( align   => $align2,
673                         tooltip => \%tips                         tooltip => \%tips
674                       );                       );
675          $param2{ legend } = $legend if $legend;          $param2{ legend } = $legend if $legend;
676    
677            push @$html, join( "\n",
678                               scalar gjoalign2html::alignment_2_html_table( \%param2 ),
679                               $cgi->br,
680                             );
681        }
682    
683        return @$html if wantarray;
684    }
685    
686    
687    #------------------------------------------------------------------------------
688    #  Clustal format alignment
689    #------------------------------------------------------------------------------
690    sub to_clustal
691    {
692        my( $alignment ) = @_;
693    
694        my($tuple,$seq,$i);
695        my $len_name = 0;
696        foreach $tuple ( @$alignment )
697        {
698            my $sz = length( $tuple->[0] );
699            $len_name = ($sz > $len_name) ? $sz : $len_name;
700        }
701    
702        my @seq  = map { $_->[2] } @$alignment;
703        my $seq1 = shift @seq;
704        my $cons = "\377" x length($seq1);
705        foreach $seq (@seq)
706        {
707            $seq  = ~($seq ^ $seq1);
708            $seq  =~ tr/\377/\000/c;
709            $cons &= $seq;
710        }
711        $cons =~ tr/\000/ /;
712        $cons =~ tr/\377/*/;
713    
714        push(@$alignment,["","",$cons]);
715    
716          push @html, join( "\n",      my @out = ();
717                             scalar gjoalign2html::alignment_2_html_table( \%param2 ),      for ($i=0; ($i < length($seq1)); $i += 50)
718                             $cgi->br,      {
719                           );          foreach $tuple (@$alignment)
720            {
721                my($id,undef,$seq) = @$tuple;
722                my $line = sprintf("\%-${len_name}s %s\n", $id, substr($seq,$i,50));
723                push(@out,$line);
724            }
725            push(@out,"\n");
726      }      }
727        return join("","CLUSTAL W (1.8.3) multiple sequence alignment\n\n\n",@out);
728  }  }
729    
730    
# Line 314  Line 732 
732  #  Tree:  #  Tree:
733  #==============================================================================  #==============================================================================
734    
735  if ( $show_tree )  sub show_tree
736    {
737        my ( $data ) = @_;
738    
739        my $html = $data->{ html } || [];
740    
741        my $tree = $data->{ tree };
742        if ( ! $tree )
743  {  {
744      $tree ||= AlignsAndTreesServer::peg_tree_by_ID( $ali_tree_id );          push @$html, $cgi->h2( "No data for tree '$data->{ali_tree_id}'." );
745      $tree or push @html, cgi->h2( "No data for tree '$ali_tree_id'." );          return wantarray ? @$html : ();
746        }
747    
748      push @html, "<h2>Tree $ali_tree_id</h2>\n"  if $tree;      push @$html, $cgi->h2( "Tree $data->{ali_tree_id}" ) . "\n"  if $tree;
749    
750        my $can_assign = $data->{ can_assign };
751        my $fid_of_uid = $data->{ fid_of_uid };
752        my $fid_func   = $data->{ fid_func } || {};
753        my $org        = $data->{ org }      || {};
754        my $alias      = $data->{ alias }    || {};
755        my $dlits      = $data->{ dlits }    || {};
756        my $proj       = $data->{ projects } || {};
757    
758      #------------------------------------------------------------------      #------------------------------------------------------------------
759      #  Newick tree      #  Newick tree
760      #------------------------------------------------------------------      #------------------------------------------------------------------
761      if ( $tree && ( $tree_format eq "newick" ) )      if ( $tree && ( $data->{ tree_format } =~ /^newick/i ) )
762      {      {
763          push @html, "<pre>\n" . &gjonewicklib::formatNewickTree( $tree ) . "</pre>\n";          push @$html, "<pre>\n" . &gjonewicklib::formatNewickTree( $tree ) . "</pre>\n";
764      }      }
765    
766      #------------------------------------------------------------------      #------------------------------------------------------------------
767      #  PNG tree      #  PNG tree
768      #------------------------------------------------------------------      #------------------------------------------------------------------
769      elsif ( $tree && ( $tree_format eq "png" ) )      elsif ( $tree && ( $data->{ tree_format } =~ /^png/i ) )
770      {      {
771          my $okay;          my $okay;
772          eval { require gd_tree_0; $okay = 1 };          eval { require gd_tree_0; $okay = 1 };
# Line 346  Line 780 
780              #  Formulate the desired labels              #  Formulate the desired labels
781              #------------------------------------------------------------------              #------------------------------------------------------------------
782              my %labels;              my %labels;
783              foreach my $id ( @uids )              foreach my $id ( @{ $data->{ uids } } )
784              {              {
785                  my   $peg = $fid_of_uid{ $id };                  my   $peg = $fid_of_uid->{ $id };
786                  my   @label;                  my   @label;
787                  push @label, $id;                  push @label, $id;
788                  push @label, $fid_funcH->{ $peg }          if $fid_funcH->{ $peg };                  push @label, $fid_func->{ $peg }          if $fid_func->{ $peg };
789                  push @label, "[$orgH->{$peg}]"             if $orgH->{ $peg };                  push @label, "[$org->{$peg}]"             if $org->{ $peg };
790                  push @label, html_esc( $aliasH->{ $peg } ) if $aliasH->{ $peg };                  push @label, html_esc( $alias->{ $peg } ) if $alias->{ $peg };
791    
792                  $labels{ $id } = join( ' ', @label );                  $labels{ $id } = join( ' ', @label );
793              }              }
# Line 384  Line 818 
818              chmod   0644, $file;              chmod   0644, $file;
819    
820              my $url = &FIG::temp_url() . "/$name";              my $url = &FIG::temp_url() . "/$name";
821              push @html, $cgi->br . "\n"              push @$html, $cgi->br . "\n"
822                        . "<img src='$url' border=0>\n"                        . "<img src='$url' border=0>\n"
823                        .  $cgi->br . "\n";                        .  $cgi->br . "\n";
824          }          }
825          else          else
826          {          {
827              push @html, "<h3>Failed to convert tree to PNG.  Sorry.</h3>\n"              push @$html, "<h3>Failed to convert tree to PNG.  Sorry.</h3>\n"
828                        . "<h3>Please choose another format above.</h3>\n";                        . "<h3>Please choose another format above.</h3>\n";
829          }          }
830      }      }
# Line 409  Line 843 
843          #  Undefined function is not in %func_color, and so is not in          #  Undefined function is not in %func_color, and so is not in
844          #  %formatted_func          #  %formatted_func
845          #----------------------------------------------------------------------          #----------------------------------------------------------------------
846          my %formatted_func = &FIGgjo::colorize_roles( $fid_funcH );          my %formatted_func = &FIGgjo::colorize_roles( $fid_func );
847    
848          my %labels;          my %labels;
849          foreach my $id ( @uids )          foreach my $id ( @{ $data->{ uids } } )
850            {
851                my $peg      = $fid_of_uid->{ $id };
852                my $func     = $fid_func->{ $peg };
853                my $functext = $func ? $formatted_func{ $func } : '';
854                my $orgname  = $org->{ $peg } ? html_esc( $org->{ $peg } ) : '';
855                my $proj_scr = $proj->{ $peg } ? $proj->{ $peg }->[2] : 0;
856                my $hbar     = score_to_hbar( $proj_scr );
857    
858                if ( $dlits->{$peg} && @{$dlits->{$peg}} )
859          {          {
860              my   $peg = $fid_of_uid{ $id };                  $functext = qq(<SPAN Style='font-weight:bold'>$functext</SPAN>) if $functext;
861                    $orgname  = qq(<SPAN Style='font-weight:bold'>$orgname</SPAN>)  if $orgname;
862                }
863    
864              my   @label;              my   @label;
865              push @label, &HTML::fid_link( $cgi, $peg ) . '&nbsp;';              push @label, &HTML::fid_link( $cgi, $peg ) . '&nbsp;';
866              push @label, qq(<INPUT Type=checkbox Name=checked Value="$peg">);              push @label, qq(<INPUT Type=checkbox Name=checked Value="$peg">) if $can_assign && $orgname;
867              push @label, qq(<INPUT Type=radio    Name=from    Value="$peg">)  if $fid_funcH->{ $peg };              push @label, qq(<INPUT Type=radio    Name=from    Value="$peg">) if $func;
868              push @label, $formatted_func{ $fid_funcH->{ $peg } }              if $fid_funcH->{ $peg };              push @label, $hbar;
869              push @label, "[$orgH->{$peg}]"                                    if $orgH->{ $peg };              push @label, $functext                                           if $functext;
870              push @label, html_esc( $aliasH->{ $peg } )                        if $aliasH->{ $peg };              push @label, "[$orgname]"                                        if $orgname;
871                push @label, html_esc( $alias->{ $peg } )                        if $alias->{ $peg };
872    
873              $labels{ $id } = join( ' ', @label );              $labels{ $id } = join( ' ', @label );
874          }          }
# Line 439  Line 886 
886          #  Modified by GDP to make it DWWM, 2004-Jul-23, 2004-Aug-04.          #  Modified by GDP to make it DWWM, 2004-Jul-23, 2004-Aug-04.
887          #------------------------------------------------------------------          #------------------------------------------------------------------
888    
889          push @html, join( "\n",          push @$html, join( "\n",
890                             $cgi->start_form( -method => 'post',                             $cgi->start_form( -method => 'post',
891                                               -target => '_blank',                                               -target => '_blank',
892                                               -action => 'fid_checked.cgi',                                               -action => 'fid_checked.cgi',
893                                               -name   => 'protein_tree'                                               -name   => 'protein_tree'
894                                             ),                                             ),
895                             $cgi->hidden( -name => 'align_format', -value => $align_format ),                             $cgi->hidden( -name => 'align_format', -value => $data->{ align_format } ),
896                             $cgi->hidden( -name => 'color_aln_by', -value => $color_aln_by ),                             $cgi->hidden( -name => 'color_aln_by', -value => $data->{ color_aln_by } ),
897                             $cgi->hidden( -name => 'fid',          -value => $fid ),                             $cgi->hidden( -name => 'fid',          -value => $data->{ fid } ),
898                             $cgi->hidden( -name => 'show_aliases', -value => $show_aliases ),                             $cgi->hidden( -name => 'show_aliases', -value => $data->{ show_aliases } ),
899                             $cgi->hidden( -name => 'tree_format',  -value => $tree_format ),                             $cgi->hidden( -name => 'tree_format',  -value => $data->{ tree_format } ),
900                             $cgi->hidden( -name => 'user',         -value => $user ),                             $cgi->hidden( -name => 'user',         -value => $user ),
901                             ""                             ""
902                           );                           );
# Line 458  Line 905 
905          #  Draw the tree as printer plot.          #  Draw the tree as printer plot.
906          #------------------------------------------------------------------          #------------------------------------------------------------------
907    
908            if ( $user )
909            {
910                push @$html, $cgi->submit( -name => 'action', -value => 'assign' );
911            }
912            push @$html, $cgi->submit( -name => 'action', -value => 'chnage focus peg' ),
913                         $cgi->br;
914    
915          my $plot_options = { chars  => 'html',     # html-encoded unicode box set          my $plot_options = { chars  => 'html',     # html-encoded unicode box set
916                               format => 'tree_lbl', # line = [ $graphic, $label ]                               format => 'tree_lbl', # line = [ $graphic, $label ]
917                               dy     =>  1,                               dy     =>  1,
918                               min_dx =>  1,                               min_dx =>  1,
919                               width  => 64                               width  => 64
920                             };                             };
921          push @html, join( "\n",          push @$html, join( "\n",
922                             '',                             '',
923                             '<DIV Class="tree">',                             '<DIV Class="tree">',
924                             ( map { my ( $line, $lbl ) = @$_;                             ( map { my ( $line, $lbl ) = @$_;
# Line 481  Line 935 
935                             '', ''                             '', ''
936                           );                           );
937    
938          push @html, join ("\n", $cgi->br, &HTML::java_buttons("protein_tree", "checked"), $cgi->br, "");          push @$html, join ("\n", $cgi->br, &HTML::java_buttons( "protein_tree", "checked" ), $cgi->br, "");
   
         push @html, join("\n",  
              "For selected (checked) sequences: "  
              , $cgi->submit('align'),  
              , $cgi->submit('view annotations')  
              , $cgi->submit('show regions')  
              , $cgi->br  
              , ""  
              );  
939    
940          if ( $user )          if ( $user )
941          {          {
942              push @html, $cgi->submit('assign/annotate') . "\n";              push @$html, $cgi->submit( -name => 'action', -value => 'assign' );
   
             push @html, join( "\n",  
                                $cgi->br,  
                                "<A HRef='Html/help_for_assignments_and_rules.html' Target=_blank>Help on Assignments, Rules, and Checkboxes</A>",  
                                ""  
                              );  
943          }          }
944    
945          push @html, $cgi->end_form, "\n";          push @$html, $cgi->submit( -name => 'action', -value => 'chnage focus peg' ),
946      }                       $cgi->br;
947    
948            push @$html, $cgi->end_form;
949  }  }
950    
951  #==============================================================================      return @$html if wantarray;
 #  Find alignments and trees with fid  
 #==============================================================================  
   
 if ( ! $show_align && ! $show_tree )  
 {  
     if ( $fid && ! @ali_tree_ids )  
     {  
         @ali_tree_ids = AlignsAndTreesServer::aligns_with_pegID( $fid );  
         push @html, "Sorry, no alignments with protein id '$fid'\n<BR /><BR />\n" if ! @ali_tree_ids;  
952      }      }
953    
     if ( @ali_tree_ids )  
     {  
         push @html, $cgi->h2( "Select an Alignment and/or Tree" );  
   
         push @html, join( "\n",  
                           'Select an alignment/tree ID: ',  
                           $cgi->start_form( -method => 'post',  
                                             -action => 'align_and_tree.cgi',  
                                             -name   => 'align_and_tree'  
                                           ),  
                           $cgi->hidden( -name => 'fid',     -value => $fid ),  
                           $cgi->hidden( -name => 'user',    -value => $user ),  
                           @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),  
   
                           $cgi->scrolling_list( -name   => 'ali_tree_id',  
                                                 -values => \@ali_tree_ids,  
                                                 -size   => scalar @ali_tree_ids  
                                               ),  
                           $cgi->br,  
   
                           $cgi->checkbox( -name     => 'show_align',  
                                           -label    => 'Show alignment',  
                                           -override => 1,  
                                           -checked  => $show_align  
                                         ),  
   
                           $cgi->checkbox( -name     => 'show_tree',  
                                           -label    => 'Show tree',  
                                           -override => 1,  
                                           -checked  => $show_tree  
                                         ),  
                           $cgi->br,  
   
                           'Color alignment by: ',  
                           $cgi->radio_group( -name     => 'color_aln_by',  
                                              -override => 1,  
                                              -values   => [ 'consensus', 'residue' ],  
                                              -default  => $color_aln_by  
                                            ),  
                           $cgi->br,  
   
                           'Alignment format: ',  
                           $cgi->radio_group( -name     => 'align_format',  
                                              -override => 1,  
                                              -values   => [ 'default', 'fasta', 'clustal' ],  
                                              -default  => $align_format || 'default'  
                                            ),  
                           $cgi->br,  
   
                           'Tree format: ',  
                           $cgi->radio_group( -name     => 'tree_format',  
                                              -override => 1,  
                                              -values   => [ 'default', 'newick', 'png' ],  
                                              -default  => $tree_format || 'default'  
                                            ),  
                           $cgi->br,  
   
                           $cgi->checkbox( -name     => 'show_aliases',  
                                           -label    => 'Show aliases in tree',  
                                           -override => 1,  
                                           -checked  => $show_aliases  
                                         ),  
                           $cgi->br,  
   
                           $cgi->submit( 'show' ),  
                           $cgi->br,  
                           $cgi->end_form,  
                           ''  
                         );  
     }  
954    
955      #==============================================================================      #==============================================================================
956      #  Request a fid  #  Select alignments and trees with given fid
957      #==============================================================================      #==============================================================================
958    
959      else  sub show_alignments_and_trees_with_fid
960      {      {
961          push @html, $cgi->h2( "Enter a Protein ID for an Alignment and/or Tree" );      my ( $data ) = @_;
962        my $html = $data->{ html } || [];
963          push @html, join( "\n",      my $sap  = $data->{ sap };
                           $cgi->start_form( -method => 'post',  
                                             -action => 'align_and_tree.cgi',  
                                             -name   => 'align_and_tree'  
                                           ),  
                           $cgi->hidden( -name => 'user', -value => $user ),  
                           @checked ? $cgi->hidden( -name => 'checked', -value => \@checked ) : (),  
   
                           'Enter a SEED protein id: ',  
                           $cgi->textfield( -name => "fid", -size => 32 ),  
                           $cgi->br,  
   
                           $cgi->checkbox( -name     => 'show_align',  
                                           -label    => 'Show alignment',  
                                           -override => 1,  
                                           -checked  => $show_align  
                                         ),  
   
                           $cgi->checkbox( -name     => 'show_tree',  
                                           -label    => 'Show tree',  
                                           -override => 1,  
                                           -checked  => $show_tree  
                                         ),  
                           $cgi->br,  
   
                           'Color alignment by: ',  
                           $cgi->radio_group( -name     => 'color_aln_by',  
                                              -override => 1,  
                                              -values   => [ 'consensus', 'residue' ],  
                                              -default  => $color_aln_by  
                                            ),  
                           $cgi->br,  
   
                           'Alignment format: ',  
                           $cgi->radio_group( -name     => 'align_format',  
                                              -override => 1,  
                                              -values   => [ 'default', 'fasta', 'clustal' ],  
                                              -default  => $align_format || 'default'  
                                            ),  
                           $cgi->br,  
   
                           'Tree format: ',  
                           $cgi->radio_group( -name     => 'tree_format',  
                                              -override => 1,  
                                              -values   => [ 'default', 'newick', 'png' ],  
                                              -default  => $tree_format || 'default'  
                                            ),  
                           $cgi->br,  
964    
965                            $cgi->checkbox( -name     => 'show_aliases',      if ( @{ $data->{ ali_tree_ids } } )
966                                            -label    => 'Show aliases in tree',      {
967                                            -override => 1,          push @$html, $cgi->h2( "Select an Alignment and/or Tree" ),
968                                            -checked  => $show_aliases                      '<TABLE>',
969                                          ),                      '<TR><TH>ID</TH><TH>Count</TH><TH>Role</TH><TR>',
970                            $cgi->br,                      '<TABLEBODY>';
971            foreach my $id ( @{ $data->{ ali_tree_ids } } )
972            {
973                push @$html, '<TR><TD ColSpan=3><HR /></TD></TR>';
974    
975                            $cgi->submit( 'show' ),              my @role_data = AlignsAndTreesServer::roles_in_align( $sap, $id );
976                            $cgi->br,              splice @role_data, 5 if @role_data > 5;
977                            $cgi->end_form,              my $nrow = @role_data;
978                            ''              my ( $role, $cnt ) = @{ shift @role_data };
979                          );              $role = html_esc( $role );
980                push @$html, "<TR><TD RowSpan=$nrow><INPUT Type=radio Name=ali_tree_id Value=$id /> $id</TD>";
981                push @$html, "    <TD Style='text-align:right'>$cnt</TD>";
982                push @$html, "    <TD>$role</TD>";
983                push @$html, "</TR>";
984                foreach ( @role_data )
985                {
986                    ( $role, $cnt ) = @$_;
987                    $role = html_esc( $role );
988                    push @$html, "<TR>";
989                    push @$html, "    <TD Style='text-align:right'>$cnt</TD>";
990                    push @$html, "    <TD>$role</TD>";
991                    push @$html, "</TR>";
992      }      }
993  }  }
994            push @$html, '</TABLEBODY>',
995  #==============================================================================                      '</TABLE>', $cgi->br,
996  #  Report the output                      $cgi->submit( -name => 'action', -value => 'update' ),
997  #==============================================================================                      $cgi->br;
998        }
999  print join( '', @html, "\n" );      elsif ( $data->{ fid } )
 exit;  
   
   
 #==============================================================================  
 #  Only subroutines below  
 #==============================================================================  
 #  This is a sufficient set of escaping for text in HTML (function and alias):  
 #  
 #     $html = html_esc( $text )  
 #------------------------------------------------------------------------------  
   
 sub html_esc { local $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }  
   
   
 sub to_clustal  
 {  
     my($alignment) = @_;  
   
     my($tuple,$seq,$i);  
     my $len_name = 0;  
     foreach $tuple (@$alignment)  
1000      {      {
1001          my $sz = length($tuple->[0]);          @{ $data->{ ali_tree_ids } } = AlignsAndTreesServer::aligns_with_pegID( $sap, $data->{ fid } );
1002          $len_name = ($sz > $len_name) ? $sz : $len_name;          push @$html, "Sorry, no alignments with protein id '$data->{fid}'\n<BR /><BR />\n" if ! @{ $data->{ ali_tree_ids } };
1003      }      }
1004    
1005      my @seq  = map { $_->[2] } @$alignment;      return @$html if wantarray;
     my $seq1 = shift @seq;  
     my $cons = "\377" x length($seq1);  
     foreach $seq (@seq)  
     {  
         $seq  = ~($seq ^ $seq1);  
         $seq  =~ tr/\377/\000/c;  
         $cons &= $seq;  
1006      }      }
     $cons =~ tr/\000/ /;  
     $cons =~ tr/\377/*/;  
1007    
     push(@$alignment,["","",$cons]);  
1008    
1009      my @out = ();  #  Vertical and horizontal histogram bar graphics characters:
1010      for ($i=0; ($i < length($seq1)); $i += 50)  #
1011      {  #  9601-9608
1012          foreach $tuple (@$alignment)  #  9615-9608
1013    #
1014    sub score_to_vbar
1015          {          {
1016              my($id,undef,$seq) = @$tuple;      my ($scr) = @_;
1017              my $line = sprintf("\%-${len_name}s %s\n", $id, substr($seq,$i,50));      my $code = int(($scr ** 0.8) / 0.15) + 9601;
1018              push(@out,$line);      return "&#$code";
         }  
         push(@out,"\n");  
     }  
     return join("","CLUSTAL W (1.8.3) multiple sequence alignment\n\n\n",@out);  
1019  }  }
1020    
1021    
1022  sub page_head_html  sub score_to_hbar
1023  {  {
1024      my ( $title ) = @_;      my ($scr) = @_;
1025        return '&nbsp;&nbsp;' if $scr == 0;
1026      $title ||= 'The SEED: Alignments and Trees';      my $code = 9615 - int( 7.999 * ($scr ** 1.00) );
1027        return "&#$code";
 #  This stuff is because different browsers render the contents differently.  
   
     my $agent  = $ENV{ HTTP_USER_AGENT } || '';  
     my $height = $agent =~ /Safari/i  ? '110%'  
                : $agent =~ /Firefox/i ? '100%'  
                :                        '100%';  
     my $lsize  = $agent =~ /Safari/i  ? '160%'  
                : $agent =~ /Firefox/i ? '130%'  
                :                        '140%';  
   
     return <<"End_of_Head";  
 <HTML>  
 <HEAD>  
 <TITLE>$title</TITLE>  
   
 <STYLE Type="text/css">  
   /* Support for HTML printer graphics tree */  
   DIV.tree {  
     border-spacing: 0px;  
     font-size:     100%;  
     line-height:    $height;  
     white-space: nowrap;  
   }  
   DIV.tree A {  
     text-decoration: none;  
   }  
   DIV.tree PRE {  
     padding:    0px;  
     margin:     0px;  
     font-size: $lsize;  
     display: inline;  
   }  
   DIV.tree INPUT {  
     padding: 0px;  
     margin:  0px;  
     height: 10px;    /* ignored by Firefox */  
     width:  10px;    /* ignored by Firefox */  
   }  
   DIV.tree SPAN.w {  /* used for tree white space */  
     color: white;  
1028    }    }
 </STYLE>  
1029    
 </HEAD>  
 <BODY>  
 End_of_Head  
1030    
1031  }  

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3