File Coverage

blib/lib/Tie/FlatFile/Array.pm

Criterion	Covered	Total	%
statement	91	116	78.4
branch	6	14	42.8
condition			n/a
subroutine	20	24	83.3
pod			n/a
total	117	154	75.9

use strict;
use warnings;

package Tie::FlatFile::Array;
use base 'Class::Accessor';
use Carp qw(croak);
use Fcntl;
use POSIX qw(:stdio_h ceil);
use FileHandle;
use English qw(-no_match_vars);
use File::Spec::Functions qw(catfile splitpath);

my @fields;

BEGIN {
	our $VERSION = 0.05;
	$VERSION = eval $VERSION;
	@fields = qw(filename flags mode packformat handle
	reclen nulls nulla);
	__PACKAGE__->mk_accessors(@fields);
	*fh = \&handle;
	# require Tie::FlatFile::ArrayHelper;
}

sub TIEARRAY {
	my $class = shift;
	my $self = bless({}, $class);
	my ($filename, $flags, $mode, $opts) = @_;
	my ($packformat);
	local $Carp::CarpLevel = 1;	# Set the stack frame for croak().

	if ('HASH' ne ref($opts)) {
		croak('Options hash missing');
	} else {
		$packformat = $opts->{packformat};
	}

	# Check for missing parameters.
	foreach my $nm (qw(filename flags mode packformat)) {
		my $value = eval "\$$nm";
		unless (defined ($value)) {
			croak("Missing $nm");
		}
		$self->$nm($value);
	}

	# Open the file and save the file handle.
	my $fh = new FileHandle $filename, $flags;
	$self->handle($fh);

	# Store the record length;
	my $len = $self->reclen(length(pack $packformat, (1) x 30));

	{
	no warnings 'uninitialized';
	$self->nulls(pack $packformat, (undef) x 30);
	$self->nulla([(undef) x 30]);
	}

	$self;
}

sub UNTIE {
	my $self = shift;
	return unless $self->handle;
	close($self->handle);
}

sub FETCH {
	my ($self, $index) = @_;
	return undef if $index < 0;

	my $len = $self->reclen;
	my $fh = $self->fh;
	local $Carp::CarpLevel = 1;	# Set the stack frame for croak().

	local $RS = \$len;		# Set the record length.
	seek($fh, $index * $len, SEEK_SET);
	my $data = <$fh>;  # Get a record.
	return undef unless $data;

	# Unpack and return the data as an array reference.
	[ unpack $self->packformat, $data ];
}

sub STORE {
	my ($self, $index, $value) = @_;
	my $len = $self->reclen;
	my $fh = $self->fh;

	seek($fh, $index * $len, SEEK_SET);
	print $fh (pack $self->packformat, @$value);
}

sub FETCHSIZE {
	my $self = shift;
	my $pos = tell($self->fh);

	# Go to the end of the file and find out the
	# size in bytes [using tell()] and divide that
	# by the size of a record.
	seek($self->fh, 0, SEEK_END);
	my $size = tell($self->fh) / $self->reclen;
	$size = ceil($size);

	# Go back to the original position in the file.
	seek($self->fh, $pos, SEEK_SET);
	$size;
}


sub EXTEND {
}


sub EXISTS {
	my ($self, $index) = @_;
	$index >= 0 && $index < $self->FETCHSIZE;
}

sub DELETE {
	my ($self, $index) = @_;
	$self->STORE($index, $self->nulla);
}

sub CLEAR {
	my $self = shift;
	truncate($self->fh, 0);
}

sub PUSH {
	my $self = shift;
	my $size = $self->FETCHSIZE;
	$self->STORE($size++, +shift) while (@_);
}

sub POP {
	my $self = shift;
	my $size = $self->FETCHSIZE;
	my $data = $self->FETCH($size-1);
	truncate($self->fh, ($size-1) * $self->reclen);
	$data;
}

sub SHIFT {
	my $self = shift;
	my $size = $self->FETCHSIZE;
	return undef unless $size;

	my $data = $self->FETCH(0);
	my $reclen = $self->reclen;
	my $fh = $self->fh;
	local $RS = \$reclen;

	foreach my $n (0..$size-2) {
		seek($fh, ($n+1) * $reclen, SEEK_SET);
		my $temp = <$fh>;
		seek($fh, -2*$reclen, SEEK_CUR);
		print $fh $temp;
	}

	truncate($fh, ($size-1)*$reclen );
	$data;
}

sub UNSHIFT {
	my $self = shift;

	for (my $n = $self->FETCHSIZE-1; $n >= 0; --$n) {
		my $ele = $self->FETCH($n);
		$self->STORE($n + @_, $ele);
	}

	foreach my $n (0..$#_) {
		$self->STORE($n, $_[$n]);
	}
	$self->FETCHSIZE;
}


1;