File Coverage

blib/lib/Bio/Gonzales/Util/Role/FileIO.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	8	10	80.0
condition	1	6	16.6
subroutine	12	12	100.0
pod	1	2	50.0
total	66	74	89.1

package Bio::Gonzales::Util::Role::FileIO;

use warnings;
use strict;

use Mouse::Role;
use Data::Dumper;
use Bio::Gonzales::Util::File qw/open_on_demand/;
use Carp;
use IO::Handle;
use IO::Zlib;

our $VERSION = '0.083'; # VERSION

has fh              => ( is => 'rw' );
has mode            => ( is => 'rw', default => '<' );
has _fhi            => ( is => 'rw', lazy_build => 1 );
has _cached_records => ( is => 'rw', default => sub { [] } );
has record_separator => ( is => 'rw', default => $/ );
has record_filter    => ( is => 'rw' );
has _fh_was_open     => ( is => 'rw', default => 1 );

requires 'BUILDARGS';

# file handle iterator
sub _build__fhi {
  my ($self) = @_;

  my $fh = $self->fh;

  my $rs     = $self->record_separator;
  my $filter = $self->record_filter;

  return sub {
    # make use of cached records if we have
    return shift @{ $self->_cached_records }
      if ( @{ $self->_cached_records } > 0 );

    local $/ = $rs;

    while (1) {
      my $l = <$fh>;
      if ( defined($l) ) {
        # handle DOS format
        #$l =~ s/\r\n$/\n/;
        # this is 2x as fast
        substr( $l, -2, 1, '' ) if ( substr( $l, -2, 1 ) eq "\r" );
        chomp $l;
      } else {
        return;
      }

      return $l
        if ( !$filter || ( $filter && $filter->($l) ) );
    }
  };
}

around BUILDARGS => sub {
  my $orig  = shift;
  my $class = shift;

  if ( @_ == 1 && !ref $_[0] ) {
    return $class->$orig( file => $_[0] );
  } else {
    return $class->$orig(@_);
  }
};

sub BUILD { }

before BUILD => sub {
  my ( $self, $args ) = @_;

  confess "use either file, fh or file_or_fh" . Dumper $args
    if ( $self->fh && $args->{file} );
  $args->{file} //= $args->{file_or_fh} if($args->{file_or_fh});
  # open file
  if ( $args->{file} ) {
    my ( $fh, $was_open ) = open_on_demand( $args->{file}, $self->mode );
    $self->fh($fh);
    $self->_fh_was_open($was_open);
  } else {
    confess "You did not supply a file handle for fh: " . ref $self->fh
      unless ( Bio::Gonzales::Util::File::is_fh( $self->fh ) );
  }
};

sub close {
  my ($self) = @_;

  my $fh = $self->fh;
  $fh->close unless ( $self->_fh_was_open );

  return;
}

1;

__END__

=head1 NAME

BaMo::Role::FileIO - File input & ouput interface for parser classes

=head1 SYNOPSIS

    use Mouse;

    with 'BaMo::Role::FileIO';

    sub parse {
        my ($self) = @_;
        $fhi = $self->_fhi;

        while(my $line = $fhi->()) {
            #parse a bit
            if($line =~ /break/) {
                # oh no, we parsed too much...
                push @{$self->_cached_records}, $line;
                #but we can reverse it
            }
        }
    }

=head1 DESCRIPTION

Enhances the class that uses this role with a file handle iterator that is
capable of caching records (lines in most cases), in case you read too much.

=head1 METHODS

=over 4

=item B<< $self->fh() >>

Get or set the filehandle.

=item B<< $self->_cached_records() >>

You can push lines on @{$self->_cached_records} (they need to be chomped
already). The file handle iterator will use them first if you call it. The
file handle will not be touched until all cached lines are shifted.

=item B<< $class->new(file => 'filename.xyz', mode => '<') >>

Opens the file in the specified mode. Sets the C<fh> and C<_fhi> attribute (indirectly).

=item B<< $self->_fhi() >>

Get the file handle iterator.

=item B<< $class->new(fh => $fh) >>

=item B<< $self->close() >>

Close the filehandle.

=back

=head1 SEE ALSO

=head1 AUTHOR

jw bargsten, C<< <joachim.bargsten at wur.nl> >>

=cut