branch-1-6/Bio/MapIO.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::MapIO
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Jason Stajich <jason@bioperl.org>
   8 #
   9 # Copyright Jason Stajich
  10 #
  11 # You may distribute this module under the same terms as perl itself
  12
  13 # POD documentation - main docs before the code
  14
  15 =head1 NAME
  16
  17 Bio::MapIO - A Map Factory object
  18
  19 =head1 SYNOPSIS
  20
  21     use Bio::MapIO;
  22     my $mapio = Bio::MapIO->new(-format => "mapmaker",
  23                                -file   => "mapfile.map");
  24
  25     while( my $map = $mapio->next_map ) {
  26         # get each map
  27         foreach my $marker ( $map->each_element ) {
  28             # loop through the markers associated with the map
  29         }
  30     }
  31
  32 =head1 DESCRIPTION
  33
  34 This is the Factory object for reading Maps from a data stream or file.
  35
  36 =head1 FEEDBACK
  37
  38 =head2 Mailing Lists
  39
  40 User feedback is an integral part of the evolution of this and other
  41 Bioperl modules. Send your comments and suggestions preferably to
  42 the Bioperl mailing list.  Your participation is much appreciated.
  43
  44   bioperl-l@bioperl.org                  - General discussion
  45   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  46
  47 =head2 Support
  48
  49 Please direct usage questions or support issues to the mailing list:
  50
  51 I<bioperl-l@bioperl.org>
  52
  53 rather than to the module maintainer directly. Many experienced and
  54 reponsive experts will be able look at the problem and quickly
  55 address it. Please include a thorough description of the problem
  56 with code and data examples if at all possible.
  57
  58 =head2 Reporting Bugs
  59
  60 Report bugs to the Bioperl bug tracking system to help us keep track
  61 of the bugs and their resolution. Bug reports can be submitted the web:
  62
  63   http://bugzilla.open-bio.org/
  64
  65 =head1 AUTHOR - Jason Stajich
  66
  67 Email jason@bioperl.org
  68
  69 =head1 APPENDIX
  70
  71 The rest of the documentation details each of the object methods.
  72 Internal methods are usually preceded with a _
  73
  74 =cut
  75
  76
  77 # Let the code begin...
  78
  79
  80 package Bio::MapIO;
  81 use strict;
  82
  83
  84 use base qw(Bio::Root::Root Bio::Root::IO Bio::Factory::MapFactoryI);
  85
  86 =head2 new
  87
  88  Title   : new
  89  Usage   : my $obj = Bio::MapIO->new();
  90  Function: Builds a new Bio::MapIO object
  91  Returns : Bio::MapIO
  92  Args    :
  93
  94
  95 =cut
  96
  97 sub new {
  98   my($caller,@args) = @_;
  99
 100   my $class = ref($caller) || $caller;
 101
 102   # or do we want to call SUPER on an object if $caller is an
 103   # object?
 104   if( $class =~ /Bio::MapIO::(\S+)/ ) {
 105         my ($self) = $class->SUPER::new(@args);
 106         $self->_initialize(@args);
 107         return $self;
 108     } else {
 109
 110         my %param = @args;
 111         @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 112         my $format = $param{'-format'} ||
 113             $class->_guess_format( $param{'-file'} || $ARGV[0] ) ||
 114                 'mapmaker';
 115         $format = "\L$format";  # normalize capitalization to lower case
 116
 117         # normalize capitalization
 118         return unless( $class->_load_format_module($format) );
 119         return "Bio::MapIO::$format"->new(@args);
 120     }
 121
 122 }
 123
 124 =head2 Bio::Factory::MapFactoryI methods
 125
 126 =cut
 127
 128 =head2 next_map
 129
 130  Title   : next_tree
 131  Usage   : my $map = $factory->next_map;
 132  Function: Get a map from the factory
 133  Returns : L<Bio::Map::MapI>
 134  Args    : none
 135
 136
 137 =head2 write_map
 138
 139  Title   : write_tree
 140  Usage   : $factory->write_map($map);
 141  Function: Write a map out through the factory
 142  Returns : none
 143  Args    : L<Bio::Map::MapI>
 144
 145 =cut
 146
 147
 148 =head2 attach_EventHandler
 149
 150  Title   : attach_EventHandler
 151  Usage   : $parser->attatch_EventHandler($handler)
 152  Function: Adds an event handler to listen for events
 153  Returns : none
 154  Args    : L<Bio::Event::EventHandlerI>
 155
 156 =cut
 157
 158 sub attach_EventHandler{
 159     my ($self,$handler) = @_;
 160     return if( ! $handler );
 161     if( ! $handler->isa('Bio::Event::EventHandlerI') ) {
 162         $self->warn("Ignoring request to attatch handler ".ref($handler). ' because it is not a Bio::Event::EventHandlerI');
 163     }
 164     $self->{'_handler'} = $handler;
 165     return;
 166 }
 167
 168 =head2 _eventHandler
 169
 170  Title   : _eventHandler
 171  Usage   : private
 172  Function: Get the EventHandler
 173  Returns : L<Bio::Event::EventHandlerI>
 174  Args    : none
 175
 176
 177 =cut
 178
 179 sub _eventHandler{
 180    my ($self) = @_;
 181    return $self->{'_handler'};
 182 }
 183
 184 sub _initialize {
 185     my($self, @args) = @_;
 186     $self->{'_handler'} = undef;
 187
 188     # initialize the IO part
 189     $self->_initialize_io(@args);
 190 #    $self->attach_EventHandler(Bio::MapIO::MapEventBuilder->new());
 191 }
 192
 193 =head2 _load_format_module
 194
 195  Title   : _load_format_module
 196  Usage   : *INTERNAL MapIO stuff*
 197  Function: Loads up (like use) a module at run time on demand
 198  Example :
 199  Returns :
 200  Args    :
 201
 202 =cut
 203
 204 sub _load_format_module {
 205   my ($self,$format) = @_;
 206   my $module = "Bio::MapIO::" . $format;
 207   my $ok;
 208   eval {
 209       $ok = $self->_load_module($module);
 210   };
 211   if ( $@ ) {
 212     print STDERR <<END;
 213 $self: $format cannot be found
 214 Exception $@
 215 For more information about the MapIO system please see the MapIO docs.
 216 This includes ways of checking for formats at compile time, not run time
 217 END
 218   ;
 219   }
 220   return $ok;
 221 }
 222
 223
 224 =head2 _guess_format
 225
 226  Title   : _guess_format
 227  Usage   : $obj->_guess_format($filename)
 228  Function:
 229  Example :
 230  Returns : guessed format of filename (lower case)
 231  Args    :
 232
 233 =cut
 234
 235 sub _guess_format {
 236    my $class = shift;
 237    return unless $_ = shift;
 238    return 'mapmaker'   if /\.(map)$/i;
 239    return 'mapxml' if /\.(xml)$/i;
 240 }
 241
 242 sub DESTROY {
 243     my $self = shift;
 244
 245     $self->close();
 246 }
 247
 248 1;