File Coverage

blib/lib/SerealX/Store.pm

Criterion	Covered	Total	%
statement	47	48	97.9
branch	17	26	65.3
condition			n/a
subroutine	8	8	100.0
pod	3	3	100.0
total	75	85	88.2

package SerealX::Store;
# ABSTRACT: Sereal based persistence for Perl data structures
our $VERSION = '0.003';

use 5.008001;
use strict;
use warnings;

use Sereal::Encoder;
use Sereal::Decoder;

# Constructor
sub new {
	my ($class, $params) = @_;

	my $self = {};
	if (ref $params->{encoder} eq 'HASH') {
		$self->{encoder} = Sereal::Encoder->new($params->{encoder});
	}
	if (ref $params->{decoder} eq 'HASH') {
		$self->{decoder} = Sereal::Decoder->new($params->{decoder});
	}

	return bless $self, $class;
}

sub store {
	my ($self, $data, $path) = @_;

	die "No file specified" unless $path;
	if (ref $self->{encoder} ne 'Sereal::Encoder') {
		$self->{encoder} = Sereal::Encoder->new();
	}
	my $encoded = $self->{encoder}->encode($data);
	open(my $fh, ">", $path) or die "Cannot open file $path: $!";
	binmode $fh;
	print $fh $encoded	or die "Cannot write to file $path: $!";
	close $fh or die "Cannot close file $path: $!";

	return 1;
}

sub retrieve {
	my ($self, $path) = @_;

	die "No file specified" unless $path;
	if (ref $self->{decoder} ne 'Sereal::Decoder') {
		$self->{decoder} = Sereal::Decoder->new();
	}
	open(my $fh, "<", $path) or die "Cannot open file $path: $!";
	binmode $fh;
	my $data;
	if (my $size = -s $fh) {
		my ($pos, $read) = 0;
		while ($pos < $size) {
			defined($read = read($fh, $data, $size - $pos, $pos))
				or die "Cannot read file $path: $!";
			$pos += $read;
		}
	}
	else {
		$data = <$fh>;
	}
	close $fh or die "Cannot close file $path: $!";
	$self->{decoder}->decode($data, my $decoded);

	return $decoded;
}

1;

__END__