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