File Coverage

blib/lib/ESPPlus/Storage/Reader.pm

Criterion	Covered	Total	%
statement	54	60	90.0
branch	8	16	50.0
condition	3	6	50.0
subroutine	11	11	100.0
pod	3	4	75.0
total	79	97	81.4

package ESPPlus::Storage::Reader;
use 5.006;
use strict;
use warnings;
use Carp 'confess';
use ESPPlus::Storage::Util;

use vars qw($COMPRESS_MAGIC_NUMBER
	    $BLOCK_SIZE
	    $MAX_BUFFER_SIZE
	    $MIN_BUFFER_SIZE);

$COMPRESS_MAGIC_NUMBER = "\037\235";

#our $BASE_RECORD =
#    q[(?x:
#       \\A # Start at the beginning
#
#       ((?xs:.+?))
#       # Capture the .Z binary record. It is known to be $L characters
#       # uncompressed so I'm using 0 -> $L as the size restriction.
#
#       # Insert a tail condition here. Either match the next header or
#       # the end of string if the buffer and file are exhausted.
#       )];
#
#our $CONTINUED_RECORD =
#    do {
#	use re 'eval';
#	qr( $BASE_RECORD
#	    # Find the header for the next section but don't remove it.
#	    H=(\d+);
#	    # The number after H indicates how many bytes the header is. The
#	    # expression should now look for $+ - length("H=$+;") characters
#	    # that match [[:print:]] followed by a .Z magic number or the
#	    # end of the string if the source filehandle is at eof().
#
#	    (??{ "(?s:.{".($+ - length "H=$+;")."})$COMPRESS_MAGIC_NUMBER" })
#	    )x;
#    };
#
#our $LAST_RECORD = qr[$BASE_RECORD\z];

$BLOCK_SIZE = 2 ** 13;
$MAX_BUFFER_SIZE = 128 * $BLOCK_SIZE;
$MIN_BUFFER_SIZE = 8 * $BLOCK_SIZE;


BEGIN {
    for (qw(handle
	    record_number)) {
	attribute_builder( $_, 'read only' );
    }

    attribute_builder( 'uncompress_function' );
}

sub new {
    my $class = shift;
    my $p     = shift;
    my $self  = bless {}, $class;

    $self->{'record_number'} = 0;
    my $_buffer = '';
    $self->{'_buffer'} = \ $_buffer;

    for my $param (qw[uncompress_function
		      handle]) {
	unless ( exists $p->{$param} ) {
	    confess "Required parameter $param wasn't provided";
	}

	$self->{$param} = delete $p->{$param};
    }

    return $self;
}

sub buffer {
    my $self = shift;
    my $handle = $self->{'handle'};
    my $buffer = $self->{'_buffer'};

    if ( eof $handle and not length $$buffer ) {
	return;
    }

    if (length $$buffer < $MIN_BUFFER_SIZE) {
	my $read_bytes = int
	    ( ($MAX_BUFFER_SIZE - length($$buffer))
	      / $BLOCK_SIZE ) * $BLOCK_SIZE;

	read( $handle,
	      $$buffer,
	      $read_bytes,
	      length $$buffer );
    }

    return $buffer;
}

sub next_record_body {
    my $self = shift;

    my $record = $self->next_record;

    return $record->body if $record;
    return;
}

sub next_record {
    my $self = shift;
    my $buffer = $self->buffer;
    my $rec_num = ++$self->{'record_number'};

    return unless $buffer;
    unless ($$buffer =~ m/^H=(?>\d+);/) {
	confess
	    "$rec_num was missing the header prefix m/^H=\\d+;/: $$buffer";
    }

    my $header_length = substr $$buffer, 2, $+[0]-3;

    # Remove the header
    my $header_text = substr $$buffer, 0, $header_length, '';

    my $record_body;
    if ( $$buffer =~ /H=(?>\d+);/ and
	 $COMPRESS_MAGIC_NUMBER eq
	 substr( $$buffer,
		 $-[0] + substr($$buffer,$-[0]+2,$+[0]-$-[0]-3),
		 length($COMPRESS_MAGIC_NUMBER) ) ) {

	# Capture everything before the first header-looking thing.
	$record_body = substr $$buffer, 0, $-[0], '';
    } elsif ( eof $self->{'handle'} ) {

	# Since a header wasn't found, I'm expecting that the database is
	# at the end.
	$record_body = $$buffer;
	$$buffer = '';
    } else {

	confess("Er!");
    }

    return
	ESPPlus::Storage::Record->new
	( { header_text         => \ $header_text,
	    compressed          => \ $record_body,
	    uncompress_function =>   $self->{'uncompress_function'},
	    record_number       =>   $rec_num } );
}

1;

__END__