File Coverage

blib/lib/Bio/Tools/Run/Phylo/Phylip/DrawTree.pm
Criterion Covered Total %
statement 46 130 35.3
branch 12 58 20.6
condition 0 5 0.0
subroutine 10 15 66.6
pod 5 5 100.0
total 73 213 34.2


line stmt bran cond sub pod time code
1             # $Id$
2             #
3             # BioPerl module for Bio::Tools::Run::Phylo::Phylip::DrawTree
4             #
5             # Please direct questions and support issues to
6             #
7             # Cared for by Jason Stajich
8             #
9             # Copyright Jason Stajich
10             #
11             # You may distribute this module under the same terms as perl itself
12              
13             # POD documentation - main docs before the code
14              
15             =head1 NAME
16              
17             Bio::Tools::Run::Phylo::Phylip::DrawTree - use Phylip DrawTree
18             program to draw trees
19              
20             =head1 SYNOPSIS
21              
22             use Bio::Tools::Run::Phylo::Phylip::DrawTree;
23              
24             my $treedraw = Bio::Tools::Run::Phylo::Phylip::DrawTree->new();
25             my $treeimagefile = $drawfact->run($tree);
26              
27             =head1 DESCRIPTION
28              
29             This is a module for automating drawing of trees through Joe
30             Felsenstein's Phylip suite.
31              
32             To set parameters with option you need to pass in an array reference or
33             a string, depending on the parameter. For example:
34              
35             $treedraw->HORIZMARGINS(['2.00','2.5']);
36             $treedraw->ANCESTRALNODES('C');
37             $treedraw->TREESTYLE('PHEN');
38             $treedraw->USEBRANCHLENS('N');
39              
40             This can be a brittle module as the menus change in PHYLIP. It should
41             support phylip 3.6 but no guarantees.
42              
43             =head1 FEEDBACK
44              
45             =head2 Mailing Lists
46              
47             User feedback is an integral part of the evolution of this and other
48             Bioperl modules. Send your comments and suggestions preferably to the
49             Bioperl mailing list. Your participation is much appreciated.
50              
51             bioperl-l@bioperl.org - General discussion
52             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
53              
54             =head2 Support
55              
56             Please direct usage questions or support issues to the mailing list:
57              
58             I
59              
60             rather than to the module maintainer directly. Many experienced and
61             reponsive experts will be able look at the problem and quickly
62             address it. Please include a thorough description of the problem
63             with code and data examples if at all possible.
64              
65             =head2 Reporting Bugs
66              
67             Report bugs to the Bioperl bug tracking system to help us keep track
68             of the bugs and their resolution. Bug reports can be submitted via the
69             web:
70              
71             http://redmine.open-bio.org/projects/bioperl/
72              
73             =head1 AUTHOR - Jason Stajich
74              
75             Email jason-at-bioperl.org
76              
77             =head1 APPENDIX
78              
79             The rest of the documentation details each of the object methods.
80             Internal methods are usually preceded with a _
81              
82             =cut
83              
84              
85             # Let the code begin...
86              
87              
88             package Bio::Tools::Run::Phylo::Phylip::DrawTree;
89 1         81 use vars qw($AUTOLOAD @ISA $PROGRAM $PROGRAMDIR $PROGRAMNAME
90             $FONTFILE @DRAW_PARAMS @OTHER_SWITCHES
91 1     1   113300 %OK_FIELD %DEFAULT);
  1         1  
92 1     1   4 use strict;
  1         1  
  1         16  
93             # inherit from Phylip::Base which has some methods for dealing with
94             # Phylip specifics
95 1     1   357 use Bio::Tools::Run::Phylo::Phylip::Base;
  1         3  
  1         27  
96 1     1   4 use Cwd;
  1         1  
  1         59  
97              
98             @ISA = qw( Bio::Tools::Run::Phylo::Phylip::Base );
99              
100 1     1   3 use Bio::Tools::Run::Phylo::Phylip::PhylipConf qw(%Menu);
  1         1  
  1         202  
101              
102             # You will need to enable the neighbor program. This
103             # can be done in (at least) 3 ways:
104             #
105             # 1. define an environmental variable PHYLIPDIR:
106             # export PHYLIPDIR=/home/shawnh/PHYLIP/bin
107             #
108             # 2. include a definition of an environmental variable PHYLIPDIR in
109             # every script that will use DrawTree.pm.
110             # $ENV{PHYLIPDIR} = '/home/shawnh/PHYLIP/bin';
111             #
112             # 3. You can set the path to the program through doing:
113             # my @params('program'=>'/usr/local/bin/drawgram');
114             # my $neighbor_factory = Bio::Tools::Run::Phylo::Phylip::DrawTree->new(@params)
115              
116             BEGIN {
117 1     1   3 %DEFAULT = ('PLOTTER' => 'P',
118             'SCREEN' => 'N');
119 1 50       6 $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1") if $ENV{'PHYLIPDIR'};
120              
121 1         1 $PROGRAMNAME="drawtree";
122 1 50       3 if (defined $ENV{'PHYLIPDIR'}) {
123 0   0     0 $PROGRAMDIR = $ENV{'PHYLIPDIR'} || '';
124 0 0       0 $PROGRAM = Bio::Root::IO->catfile($PROGRAMDIR,
125             $PROGRAMNAME.($^O =~ /mswin/i ?'.exe':''));
126 0         0 $DEFAULT{'FONTFILE'} = Bio::Root::IO->catfile($ENV{'PHYLIPDIR'},"font1");
127             }
128             else {
129 1         1 $PROGRAM = $PROGRAMNAME;
130             }
131              
132 1         2 @DRAW_PARAMS = qw(PLOTTER SCREEN LABEL_ANGLE ROTATION TREEARC
133             ITERATE SCALE HORIZMARGINS VERTICALMARGINS FONT
134             );
135 1         1 @OTHER_SWITCHES = qw(QUIET);
136 1         2 foreach my $attr(@DRAW_PARAMS,@OTHER_SWITCHES) {
137 11         806 $OK_FIELD{$attr}++;
138             }
139             }
140              
141             =head2 program_name
142              
143             Title : program_name
144             Usage : $obj->program_name()
145             Function: holds the program name
146             Returns: string
147             Args : None
148              
149             =cut
150              
151             sub program_name {
152 6     6 1 26 return $PROGRAMNAME;
153             }
154              
155             =head2 program_dir
156              
157             Title : program_dir
158             Usage : $drawfact->program_dir()
159             Function: returns the program directory, obtained from ENV variable.
160             Returns : string
161             Args :
162              
163             =cut
164              
165             sub program_dir {
166 3 50   3 1 11 return Bio::Root::IO->catfile($ENV{PHYLIPDIR}) if $ENV{PHYLIPDIR};
167             }
168              
169             =head2 new
170              
171             Title : new
172             Usage : my $obj = Bio::Tools::Run::Phylo::Phylip::DrawTree->new();
173             Function: Builds a new Bio::Tools::Run::Phylo::Phylip::DrawTree object
174             Returns : an instance of Bio::Tools::Run::Phylo::Phylip::DrawTree
175             Args : The available DrawGram parameters
176              
177              
178             =cut
179              
180             sub new {
181 1     1 1 77 my($class,@args) = @_;
182              
183 1         11 my $self = $class->SUPER::new(@args);
184            
185 1         31 my ($attr, $value);
186            
187 1         3 while (@args) {
188 2         3 $attr = shift @args;
189 2         2 $value = shift @args;
190 2 100       6 next if( $attr =~ /^-/ ); # don't want named parameters
191 1 50       3 if ($attr =~/PROGRAM/i) {
192 0         0 $self->executable($value);
193 0         0 next;
194             }
195 1         7 $self->$attr($value);
196             }
197 1 50       7 $self->plotter($DEFAULT{'PLOTTER'}) unless $self->plotter;
198 1 50       5 $self->screen($DEFAULT{'SCREEN'}) unless $self->screen;
199 1 50       7 $self->fontfile($DEFAULT{'FONTFILE'}) unless $self->fontfile;
200 1         3 return $self;
201             }
202              
203              
204             sub AUTOLOAD {
205 4     4   5 my $self = shift;
206 4         2 my $attr = $AUTOLOAD;
207 4         10 $attr =~ s/.*:://;
208 4         4 $attr = uc $attr;
209 4 50       9 $self->throw("Unallowed parameter: $attr !") unless $OK_FIELD{$attr};
210 4 100       7 $self->{$attr} = shift if @_;
211 4         12 return $self->{$attr};
212             }
213              
214             =head2 run
215              
216             Title : run
217             Usage : my $file = $app->run($treefile);
218             Function: Draw a tree
219             Returns : File containing the rendered tree
220             Args : either a Bio::Tree::TreeI
221             OR
222             filename of a tree in newick format
223              
224             =cut
225              
226             sub run{
227 0     0 1   my ($self,$input) = @_;
228            
229             # Create input file pointer
230 0           my ($infilename) = $self->_setinput($input);
231 0 0         if (!$infilename) {
232 0           $self->throw("Problems setting up for drawgram. Probably bad input data in $input !");
233             }
234              
235             # Create parameter string to pass to neighbor program
236 0           my $param_string = $self->_setparams();
237              
238             # run drawgram
239 0           my $plotfile = $self->_run($infilename,$param_string);
240 0           return $plotfile;
241             }
242              
243             =head2 draw_tree
244              
245             Title : draw_tree
246             Usage : my $file = $app->draw_tree($treefile);
247             Function: This method is deprecated. Please use run method.
248             Returns : File containing the rendered tree
249             Args : either a Bio::Tree::TreeI
250             OR
251             filename of a tree in newick format
252              
253             =cut
254              
255             sub draw_tree{
256 0     0 1   return shift->run(@_);
257             }
258              
259             =head2 _run
260              
261             Title : _run
262             Usage : Internal function, not to be called directly
263             Function: makes actual system call to drawgram program
264             Example :
265             Returns : Bio::Tree object
266             Args : Name of a file the tree to draw in newick format
267             and a parameter string to be passed to drawgram
268              
269              
270             =cut
271              
272             sub _run {
273 0     0     my ($self,$infile,$param_string) = @_;
274 0           my $instring;
275 0           my $curpath = cwd;
276            
277 0 0         unless( File::Spec->file_name_is_absolute($infile) ) {
278 0           $infile = $self->io->catfile($curpath,$infile);
279             }
280 0           $instring = $infile . "\n";
281 0 0         if( ! defined $self->fontfile ) {
282 0           $self->throw("You must have defined a fontfile");
283             }
284              
285 0 0         if( -e $self->io->catfile($curpath,'fontfile') ) {
    0          
286 0           $instring .= $self->io->catfile($curpath,'fontfile')."\n";
287             } elsif( File::Spec->file_name_is_absolute($self->fontfile) ) {
288             #$instring .= $self->io->catfile($self->tempdir,$self->fontfile)."\n";
289 0           $instring .= $self->io->catfile($self->fontfile)."\n";
290             } else {
291 0           $instring .= $self->io->catfile($curpath,$self->fontfile)."\n";
292             }
293 0           chdir($self->tempdir);
294 0           $instring .= $param_string;
295 0           $self->debug( "Program ".$self->executable." $param_string\n");
296             # open a pipe to run drawgram to bypass interactive menus
297 0 0 0       if ($self->quiet() || $self->verbose() < 0) {
298 0 0         my $null = ($^O =~ m/mswin/i) ? 'NUL' : '/dev/null';
299 0           open(DRAW,"|".$self->executable.">$null");
300             }
301             else {
302 0           open(DRAW,"|".$self->executable);
303             }
304 0           print DRAW $instring;
305 0           close(DRAW);
306 0           chdir($curpath);
307             #get the results
308 0           my $plotfile = $self->io->catfile($self->tempdir,$self->plotfile);
309              
310 0 0         $self->throw("drawgram did not create plotfile correctly ($plotfile)")
311             unless (-e $plotfile);
312 0           return $plotfile;
313             }
314              
315             =head2 _setinput()
316              
317             Title : _setinput
318             Usage : Internal function, not to be called directly
319             Function: Create input file for drawing program
320             Example :
321             Returns : filename containing tree in newick format
322             Args : Bio::Tree::TreeI object
323              
324             =cut
325              
326             sub _setinput {
327 0     0     my ($self, $input) = @_;
328 0           my $treefile;
329 0 0         unless (ref $input) {
    0          
330             # check that file exists or throw
331 0           $treefile = $input;
332 0 0         unless (-e $input) {return 0;}
  0            
333            
334             } elsif ($input->isa("Bio::Tree::TreeI")) {
335             # Open temporary file for both reading & writing of BioSeq array
336 0           my $tfh;
337 0           ($tfh,$treefile) = $self->io->tempfile(-dir=>$self->tempdir);
338 0           my $treeIO = Bio::TreeIO->new(-fh => $tfh,
339             -format=>'newick');
340 0           $treeIO->write_tree($input);
341 0           $treeIO->close();
342 0           close($tfh);
343 0           undef $tfh;
344             }
345 0           return $treefile;
346             }
347              
348             =head2 _setparams()
349              
350             Title : _setparams
351             Usage : Internal function, not to be called directly
352             Function: Create parameter inputs for drawgram program
353             Example :
354             Returns : parameter string to be passed to drawgram
355             Args : name of calling object
356              
357             =cut
358              
359              
360              
361             sub _setparams {
362 0     0     my ($attr, $value, $self);
363              
364             #do nothing for now
365 0           $self = shift;
366 0           my $param_string = "";
367 0           my $cat = 0;
368 0           my ($hmargin,$vmargin);
369 0           my %menu = %{$Menu{$self->version}->{'DRAWTREE'}};
  0            
370 0           foreach my $attr ( @DRAW_PARAMS) {
371 0           $value = $self->$attr();
372 0 0         next unless defined $value;
373 0           my @vals;
374 0 0         if( ref($value) ) {
375 0           ($value,@vals) = @$value;
376             }
377 0           $attr = uc($attr);
378 0 0         if( ! exists $menu{$attr} ) {
379 0           $self->warn("unknown parameter $attr, known params are ".
380             join(",",keys %menu). "\n");
381             }
382 0 0         if( ref ($menu{$attr}) !~ /HASH/i ) {
383 0 0         unless( @vals ) {
384 0           $param_string .= $menu{$attr};
385             } else {
386 0           $param_string .= sprintf($menu{$attr},$value,@vals);
387             }
388 0           next;
389             }
390 0           my $seen = 0;
391 0           for my $stype ( keys %{$menu{$attr}} ) {
  0            
392 0 0         if( $value =~ /$stype/i ) {
393 0           $param_string .= sprintf($menu{$attr}->{$stype},@vals);
394 0           $seen = 1;
395 0           last;
396             }
397             }
398 0 0         unless( $seen ) {
399 0           $self->warn("Unknown requested attribute $attr, $value is not known\n");
400             }
401             }
402 0           $param_string .="Y\n";
403 0           return $param_string;
404             }
405              
406              
407             =head1 Bio::Tools::Run::Wrapper methods
408              
409             =cut
410              
411             =head2 no_param_checks
412              
413             Title : no_param_checks
414             Usage : $obj->no_param_checks($newval)
415             Function: Boolean flag as to whether or not we should
416             trust the sanity checks for parameter values
417             Returns : value of no_param_checks
418             Args : newvalue (optional)
419              
420              
421             =cut
422              
423             =head2 save_tempfiles
424              
425             Title : save_tempfiles
426             Usage : $obj->save_tempfiles($newval)
427             Function:
428             Returns : value of save_tempfiles
429             Args : newvalue (optional)
430              
431              
432             =cut
433              
434             =head2 outfile_name
435              
436             Title : outfile_name
437             Usage : my $outfile = $dragram->outfile_name();
438             Function: Get/Set the name of the output file for this run
439             (if you wanted to do something special)
440             Returns : string
441             Args : [optional] string to set value to
442              
443              
444             =cut
445              
446              
447             =head2 tempdir
448              
449             Title : tempdir
450             Usage : my $tmpdir = $self->tempdir();
451             Function: Retrieve a temporary directory name (which is created)
452             Returns : string which is the name of the temporary directory
453             Args : none
454              
455              
456             =cut
457              
458             =head2 cleanup
459              
460             Title : cleanup
461             Usage : $codeml->cleanup();
462             Function: Will cleanup the tempdir directory after a DrawTree run
463             Returns : none
464             Args : none
465              
466              
467             =cut
468              
469             =head2 io
470              
471             Title : io
472             Usage : $obj->io($newval)
473             Function: Gets a Bio::Root::IO object
474             Returns : Bio::Root::IO object
475             Args : none
476              
477             See L
478              
479             =cut
480              
481             1; # Needed to keep compiler happy