Bio/TreeIO.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::TreeIO
   4 #
   5 # Cared for by Jason Stajich <jason@bioperl.org>
   6 #
   7 # Copyright Jason Stajich
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::TreeIO - Parser for Tree files
  16
  17 =head1 SYNOPSIS
  18
  19   {
  20       use Bio::TreeIO;
  21       my $treeio = new Bio::TreeIO('-format' => 'newick',
  22                                    '-file'   => 'globin.dnd');
  23       while( my $tree = $treeio->next_tree ) {
  24           print "Tree is ", $tree->size, "\n";
  25       }
  26   }
  27
  28 =head1 DESCRIPTION
  29
  30 This is the driver module for Tree reading from data streams and
  31 flatfiles.  This is intended to be able to create Bio::Tree::TreeI
  32 objects.
  33
  34 =head1 FEEDBACK
  35
  36 =head2 Mailing Lists
  37
  38 User feedback is an integral part of the evolution of this and other
  39 Bioperl modules. Send your comments and suggestions preferably to
  40 the Bioperl mailing list.  Your participation is much appreciated.
  41
  42   bioperl-l@bioperl.org              - General discussion
  43   http://bioperl.org/MailList.shtml  - About the mailing lists
  44
  45 =head2 Reporting Bugs
  46
  47 Report bugs to the Bioperl bug tracking system to help us keep track
  48 of the bugs and their resolution. Bug reports can be submitted via
  49 email or the web:
  50
  51   bioperl-bugs@bioperl.org
  52   http://bioperl.org/bioperl-bugs/
  53
  54 =head1 AUTHOR - Jason Stajich
  55
  56 Email jason@bioperl.org
  57
  58 Describe contact details here
  59
  60 =head1 CONTRIBUTORS
  61
  62 Additional contributors names and emails here
  63
  64 =head1 APPENDIX
  65
  66 The rest of the documentation details each of the object methods.
  67 Internal methods are usually preceded with a _
  68
  69 =cut
  70
  71
  72 # Let the code begin...
  73
  74
  75 package Bio::TreeIO;
  76 use vars qw(@ISA);
  77 use strict;
  78
  79 # Object preamble - inherits from Bio::Root::Root
  80
  81 use Bio::Root::Root;
  82 use Bio::Root::IO;
  83 use Bio::Event::EventGeneratorI;
  84 use Bio::TreeIO::TreeEventBuilder;
  85 use Bio::Factory::TreeFactoryI;
  86
  87 @ISA = qw(Bio::Root::Root Bio::Root::IO
  88         Bio::Event::EventGeneratorI Bio::Factory::TreeFactoryI);
  89
  90 =head2 new
  91
  92  Title   : new
  93  Usage   : my $obj = new Bio::TreeIO();
  94  Function: Builds a new Bio::TreeIO object
  95  Returns : Bio::TreeIO
  96  Args    :
  97
  98
  99 =cut
 100
 101 sub new {
 102   my($caller,@args) = @_;
 103   my $class = ref($caller) || $caller;
 104
 105     # or do we want to call SUPER on an object if $caller is an
 106     # object?
 107     if( $class =~ /Bio::TreeIO::(\S+)/ ) {
 108         my ($self) = $class->SUPER::new(@args);
 109         $self->_initialize(@args);
 110         return $self;
 111     } else {
 112
 113         my %param = @args;
 114         @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 115         my $format = $param{'-format'} ||
 116             $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
 117                 'newick';
 118         $format = "\L$format";  # normalize capitalization to lower case
 119
 120         # normalize capitalization
 121         return undef unless( $class->_load_format_module($format) );
 122         return "Bio::TreeIO::$format"->new(@args);
 123     }
 124 }
 125
 126
 127 =head2 next_tree
 128
 129  Title   : next_tree
 130  Usage   : my $tree = $treeio->next_tree;
 131  Function: Gets the next tree off the stream
 132  Returns : Bio::Tree::TreeI or undef if no more trees
 133  Args    : none
 134
 135 =cut
 136
 137 sub next_tree{
 138    my ($self) = @_;
 139    $self->throw("Cannot call method next_tree on Bio::TreeIO object must use a subclass");
 140 }
 141
 142 =head2 write_tree
 143
 144  Title   : write_tree
 145  Usage   : $treeio->write_tree($tree);
 146  Function: Writes a tree onto the stream
 147  Returns : none
 148  Args    : Bio::Tree::TreeI
 149
 150
 151 =cut
 152
 153 sub write_tree{
 154    my ($self,$tree) = @_;
 155    $self->throw("Cannot call method write_tree on Bio::TreeIO object must use a subclass");
 156 }
 157
 158
 159 =head2 attach_EventHandler
 160
 161  Title   : attach_EventHandler
 162  Usage   : $parser->attatch_EventHandler($handler)
 163  Function: Adds an event handler to listen for events
 164  Returns : none
 165  Args    : Bio::Event::EventHandlerI
 166
 167 =cut
 168
 169 sub attach_EventHandler{
 170     my ($self,$handler) = @_;
 171     return if( ! $handler );
 172     if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
 173         $self->warn("Ignoring request to attatch handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
 174     }
 175     $self->{'_handler'} = $handler;
 176     return;
 177 }
 178
 179 =head2 _eventHandler
 180
 181  Title   : _eventHandler
 182  Usage   : private
 183  Function: Get the EventHandler
 184  Returns : Bio::Event::EventHandlerI
 185  Args    : none
 186
 187
 188 =cut
 189
 190 sub _eventHandler{
 191    my ($self) = @_;
 192    return $self->{'_handler'};
 193 }
 194
 195 sub _initialize {
 196     my($self, @args) = @_;
 197     $self->{'_handler'} = undef;
 198
 199     # initialize the IO part
 200     $self->_initialize_io(@args);
 201     $self->attach_EventHandler(new Bio::TreeIO::TreeEventBuilder(-verbose => $self->verbose(), @args));
 202 }
 203
 204 =head2 _load_format_module
 205
 206  Title   : _load_format_module
 207  Usage   : *INTERNAL TreeIO stuff*
 208  Function: Loads up (like use) a module at run time on demand
 209  Example :
 210  Returns :
 211  Args    :
 212
 213 =cut
 214
 215 sub _load_format_module {
 216   my ($self,$format) = @_;
 217   my $module = "Bio::TreeIO::" . $format;
 218   my $ok;
 219
 220   eval {
 221       $ok = $self->_load_module($module);
 222   };
 223   if ( $@ ) {
 224     print STDERR <<END;
 225 $self: $format cannot be found
 226 Exception $@
 227 For more information about the TreeIO system please see the TreeIO docs.
 228 This includes ways of checking for formats at compile time, not run time
 229 END
 230   ;
 231   }
 232   return $ok;
 233 }
 234
 235
 236 =head2 _guess_format
 237
 238  Title   : _guess_format
 239  Usage   : $obj->_guess_format($filename)
 240  Function:
 241  Example :
 242  Returns : guessed format of filename (lower case)
 243  Args    :
 244
 245 =cut
 246
 247 sub _guess_format {
 248    my $class = shift;
 249    return unless $_ = shift;
 250    return 'newick'   if /\.(dnd|newick|nh)$/i;
 251    return 'phyloxml' if /\.(xml)$/i;
 252 }
 253
 254 sub DESTROY {
 255     my $self = shift;
 256
 257     $self->close();
 258 }
 259
 260 sub TIEHANDLE {
 261   my $class = shift;
 262   return bless {'treeio' => shift},$class;
 263 }
 264
 265 sub READLINE {
 266   my $self = shift;
 267   return $self->{'treeio'}->next_tree() unless wantarray;
 268   my (@list,$obj);
 269   push @list,$obj  while $obj = $self->{'treeio'}->next_tree();
 270   return @list;
 271 }
 272
 273 sub PRINT {
 274   my $self = shift;
 275   $self->{'treeio'}->write_tree(@_);
 276 }
 277
 278 1;