File Coverage

blib/lib/Statistics/R/IO.pm

Criterion	Covered	Total	%
statement	65	66	98.4
branch	21	30	70.0
condition	1	2	50.0
subroutine	13	13	100.0
pod	3	3	100.0
total	103	114	90.3

package Statistics::R::IO;
# ABSTRACT: Perl interface to serialized R data
$Statistics::R::IO::VERSION = '1.0001';
use 5.010;
use strict;
use warnings FATAL => 'all';

use Exporter 'import';

our @EXPORT = qw( );
our @EXPORT_OK = qw( readRDS readRData evalRserve );

our %EXPORT_TAGS = ( all => [ @EXPORT_OK ], );

use Statistics::R::IO::REXPFactory;
use Statistics::R::IO::Rserve;
use IO::Uncompress::Gunzip ();
use IO::Uncompress::Bunzip2 ();
use IO::Socket::INET ();
use Carp;


sub readRDS {
    open (my $f, shift) or croak $!;
    binmode $f;
    my ($data, $rc) = '';
    while ($rc = read($f, $data, 8192, length $data)) {}
    croak $! unless defined $rc;
    if (substr($data, 0, 2) eq "\x1f\x8b") {
        ## gzip-compressed file
        seek($f, 0, 0);
        IO::Uncompress::Gunzip::gunzip $f, \$data;
    }
    elsif (substr($data, 0, 3) eq 'BZh') {
        ## bzip2-compressed file
        seek($f, 0, 0);
        IO::Uncompress::Bunzip2::bunzip2 $f, \$data;
    }
    elsif (substr($data, 0, 6) eq "\xfd7zXZ\0") {
        croak "xz-compressed RDS files are not supported";
    }

    my ($value, $state) = @{Statistics::R::IO::REXPFactory::unserialize($data)};
    croak 'Could not parse RDS file' unless $state;
    croak 'Unread data remaining in the RDS file' unless $state->eof;
    $value
}


sub readRData {
    open (my $f, shift) or croak $!;
    binmode $f;
    my ($data, $rc) = '';
    while ($rc = read($f, $data, 8192, length $data)) {}
    croak $! unless defined $rc;
    if (substr($data, 0, 2) eq "\x1f\x8b") {
        ## gzip-compressed file
        seek($f, 0, 0);
        IO::Uncompress::Gunzip::gunzip $f, \$data;
    }
    elsif (substr($data, 0, 3) eq 'BZh') {
        ## bzip2-compressed file
        seek($f, 0, 0);
        IO::Uncompress::Bunzip2::bunzip2 $f, \$data;
    }
    elsif (substr($data, 0, 6) eq "\xfd7zXZ\0") {
        croak "xz-compressed RData files are not supported";
    }

    if (substr($data, 0, 5) ne "RDX2\n") {
        croak 'File does not start with the RData magic number: ' .
            unpack('H*', substr($data, 0, 5));
    }

    my ($value, $state) = @{Statistics::R::IO::REXPFactory::unserialize(substr($data, 5))};
    croak 'Could not parse RData file' unless $state;
    croak 'Unread data remaining in the RData file' unless $state->eof;
    Statistics::R::IO::REXPFactory::tagged_pairlist_to_rexp_hash $value;
}


sub evalRserve {
    my ($rexp, $server) = (shift, shift);

    my $rserve = Statistics::R::IO::Rserve->new($server // {});

    $rserve->eval($rexp)
}

1; # End of Statistics::R::IO

__END__