File Coverage

blib/lib/DataStore/CAS/FS/DirCodec.pm

Criterion	Covered	Total	%
statement	47	58	81.0
branch	18	36	50.0
condition	6	17	35.2
subroutine	11	14	78.5
pod	5	5	100.0
total	87	130	66.9

package DataStore::CAS::FS::DirCodec;
use 5.008;
use strict;
use warnings;
use Carp;
use Try::Tiny;

our $VERSION= '0.010000';

our %_Formats= ();

# ABSTRACT: Abstract base class for directory encoder/decoders


sub load {
	my $class= shift;
	my %p= (@_ == 1)? ((ref $_[0] eq 'HASH')? %{$_[0]} : ( file => $_[0] )) : @_;

	defined $p{file} or croak "Missing required attribute 'file'";
	defined $p{format} or $p{format}= $class->_read_format(\%p);

	# Once we get the name of the format, we can jump over to the constructor
	# for the appropriate class
	my $codec= $_Formats{$p{format}}
		or croak "Unknown directory format '$p{format}' in ".$p{file}->hash
			."\n(be sure to load relevant modules)\n";
	return $codec->decode(\%p);
}


sub put {
	my ($class, $cas, $format, $entries, $metadata)= @_;
	defined $entries and ref $entries eq 'ARRAY' or croak "entries must be an arrayref";
	my $codec= $_Formats{$format}
		or croak "Unknown directory format '$format'"
			."\n(be sure to load relevant modules)\n";
	my $scalar= $codec->encode($entries, $metadata);
	return $cas->put_scalar($scalar);
}


sub decode {
	(shift)->load(@_);
}


sub encode {
	croak "Only implemented in subclasses";
}


sub register_format {
	my ($class, $format, $codec)= @_;
	my $dec= $codec->can('decode');
	defined $dec && $dec ne \&decode
		or croak ref($codec)." must implement 'decode'";
	$_Formats{$format}= $codec;
}


my $_MagicNumber= 'CAS_Dir ';

sub _magic_number { $_MagicNumber }

sub _calc_header_length {
	my ($class, $format)= @_;
	# Length of sprintf("CAS_Dir %02X %s\n", length($format), $format)
	return length($format)+length($_MagicNumber)+4;
}


sub _read_format {
	my ($class, $params)= @_;

	# The caller is allowed to pre-load the data so that we don't need to read it here.
	my $buf= $params->{data};
	# If they didn't, we need to load it.
	if (!defined $params->{data}) {
		$params->{handle}= $params->{file}->open
			unless defined $params->{handle};
		seek($params->{handle}, 0, 0) or croak "seek: $!";
		$class->_readall($params->{handle}, $buf, length($_MagicNumber)+2);
	}

	# first 8 bytes are "CAS_Dir "
	# Next 2 bytes are the length of the format in uppercase ascii hex (limiting format id to 255 characters)
	substr($buf, 0, length($_MagicNumber)) eq $_MagicNumber
		or croak "Bad magic number in directory ".$params->{file}->hash;
	my $format_len= hex substr($buf, length($_MagicNumber), 2);

	# Now we know how many additional bytes we need
	if (!defined $params->{data}) {
		$class->_readall($params->{handle}, $buf, 1+$format_len+1, length($buf));
	}

	# The byte after that is a space character.
	# The format id string follows, in exactly $format_len bytes
	# There is a newline (\n) at the end of the format string which is not part of that count.
	substr($buf, length($_MagicNumber)+2, 1) eq ' '
		and substr($buf, length($_MagicNumber)+3+$format_len, 1) eq "\n"
		or croak "Invalid directory encoding in ".$params->{file}->hash;
	return substr($buf, length($_MagicNumber)+3, $format_len);
}


sub _readall {
	my $got= read($_[1], $_[2], $_[3], $_[4]||0);
	return $got if defined $got and $got == $_[3];
	my $count= $_[3];
	while (1) {
		if (defined $got) {
			croak "unexpected EOF"
				unless $got > 0;
			$count -= $got;
		}
		else {
			croak "read: $!"
				unless $!{EINTR} || $!{EAGAIN};
		}
		$got= read($_[1], $_[2], $count, length $_[2]);
	}
	1;
}

1;

__END__