File Coverage

blib/lib/Statistics/R/IO/Base.pm

Criterion	Covered	Total	%
statement	56	57	98.2
branch	25	30	83.3
condition	4	6	66.6
subroutine	13	13	100.0
pod	1	4	25.0
total	99	110	90.0

package Statistics::R::IO::Base;
# ABSTRACT: Common object methods for processing R files
$Statistics::R::IO::Base::VERSION = '1.0001';
use 5.010;

use IO::File;
use IO::Handle;

use IO::Uncompress::Gunzip ();
use IO::Uncompress::Bunzip2 ();
use Scalar::Util qw(blessed);
use Carp;

use Class::Tiny::Antlers;


has fh => (
    is => 'ro',
);


sub BUILDARGS {
    my $class = shift;
    if ( scalar @_ == 1 ) {
        if ( defined $_[0] ) {
            if ( ref $_[0] eq 'HASH' ) {
                return { %{ $_[0] } }
            } elsif (ref $_[0] eq '') {
                my $name = shift;
                die "No such file '$name'" unless -r $name;
                my $fh = IO::File->new($name);
                binmode $fh;
                return { fh => $fh }
            }
        }
        die "Single parameters to new() must be a HASH ref or filename scalar"
    }
    elsif ( @_ % 2 ) {
        die "The new() method for $class expects a hash reference or a key/value list."
                . " You passed an odd number of arguments\n";
    }
    else {
        return {@_}
    }
}


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

    die "This is an abstract class and must be subclassed" if ref($self) eq __PACKAGE__;

    # Required methods
    die "'read' method required" unless $self->can('read');

    # Required attribute types
    die "Attribute 'fh' is required" unless defined($args->{fh});

    die "Attribute 'fh' must be an instance of IO::Handle or an open filehandle" if
        defined($args->{fh}) &&
        !((ref($args->{fh}) eq "GLOB" && Scalar::Util::openhandle($args->{fh})) ||
         (blessed($args->{fh}) && $args->{fh}->isa("IO::Handle")));
}

sub _read_and_uncompress {
    my $self = shift;

    my ($data, $rc) = '';
    while ($rc = $self->fh->read($data, 8192, length $data)) {}
    croak $! unless defined $rc;
    if (substr($data, 0, 2) eq "\x1f\x8b") {
        ## gzip-compressed file
        my $input = $data;
        IO::Uncompress::Gunzip::gunzip \$input, \$data;
    }
    elsif (substr($data, 0, 3) eq 'BZh') {
        ## bzip2-compressed file
        my $input = $data;
        IO::Uncompress::Bunzip2::bunzip2 \$input, \$data;
    }
    elsif (substr($data, 0, 6) eq "\xfd7zXZ\0") {
        croak "xz-compressed R files are not supported";
    }

    $data
}


sub close {
    my $self = shift;
    $self->fh->close
}


sub DEMOLISH {
    my $self = shift;
    ## TODO: should only close if given a filename (OR autoclose, if I
    ## choose to implement it)
    $self->close if $self->fh
}


# sub eof {
#     my $self = shift;
#     $self->position >= scalar @{$self->data};
# }


1;

__END__