lib/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://github.com/bioperl/bioperl-live/issues
  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
  86 use strict;
  87
  88 # Object preamble - inherits from Bio::Root::Root
  89
  90 use Bio::TreeIO::TreeEventBuilder;
  91
  92 use base qw(Bio::Root::Root Bio::Root::IO Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);
  93
  94 =head2 new
  95
  96  Title   : new
  97  Usage   : my $obj = Bio::TreeIO->new();
  98  Function: Builds a new Bio::TreeIO object
  99  Returns : Bio::TreeIO
 100  Args    : a hash.  useful keys:
 101    -format : Specify the format of the file.  Supported formats:
 102
 103      newick             Newick tree format
 104      nexus              Nexus tree format
 105      nhx                NHX tree format
 106      svggraph           SVG graphical representation of tree
 107      tabtree            ASCII text representation of tree
 108      lintree            lintree output format
 109
 110 =cut
 111
 112 sub new {
 113   my($caller,@args) = @_;
 114   my $class = ref($caller) || $caller;
 115
 116     # or do we want to call SUPER on an object if $caller is an
 117     # object?n
 118
 119   my $obj;
 120   if( $class =~ /Bio::TreeIO::(\S+)/ ) {
 121     $obj = $class->SUPER::new(@args);
 122     $obj->_initialize(@args);
 123   } else {
 124     my %param = @args;
 125     @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 126     my $format = $param{'-format'} ||
 127       $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
 128       'newick';
 129     $format = "\L$format";  # normalize capitalization to lower case
 130
 131     # normalize capitalization
 132     return undef unless( $class->_load_format_module($format) );
 133     $obj = "Bio::TreeIO::$format"->new(@args);
 134   }
 135   return $obj;
 136 }
 137
 138
 139 =head2 format
 140
 141  Title   : format
 142  Usage   : $format = $obj->format()
 143  Function: Get the tree format
 144  Returns : tree format
 145  Args    : none
 146
 147 =cut
 148
 149 # format() method inherited from Bio::Root::IO
 150
 151
 152 =head2 next_tree
 153
 154  Title   : next_tree
 155  Usage   : my $tree = $treeio->next_tree;
 156  Function: Gets the next tree off the stream
 157  Returns : Bio::Tree::TreeI or undef if no more trees
 158  Args    : none
 159
 160 =cut
 161
 162 sub next_tree{
 163    my ($self) = @_;
 164    $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
 165 }
 166
 167 =head2 write_tree
 168
 169  Title   : write_tree
 170  Usage   : $treeio->write_tree($tree);
 171  Function: Writes a tree onto the stream
 172  Returns : none
 173  Args    : Bio::Tree::TreeI
 174
 175
 176 =cut
 177
 178 sub write_tree{
 179    my ($self,$tree) = @_;
 180    $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
 181 }
 182
 183
 184 =head2 attach_EventHandler
 185
 186  Title   : attach_EventHandler
 187  Usage   : $parser->attatch_EventHandler($handler)
 188  Function: Adds an event handler to listen for events
 189  Returns : none
 190  Args    : Bio::Event::EventHandlerI
 191
 192 =cut
 193
 194 sub attach_EventHandler{
 195     my ($self,$handler) = @_;
 196     return if( ! $handler );
 197     if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
 198     $self->warn("Ignoring request to attach handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
 199     }
 200     $self->{'_handler'} = $handler;
 201     return;
 202 }
 203
 204 =head2 _eventHandler
 205
 206  Title   : _eventHandler
 207  Usage   : private
 208  Function: Get the EventHandler
 209  Returns : Bio::Event::EventHandlerI
 210  Args    : none
 211
 212
 213 =cut
 214
 215 sub _eventHandler{
 216    my ($self) = @_;
 217    return $self->{'_handler'};
 218 }
 219
 220 sub _initialize {
 221     my($self, @args) = @_;
 222     $self->{'_handler'} = undef;
 223
 224     $self->get_params; # Initialize the default parameters.
 225
 226     my ($nen,$ini) = $self->_rearrange
 227     ([qw(NEWLINE_EACH_NODE INTERNAL_NODE_ID)],@args);
 228     $self->set_param('newline_each_node',$nen);
 229     $self->set_param('internal_node_id',$ini);
 230
 231     $self->attach_EventHandler(Bio::TreeIO::TreeEventBuilder->new
 232                    (-verbose => $self->verbose(), @args));
 233     $self->_initialize_io(@args);
 234     #$self->debug_params;
 235 }
 236
 237 =head2 _load_format_module
 238
 239  Title   : _load_format_module
 240  Usage   : *INTERNAL TreeIO stuff*
 241  Function: Loads up (like use) a module at run time on demand
 242  Example :
 243  Returns :
 244  Args    :
 245
 246 =cut
 247
 248 sub _load_format_module {
 249   my ($self,$format) = @_;
 250   my $module = "Bio::TreeIO::" . $format;
 251   my $ok;
 252
 253   eval {
 254       $ok = $self->_load_module($module);
 255   };
 256
 257   if ( $@ ) {
 258     print STDERR <<END;
 259 $self: $format cannot be found
 260 Exception $@
 261 For more information about the TreeIO system please see the TreeIO docs.
 262 This includes ways of checking for formats at compile time, not run time
 263 END
 264   ;
 265   }
 266   return $ok;
 267 }
 268
 269 sub param {
 270   my $self = shift;
 271   my $param = shift;
 272   my $value = shift;
 273
 274   if (defined $value) {
 275     $self->get_params->{$param} = $value;
 276   }
 277   return $self->get_params->{$param};
 278 }
 279
 280 sub set_param {
 281   my $self = shift;
 282   my $param = shift;
 283   my $value = shift;
 284
 285   #print STDERR "[$param] -> [undef]\n" if (!defined $value);
 286   return unless (defined $value);
 287   #print STDERR "[$param] -> [$value]\n";
 288
 289   $self->get_params->{$param} = $value;
 290   return $self->param($param);
 291 }
 292
 293 sub params {
 294   my $self = shift;
 295   return $self->get_params;
 296 }
 297 sub get_params {
 298   my $self = shift;
 299
 300   if (!defined $self->{_params}) {
 301     $self->{_params} = $self->get_default_params;
 302   }
 303
 304   return $self->{_params};
 305 }
 306
 307 sub set_params {
 308   my $self = shift;
 309   my $params = shift;
 310
 311   # Apply all the passed parameters to our internal parm hashref.
 312   my $cur_params = $self->get_params;
 313   $self->{_params} = { %$cur_params, %$params };
 314
 315   return $self->get_params;
 316 }
 317
 318 sub get_default_params {
 319   my $self = shift;
 320
 321   return {};
 322 }
 323
 324 sub debug_params {
 325   my $self = shift;
 326
 327   my $params = $self->get_params;
 328
 329   print STDERR "{\n";
 330   foreach my $param (keys %$params) {
 331     my $value = $params->{$param};
 332     print STDERR "  [$param] -> [$value]\n";
 333   }
 334   print STDERR "}\n";
 335 }
 336
 337 =head2 _guess_format
 338
 339  Title   : _guess_format
 340  Usage   : $obj->_guess_format($filename)
 341  Function:
 342  Example :
 343  Returns : guessed format of filename (lower case)
 344  Args    :
 345
 346 =cut
 347
 348 sub _guess_format {
 349    my $class = shift;
 350    return unless $_ = shift;
 351    return 'newick'   if /\.(dnd|newick|nh)$/i;
 352    return 'nhx'   if /\.(nhx)$/i;
 353    return 'phyloxml' if /\.(xml)$/i;
 354    return 'svggraph' if /\.svg$/i;
 355    return 'lintree'  if( /\.(lin|lintree)$/i );
 356 }
 357
 358 sub DESTROY {
 359     my $self = shift;
 360
 361     $self->close();
 362 }
 363
 364 sub TIEHANDLE {
 365   my $class = shift;
 366   return bless {'treeio' => shift},$class;
 367 }
 368
 369 sub READLINE {
 370   my $self = shift;
 371   return $self->{'treeio'}->next_tree() || undef unless wantarray;
 372   my (@list,$obj);
 373   push @list,$obj  while $obj = $self->{'treeio'}->next_tree();
 374   return @list;
 375 }
 376
 377 sub PRINT {
 378   my $self = shift;
 379   $self->{'treeio'}->write_tree(@_);
 380 }
 381
 382 1;