view release on metacpan or  search on metacpan

lib/Bio/FeatureIO.pm  view on Meta::CPAN

  http://bugzilla.open-bio.org/

=head1 AUTHOR - Allen Day

Email allenday@ucla.edu

=head1 APPENDIX

The rest of the documentation details each of the object
methods. Internal methods are usually preceded with a _

=cut

#' Let the code begin...

package Bio::FeatureIO;
BEGIN {
  $Bio::FeatureIO::AUTHORITY = 'cpan:BIOPERLML';
}
$Bio::FeatureIO::VERSION = '1.6.905';
use strict;

use Symbol;

use base qw(Bio::Root::Root Bio::Root::IO);

=head2 new

 Title   : new
 Usage   : $stream = Bio::FeatureIO->new(-file => $filename, -format => 'Format')
 Function: Returns a new feature stream
 Returns : A Bio::FeatureIO stream initialised with the appropriate format
 Args    : Named parameters:
             -file => $filename
             -fh => filehandle to attach to
             -format => format

=cut

my $entry = 0;

sub new {
  my ($caller,@args) = @_;
  my $class = ref($caller) || $caller;

  # or do we want to call SUPER on an object if $caller is an
  # object?
  if( $class =~ /Bio::FeatureIO::(\S+)/ ) {

    my ($self) = $class->SUPER::new(@args);	
    $self->_initialize(@args);
    return $self;

  } else {

	my %param = @args;

	@param{ map { lc $_ } keys %param } = values %param; # lowercase keys
	my $format = $param{'-format'} ||
      $class->_guess_format( $param{-file} || $ARGV[0] );
	
	if( ! $format ) {
      if ($param{-file}) {
        $format = $class->_guess_format($param{-file});
      } elsif ($param{-fh}) {
        $format = $class->_guess_format(undef);
      }
	}
	$format = "\L$format";	# normalize capitalization to lower case
	return unless( $class->_load_format_module($format) );
	return "Bio::FeatureIO::$format"->new(@args);

  }
}

=head2 newFh

 Title   : newFh
 Usage   : $fh = Bio::FeatureIO->newFh(-file=>$filename,-format=>'Format')
 Function: does a new() followed by an fh()
 Example : $fh = Bio::FeatureIO->newFh(-file=>$filename,-format=>'Format')
           $feature = <$fh>;   # read a feature object
           print $fh $feature; # write a feature object
 Returns : filehandle tied to the Bio::FeatureIO::Fh class
 Args    :

See L<Bio::FeatureIO::Fh>

=cut

sub newFh {
  my $class = shift;
  return unless my $self = $class->new(@_);
  return $self->fh;
}

=head2 fh

 Title   : fh
 Usage   : $obj->fh
 Function:
 Example : $fh = $obj->fh;      # make a tied filehandle
           $feature = <$fh>;   # read a feature object
           print $fh $feature; # write a feature object
 Returns : filehandle tied to Bio::FeatureIO class
 Args    : none

=cut


sub fh {
  my $self = shift;
  my $class = ref($self) || $self;
  my $s = Symbol::gensym;
  tie $$s,$class,$self;
  return $s;
}

# _initialize is chained for all FeatureIO classes

sub _initialize {
    my($self, %arg) = @_;

    # flush is initialized by the Root::IO init

    # initialize the IO part

lib/Bio/FeatureIO.pm  view on Meta::CPAN

 Args    :

=cut

sub _load_format_module {
    my ($self, $format) = @_;
    my $class = ref($self) || $self;
    my $module = $class."::$format";#"Bio::Feature::" . $format;
    my $ok;

    eval {
	$ok = $self->_load_module($module);
    };
    if ( $@ ) {
    print STDERR <<END;
$self: $format cannot be found
Exception $@
For more information about the FeatureIO system please see the FeatureIO docs.
This includes ways of checking for formats at compile time, not run time
END
  ;
  }
  return $ok;
}

=head2 seq

 Title   : seq
 Usage   : $obj->seq() OR $obj->seq($newSeq)
 Example :
 Returns : Bio::SeqI object
 Args    : newSeq (optional)

=cut

sub seq {
  my $self = shift;
  my $val = shift;

  $self->{'seq'} = $val if defined($val);
  return $self->{'seq'};
}

=head2 _filehandle

 Title   : _filehandle
 Usage   : $obj->_filehandle($newval)
 Function: This method is deprecated. Call _fh() instead.
 Example :
 Returns : value of _filehandle
 Args    : newvalue (optional)


=cut

sub _filehandle {
    my ($self,@args) = @_;
    return $self->_fh(@args);
}

=head2 _guess_format

 Title   : _guess_format
 Usage   : $obj->_guess_format($filename)
 Function: guess format based on file suffix
 Example :
 Returns : guessed format of filename (lower case)
 Args    :
 Notes   : See "SUPPORTED FORMATS"

=cut

sub _guess_format {
   my $class = shift;
   return unless $_ = shift;
   return 'gff'     if /\.gff3?$/i;
   return 'gff'     if /\.gtf$/i;
   return 'bed'     if /\.bed$/i;
   return 'ptt'     if /\.ptt$/i;

   return 'gff'; #the default
}

sub DESTROY {
    my $self = shift;
    $self->close();
}

sub TIEHANDLE {
    my ($class,$val) = @_;
    return bless {'featio' => $val}, $class;
}

sub READLINE {
  my $self = shift;
  return $self->{'featio'}->next_feature() unless wantarray;
  my (@list, $obj);
  push @list, $obj while $obj = $self->{'featio'}->next_feature();
  return @list;
}

sub PRINT {
  my $self = shift;
  $self->{'featio'}->write_feature(@_);
}

1;