view release on metacpan or  search on metacpan

lib/MS/Reader.pm  view on Meta::CPAN

package MS::Reader;

use strict;
use warnings;

use Carp;
use Digest::MD5;
use File::stat;
use Storable qw/nstore_fd retrieve_fd/;
use Scalar::Util qw/blessed/;
use PerlIO::gzip;
use MS; # because we need access to the package version

use constant BGZF_MAGIC => pack 'H*', '1f8b0804';

sub new {

    my ($class, $fn, %args) = @_;

    my $self = bless {} => $class;

    $self->{__use_cache} = $args{use_cache} ? 1 : 0; # remember accessed records
    $self->{__paranoid}  = $args{paranoid}  ? 1 : 0; # calc MD5 each time
    $self->{__fn}        = undef; # to allow dunlock even if not loaded
    $self->{__fh}        = undef; # to allow dunlock even if not loaded
    $self->{__version}   = $MS::VERSION;
    $self->{__lock}      = $args{lock} // 0;
    $self->{__app_data}  = {};

    $self->load($fn) if (defined $fn);

    # check expected methods in subclasses
    $self->_check_interface;

    return $self;

}

# to be defined by subclass
sub _check_interface { return }

sub _read_element {

    my ($self, $offset, $to_read) = @_;

    seek $self->{__fh}, $offset, 0;
    my $r = read($self->{__fh}, my $el, $to_read);
    croak "returned unexpected byte count" if ($r != $to_read);

    return $el;

}

sub load {

    my ($self, $fn) = @_;

    my $use_cache = $self->{__use_cache};

    croak "input file not found" if (! -e $fn);
    $self->{__fn} = $fn;
    open my $fh, '<', $fn;
    my $old_layers = join '', map {":$_"} PerlIO::get_layers($fh);
    binmode $fh;

    # check for BGZIP compression
    read($fh, my $magic, 4);
    binmode($fh, $old_layers);
    if ($magic eq BGZF_MAGIC) {
        require Compress::BGZF::Reader
            or croak "Compress::BGZF::Reader required to handle BGZF files";
        close $fh;
        $fh = Compress::BGZF::Reader->new_filehandle($fn);
    }
    
    $self->{__fh} = $fh;
    seek $fh, 0, 0;
    
    # Use a simple/fast file check (file size + mod time)
    my $st = stat($fn);