Bio/PopGen/IO.pm

   1 #
   2 # BioPerl module for Bio::PopGen::IO
   3 #
   4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   5 #
   6 # Cared for by Jason Stajich <jason-at-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::PopGen::IO - Input individual,marker,allele information
  17
  18 =head1 SYNOPSIS
  19
  20   use Bio::PopGen::IO;
  21   my $io = Bio::PopGen::IO->new(-format => 'csv',
  22                                 -file   => 'data.csv');
  23
  24   # Some IO might support reading in a population at a time
  25
  26   my @population;
  27   while( my $ind = $io->next_individual ) {
  28       push @population, $ind;
  29   }
  30
  31
  32 =head1 DESCRIPTION
  33
  34 This is a generic interface to reading in population genetic data (of
  35 which there really isn't too many standard formats).  This implementation
  36 makes it easy to provide your own parser for the data.  You need to
  37 only implement one function next_individual.  You can also implement
  38 next_population if your data has explicit information about population
  39 memberhsip for the indidviduals.
  40
  41 =head1 FEEDBACK
  42
  43 =head2 Mailing Lists
  44
  45 User feedback is an integral part of the evolution of this and other
  46 Bioperl modules. Send your comments and suggestions preferably to
  47 the Bioperl mailing list.  Your participation is much appreciated.
  48
  49   bioperl-l@bioperl.org                  - General discussion
  50   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  51
  52 =head2 Support
  53
  54 Please direct usage questions or support issues to the mailing list:
  55
  56 I<bioperl-l@bioperl.org>
  57
  58 rather than to the module maintainer directly. Many experienced and
  59 reponsive experts will be able look at the problem and quickly
  60 address it. Please include a thorough description of the problem
  61 with code and data examples if at all possible.
  62
  63 =head2 Reporting Bugs
  64
  65 Report bugs to the Bioperl bug tracking system to help us keep track
  66 of the bugs and their resolution. Bug reports can be submitted via
  67 the web:
  68
  69   https://github.com/bioperl/bioperl-live/issues
  70
  71 =head1 AUTHOR - Jason Stajich
  72
  73 Email jason-at-bioperl.org
  74
  75 =head1 APPENDIX
  76
  77 The rest of the documentation details each of the object methods.
  78 Internal methods are usually preceded with a _
  79
  80 =cut
  81
  82
  83 # Let the code begin...
  84 #TODO
  85 # Set the Individual creation as a factory rather than
  86 # hardcoded
  87
  88 package Bio::PopGen::IO;
  89 use strict;
  90
  91 # Object preamble - inherits from Bio::Root::Root
  92
  93 use Bio::Root::Root;
  94
  95 use base qw(Bio::Root::IO);
  96
  97 =head2 new
  98
  99  Title   : new
 100  Usage   : my $obj = Bio::PopGen::IO->new();
 101  Function: Builds a new Bio::PopGen::IO object
 102  Returns : an instance of Bio::PopGen::IO
 103  Args    :
 104
 105
 106 =cut
 107
 108 sub new {
 109   my($class,@args) = @_;
 110
 111   if( $class =~ /Bio::PopGen::IO::(\S+)/ ) {
 112     my ($self) = $class->SUPER::new(@args);
 113     $self->_initialize(@args);
 114     return $self;
 115   } else {
 116     my %param = @args;
 117     @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 118     my $format = $param{'-format'} ||
 119       $class->_guess_format( $param{'-file'} || $ARGV[0] ) || 'csv';
 120
 121     # normalize capitalization to lower case
 122     $format = "\L$format";
 123
 124     return unless( $class->_load_format_module($format) );
 125     return "Bio::PopGen::IO::${format}"->new(@args);
 126   }
 127 }
 128
 129
 130 =head2 format
 131
 132  Title   : format
 133  Usage   : $format = $stream->format()
 134  Function: Get the PopGen format
 135  Returns : PopGen format
 136  Args    : none
 137
 138 =cut
 139
 140 # format() method inherited from Bio::Root::IO
 141
 142
 143 # _initialize is chained for all PopGen::IO classes
 144
 145 sub _initialize {
 146     my($self, @args) = @_;
 147 #    my ($indfact, $popfact) = $self->_rearrange([qw(INDIVIDUAL_FACTORY
 148 #                                                   POPULATION_FACTORY)],
 149 #                                               @args);
 150 #    $indfact = Bio::PopGen::IndividualBuilder->new() unless $indfact;
 151 #    $indfact = Bio::PopGen::PopulationBuilder->new() unless $indfact;
 152
 153     # initialize the IO part
 154     $self->_initialize_io(@args);
 155     return 1;
 156 }
 157
 158 =head2 next_individual
 159
 160  Title   : next_individual
 161  Usage   : my $ind = $popgenio->next_individual;
 162  Function: Retrieve the next individual from a dataset
 163  Returns : L<Bio::PopGen::IndividualI> object
 164  Args    : none
 165
 166
 167 =cut
 168
 169 sub next_individual{
 170     my ($self) = @_;
 171     $self->throw_not_implemented();
 172 }
 173
 174
 175 =head2 next_population
 176
 177  Title   : next_population
 178  Usage   : my $pop = $popgenio->next_population;
 179  Function: Retrieve the next population from a dataset
 180  Returns : L<Bio::PopGen::PopulationI> object
 181  Args    : none
 182  Note    : Many implementation will not implement this
 183
 184 =cut
 185
 186 sub next_population{
 187     my ($self) = @_;
 188     $self->throw_not_implemented();
 189 }
 190
 191 =head2 write_individual
 192
 193  Title   : write_individual
 194  Usage   : $popgenio->write_individual($ind);
 195  Function: Write an individual out in the implementation format
 196  Returns : none
 197  Args    : L<Bio::PopGen::PopulationI> object(s)
 198
 199 =cut
 200
 201 sub write_individual{
 202     my ($self) = @_;
 203     $self->throw_not_implemented();
 204 }
 205
 206
 207
 208 =head2 write_population
 209
 210  Title   : write_population
 211  Usage   : $popgenio->write_population($pop);
 212  Function: Write a population out in the implementation format
 213  Returns : none
 214  Args    : L<Bio::PopGen::PopulationI> object(s)
 215  Note    : Many implementation will not implement this
 216
 217 =cut
 218
 219 sub write_population{
 220     my ($self) = @_;
 221     $self->throw_not_implemented();
 222 }
 223
 224
 225 =head2 newFh
 226
 227  Title   : newFh
 228  Usage   : $fh = Bio::SeqIO->newFh(-file=>$filename,-format=>'Format')
 229  Function: does a new() followed by an fh()
 230  Example : $fh = Bio::SeqIO->newFh(-file=>$filename,-format=>'Format')
 231            $sequence = <$fh>;   # read a sequence object
 232            print $fh $sequence; # write a sequence object
 233  Returns : filehandle tied to the Bio::SeqIO::Fh class
 234  Args    :
 235
 236 See L<Bio::SeqIO::Fh>
 237
 238 =cut
 239
 240 sub newFh {
 241   my $class = shift;
 242   return unless my $self = $class->new(@_);
 243   return $self->fh;
 244 }
 245
 246 =head2 fh
 247
 248  Title   : fh
 249  Usage   : $obj->fh
 250  Function:
 251  Example : $fh = $obj->fh;      # make a tied filehandle
 252            $sequence = <$fh>;   # read a sequence object
 253            print $fh $sequence; # write a sequence object
 254  Returns : filehandle tied to Bio::SeqIO class
 255  Args    : none
 256
 257 =cut
 258
 259
 260 sub fh {
 261   my $self = shift;
 262   my $class = ref($self) || $self;
 263   my $s = Symbol::gensym;
 264   tie $$s,$class,$self;
 265   return $s;
 266 }
 267
 268 =head2 _load_format_module
 269
 270  Title   : _load_format_module
 271  Usage   : *INTERNAL Bio::PopGen::IO stuff*
 272  Function: Loads up (like use) a module at run time on demand
 273  Example :
 274  Returns :
 275  Args    :
 276
 277 =cut
 278
 279 sub _load_format_module {
 280   my ($self,$format) = @_;
 281   my $module = "Bio::PopGen::IO::" . $format;
 282   my $ok;
 283
 284   eval {
 285       $ok = $self->_load_module($module);
 286   };
 287   if ( $@ ) {
 288       print STDERR <<END;
 289 $self: $format cannot be found
 290 Exception $@
 291 For more information about the Bio::PopGen::IO system please see the
 292 Bio::PopGen::IO docs.  This includes ways of checking for formats at
 293 compile time, not run time
 294 END
 295   ;
 296   }
 297   return $ok;
 298 }
 299
 300
 301 =head2 _guess_format
 302
 303  Title   : _guess_format
 304  Usage   : $obj->_guess_format($filename)
 305  Function:
 306  Example :
 307  Returns : guessed format of filename (lower case)
 308  Args    :
 309
 310 =cut
 311
 312
 313 sub _guess_format {
 314    my $class = shift;
 315    return unless $_ = shift;
 316    return 'csv'   if (/csv/i or /\.dat\w$/i);
 317 }
 318
 319 sub close {
 320     my $self = shift;
 321     $self->SUPER::close(@_);
 322 }
 323
 324 sub DESTROY {
 325     my $self = shift;
 326     $self->close();
 327 }
 328
 329 sub TIEHANDLE {
 330   my $class = shift;
 331   return bless {processor => shift}, $class;
 332 }
 333
 334 sub READLINE {
 335   my $self = shift;
 336   return $self->{'processor'}->next_result() || undef unless wantarray;
 337   my (@list, $obj);
 338   push @list, $obj while $obj = $self->{'processor'}->next_result();
 339   return @list;
 340 }
 341
 342 sub PRINT {
 343   my $self = shift;
 344   $self->{'processor'}->write_result(@_);
 345 }
 346
 347 1;