Bio/TreeIO.pm

   1 #
   2 # BioPerl module for Bio::TreeIO
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason@bioperl.org>
   7 #
   8 # Copyright Jason Stajich
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11
  12 # POD documentation - main docs before the code
  13
  14 =head1 NAME
  15
  16 Bio::TreeIO - Parser for Tree files
  17
  18 =head1 SYNOPSIS
  19
  20   {
  21       use Bio::TreeIO;
  22       my $treeio = Bio::TreeIO->new('-format' => 'newick',
  23                    '-file'   => 'globin.dnd');
  24       while( my $tree = $treeio->next_tree ) {
  25                 print "Tree is ", $tree->number_nodes, "\n";
  26       }
  27   }
  28
  29 =head1 DESCRIPTION
  30
  31 This is the driver module for Tree reading from data streams and
  32 flatfiles.  This is intended to be able to create Bio::Tree::TreeI
  33 objects.
  34
  35 =head1 FEEDBACK
  36
  37 =head2 Mailing Lists
  38
  39 User feedback is an integral part of the evolution of this and other
  40 Bioperl modules. Send your comments and suggestions preferably to
  41 the Bioperl mailing list.  Your participation is much appreciated.
  42
  43   bioperl-l@bioperl.org                  - General discussion
  44   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  45
  46 =head2 Support
  47
  48 Please direct usage questions or support issues to the mailing list:
  49
  50 I<bioperl-l@bioperl.org>
  51
  52 rather than to the module maintainer directly. Many experienced and
  53 reponsive experts will be able look at the problem and quickly
  54 address it. Please include a thorough description of the problem
  55 with code and data examples if at all possible.
  56
  57 =head2 Reporting Bugs
  58
  59 Report bugs to the Bioperl bug tracking system to help us keep track
  60 of the bugs and their resolution. Bug reports can be submitted via the
  61 web:
  62
  63   https://redmine.open-bio.org/projects/bioperl/
  64
  65 =head1 AUTHOR - Jason Stajich
  66
  67 Email jason-at-bioperl-dot-org
  68
  69 =head1 CONTRIBUTORS
  70
  71 Allen Day E<lt>allenday@ucla.eduE<gt>
  72
  73 =head1 APPENDIX
  74
  75 The rest of the documentation details each of the object methods.
  76 Internal methods are usually preceded with a _
  77
  78 =cut
  79
  80
  81 # Let the code begin...
  82
  83
  84 package Bio::TreeIO;
  85 use strict;
  86
  87 # Object preamble - inherits from Bio::Root::Root
  88
  89 use Bio::TreeIO::TreeEventBuilder;
  90
  91 use base qw(Bio::Root::Root Bio::Root::IO Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);
  92
  93 =head2 new
  94
  95  Title   : new
  96  Usage   : my $obj = Bio::TreeIO->new();
  97  Function: Builds a new Bio::TreeIO object
  98  Returns : Bio::TreeIO
  99  Args    : a hash.  useful keys:
 100    -format : Specify the format of the file.  Supported formats:
 101
 102      newick             Newick tree format
 103      nexus              Nexus tree format
 104      nhx                NHX tree format
 105      svggraph           SVG graphical representation of tree
 106      tabtree            ASCII text representation of tree
 107      lintree            lintree output format
 108
 109 =cut
 110
 111 sub new {
 112   my($caller,@args) = @_;
 113   my $class = ref($caller) || $caller;
 114
 115     # or do we want to call SUPER on an object if $caller is an
 116     # object?n
 117
 118   my $obj;
 119   if( $class =~ /Bio::TreeIO::(\S+)/ ) {
 120     $obj = $class->SUPER::new(@args);
 121     $obj->_initialize(@args);
 122   } else {
 123     my %param = @args;
 124     @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 125     my $format = $param{'-format'} ||
 126       $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
 127       'newick';
 128     $format = "\L$format";  # normalize capitalization to lower case
 129
 130     # normalize capitalization
 131     return undef unless( $class->_load_format_module($format) );
 132     $obj = "Bio::TreeIO::$format"->new(@args);
 133   }
 134   return $obj;
 135 }
 136
 137
 138 =head2 next_tree
 139
 140  Title   : next_tree
 141  Usage   : my $tree = $treeio->next_tree;
 142  Function: Gets the next tree off the stream
 143  Returns : Bio::Tree::TreeI or undef if no more trees
 144  Args    : none
 145
 146 =cut
 147
 148 sub next_tree{
 149    my ($self) = @_;
 150    $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
 151 }
 152
 153 =head2 write_tree
 154
 155  Title   : write_tree
 156  Usage   : $treeio->write_tree($tree);
 157  Function: Writes a tree onto the stream
 158  Returns : none
 159  Args    : Bio::Tree::TreeI
 160
 161
 162 =cut
 163
 164 sub write_tree{
 165    my ($self,$tree) = @_;
 166    $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
 167 }
 168
 169
 170 =head2 attach_EventHandler
 171
 172  Title   : attach_EventHandler
 173  Usage   : $parser->attatch_EventHandler($handler)
 174  Function: Adds an event handler to listen for events
 175  Returns : none
 176  Args    : Bio::Event::EventHandlerI
 177
 178 =cut
 179
 180 sub attach_EventHandler{
 181     my ($self,$handler) = @_;
 182     return if( ! $handler );
 183     if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
 184     $self->warn("Ignoring request to attach handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
 185     }
 186     $self->{'_handler'} = $handler;
 187     return;
 188 }
 189
 190 =head2 _eventHandler
 191
 192  Title   : _eventHandler
 193  Usage   : private
 194  Function: Get the EventHandler
 195  Returns : Bio::Event::EventHandlerI
 196  Args    : none
 197
 198
 199 =cut
 200
 201 sub _eventHandler{
 202    my ($self) = @_;
 203    return $self->{'_handler'};
 204 }
 205
 206 sub _initialize {
 207     my($self, @args) = @_;
 208     $self->{'_handler'} = undef;
 209
 210     $self->get_params; # Initialize the default parameters.
 211
 212     my ($nen,$ini) = $self->_rearrange
 213     ([qw(NEWLINE_EACH_NODE INTERNAL_NODE_ID)],@args);
 214     $self->set_param('newline_each_node',$nen);
 215     $self->set_param('internal_node_id',$ini);
 216
 217     $self->attach_EventHandler(Bio::TreeIO::TreeEventBuilder->new
 218                    (-verbose => $self->verbose(), @args));
 219     $self->_initialize_io(@args);
 220     #$self->debug_params;
 221 }
 222
 223 =head2 _load_format_module
 224
 225  Title   : _load_format_module
 226  Usage   : *INTERNAL TreeIO stuff*
 227  Function: Loads up (like use) a module at run time on demand
 228  Example :
 229  Returns :
 230  Args    :
 231
 232 =cut
 233
 234 sub _load_format_module {
 235   my ($self,$format) = @_;
 236   my $module = "Bio::TreeIO::" . $format;
 237   my $ok;
 238
 239   eval {
 240       $ok = $self->_load_module($module);
 241   };
 242
 243   if ( $@ ) {
 244     print STDERR <<END;
 245 $self: $format cannot be found
 246 Exception $@
 247 For more information about the TreeIO system please see the TreeIO docs.
 248 This includes ways of checking for formats at compile time, not run time
 249 END
 250   ;
 251   }
 252   return $ok;
 253 }
 254
 255 sub param {
 256   my $self = shift;
 257   my $param = shift;
 258   my $value = shift;
 259
 260   if (defined $value) {
 261     $self->get_params->{$param} = $value;
 262   }
 263   return $self->get_params->{$param};
 264 }
 265
 266 sub set_param {
 267   my $self = shift;
 268   my $param = shift;
 269   my $value = shift;
 270
 271   #print STDERR "[$param] -> [undef]\n" if (!defined $value);
 272   return unless (defined $value);
 273   #print STDERR "[$param] -> [$value]\n";
 274
 275   $self->get_params->{$param} = $value;
 276   return $self->param($param);
 277 }
 278
 279 sub params {
 280   my $self = shift;
 281   return $self->get_params;
 282 }
 283 sub get_params {
 284   my $self = shift;
 285
 286   if (!defined $self->{_params}) {
 287     $self->{_params} = $self->get_default_params;
 288   }
 289
 290   return $self->{_params};
 291 }
 292
 293 sub set_params {
 294   my $self = shift;
 295   my $params = shift;
 296
 297   # Apply all the passed parameters to our internal parm hashref.
 298   my $cur_params = $self->get_params;
 299   $self->{_params} = { %$cur_params, %$params };
 300
 301   return $self->get_params;
 302 }
 303
 304 sub get_default_params {
 305   my $self = shift;
 306
 307   return {};
 308 }
 309
 310 sub debug_params {
 311   my $self = shift;
 312
 313   my $params = $self->get_params;
 314
 315   print STDERR "{\n";
 316   foreach my $param (keys %$params) {
 317     my $value = $params->{$param};
 318     print STDERR "  [$param] -> [$value]\n";
 319   }
 320   print STDERR "}\n";
 321 }
 322
 323 =head2 _guess_format
 324
 325  Title   : _guess_format
 326  Usage   : $obj->_guess_format($filename)
 327  Function:
 328  Example :
 329  Returns : guessed format of filename (lower case)
 330  Args    :
 331
 332 =cut
 333
 334 sub _guess_format {
 335    my $class = shift;
 336    return unless $_ = shift;
 337    return 'newick'   if /\.(dnd|newick|nh)$/i;
 338    return 'nhx'   if /\.(nhx)$/i;
 339    return 'phyloxml' if /\.(xml)$/i;
 340    return 'svggraph' if /\.svg$/i;
 341    return 'lintree'  if( /\.(lin|lintree)$/i );
 342 }
 343
 344 sub DESTROY {
 345     my $self = shift;
 346
 347     $self->close();
 348 }
 349
 350 sub TIEHANDLE {
 351   my $class = shift;
 352   return bless {'treeio' => shift},$class;
 353 }
 354
 355 sub READLINE {
 356   my $self = shift;
 357   return $self->{'treeio'}->next_tree() unless wantarray;
 358   my (@list,$obj);
 359   push @list,$obj  while $obj = $self->{'treeio'}->next_tree();
 360   return @list;
 361 }
 362
 363 sub PRINT {
 364   my $self = shift;
 365   $self->{'treeio'}->write_tree(@_);
 366 }
 367
 368 1;