Bio/MapIO.pm

   1 #
   2 # BioPerl module for Bio::MapIO
   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::MapIO - A Map Factory object
  17
  18 =head1 SYNOPSIS
  19
  20     use Bio::MapIO;
  21     my $mapio = Bio::MapIO->new(-format => "mapmaker",
  22                                -file   => "mapfile.map");
  23
  24     while( my $map = $mapio->next_map ) {
  25         # get each map
  26         foreach my $marker ( $map->each_element ) {
  27             # loop through the markers associated with the map
  28         }
  29     }
  30
  31 =head1 DESCRIPTION
  32
  33 This is the Factory object for reading Maps from a data stream or file.
  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 the web:
  61
  62   https://redmine.open-bio.org/projects/bioperl/
  63
  64 =head1 AUTHOR - Jason Stajich
  65
  66 Email jason@bioperl.org
  67
  68 =head1 APPENDIX
  69
  70 The rest of the documentation details each of the object methods.
  71 Internal methods are usually preceded with a _
  72
  73 =cut
  74
  75
  76 # Let the code begin...
  77
  78
  79 package Bio::MapIO;
  80 use strict;
  81
  82
  83 use base qw(Bio::Root::Root Bio::Root::IO Bio::Factory::MapFactoryI);
  84
  85 =head2 new
  86
  87  Title   : new
  88  Usage   : my $obj = Bio::MapIO->new();
  89  Function: Builds a new Bio::MapIO object
  90  Returns : Bio::MapIO
  91  Args    :
  92
  93
  94 =cut
  95
  96 sub new {
  97   my($caller,@args) = @_;
  98
  99   my $class = ref($caller) || $caller;
 100
 101   # or do we want to call SUPER on an object if $caller is an
 102   # object?
 103   if( $class =~ /Bio::MapIO::(\S+)/ ) {
 104         my ($self) = $class->SUPER::new(@args);
 105         $self->_initialize(@args);
 106         return $self;
 107     } else {
 108
 109         my %param = @args;
 110         @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 111         my $format = $param{'-format'} ||
 112             $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
 113                 'mapmaker';
 114         $format = "\L$format";  # normalize capitalization to lower case
 115
 116         # normalize capitalization
 117         return unless( $class->_load_format_module($format) );
 118         return "Bio::MapIO::$format"->new(@args);
 119     }
 120
 121 }
 122
 123 =head2 Bio::Factory::MapFactoryI methods
 124
 125 =cut
 126
 127 =head2 next_map
 128
 129  Title   : next_tree
 130  Usage   : my $map = $factory->next_map;
 131  Function: Get a map from the factory
 132  Returns : L<Bio::Map::MapI>
 133  Args    : none
 134
 135
 136 =head2 write_map
 137
 138  Title   : write_tree
 139  Usage   : $factory->write_map($map);
 140  Function: Write a map out through the factory
 141  Returns : none
 142  Args    : L<Bio::Map::MapI>
 143
 144 =cut
 145
 146
 147 =head2 attach_EventHandler
 148
 149  Title   : attach_EventHandler
 150  Usage   : $parser->attatch_EventHandler($handler)
 151  Function: Adds an event handler to listen for events
 152  Returns : none
 153  Args    : L<Bio::Event::EventHandlerI>
 154
 155 =cut
 156
 157 sub attach_EventHandler{
 158     my ($self,$handler) = @_;
 159     return if( ! $handler );
 160     if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
 161         $self->warn("Ignoring request to attatch handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
 162     }
 163     $self->{'_handler'} = $handler;
 164     return;
 165 }
 166
 167 =head2 _eventHandler
 168
 169  Title   : _eventHandler
 170  Usage   : private
 171  Function: Get the EventHandler
 172  Returns : L<Bio::Event::EventHandlerI>
 173  Args    : none
 174
 175
 176 =cut
 177
 178 sub _eventHandler{
 179    my ($self) = @_;
 180    return $self->{'_handler'};
 181 }
 182
 183 sub _initialize {
 184     my($self, @args) = @_;
 185     $self->{'_handler'} = undef;
 186
 187     # initialize the IO part
 188     $self->_initialize_io(@args);
 189 #    $self->attach_EventHandler(Bio::MapIO::MapEventBuilder->new());
 190 }
 191
 192 =head2 _load_format_module
 193
 194  Title   : _load_format_module
 195  Usage   : *INTERNAL MapIO stuff*
 196  Function: Loads up (like use) a module at run time on demand
 197  Example :
 198  Returns :
 199  Args    :
 200
 201 =cut
 202
 203 sub _load_format_module {
 204   my ($self,$format) = @_;
 205   my $module = "Bio::MapIO::" . $format;
 206   my $ok;
 207   eval {
 208       $ok = $self->_load_module($module);
 209   };
 210   if ( $@ ) {
 211     print STDERR <<END;
 212 $self: $format cannot be found
 213 Exception $@
 214 For more information about the MapIO system please see the MapIO docs.
 215 This includes ways of checking for formats at compile time, not run time
 216 END
 217   ;
 218   }
 219   return $ok;
 220 }
 221
 222
 223 =head2 _guess_format
 224
 225  Title   : _guess_format
 226  Usage   : $obj->_guess_format($filename)
 227  Function:
 228  Example :
 229  Returns : guessed format of filename (lower case)
 230  Args    :
 231
 232 =cut
 233
 234 sub _guess_format {
 235    my $class = shift;
 236    return unless $_ = shift;
 237    return 'mapmaker'   if /\.(map)$/i;
 238    return 'mapxml' if /\.(xml)$/i;
 239 }
 240
 241 sub DESTROY {
 242     my $self = shift;
 243
 244     $self->close();
 245 }
 246
 247 1;