File Coverage

blib/lib/File/LinearRaid.pm

Criterion	Covered	Total	%
statement	112	123	91.0
branch	34	48	70.8
condition	6	7	85.7
subroutine	17	20	85.0
pod	3	3	100.0
total	172	201	85.5

package File::LinearRaid;

use strict;
use warnings;
use Symbol;
use Carp;
use vars '$VERSION';

$VERSION = '0.12';

sub new {
    my $pkg = shift;

    my $sym = gensym;
    tie *$sym, $pkg, @_;

    return bless $sym, $pkg;
}

sub size {
    tied( *{+shift} )->{length};
}

sub append {
    my $self = tied( *{+shift} );

    while (my ($file, $size) = splice @_, 0, 2) {
        open my $fh, $self->{mode}, $file
            or croak "File::LinearRaid: couldn't open $file: $!\n";

        push @{ $self->{handles} }, $fh;
        push @{ $self->{files} }, $file;
        push @{ $self->{sizes} }, $size;

        $self->{length} += $size;
    }

    return 1;
}

sub TIEHANDLE {
    my $pkg = shift;
    my $mode = shift;

    my @files;
    my @sizes;
    my @handles;
    my $length = 0;

    while (my ($file, $size) = splice @_, 0, 2) {
        open my $fh, $mode, $file
            or croak "File::LinearRaid: couldn't open $file: $!\n";

        push @handles, $fh;
        push @files, $file;
        push @sizes, $size;
        $length += $size;
    }

    bless {
        pos       => 0,
        files     => \@files,
        sizes     => \@sizes,
        handles   => \@handles,
        length    => $length,
	mode      => $mode
    }, $pkg;
}

sub READ {
    my ($self, undef, $length, $offset) = @_;

    $offset ||= 0;

    if ($self->EOF) {
        substr($_[1], $offset) = "";
        return 0;
    }

    my $pos = $self->{pos};

    my $f = 0;
    while ($pos >= $self->{sizes}[$f]) {
        $pos -= $self->{sizes}[$f];
        $f++;
    }

    my $b;

    my $this_read = ($pos + $length > $self->{sizes}[$f])
        ? $self->{sizes}[$f] - $pos
        : $length;

    if (tell $self->{handles}[$f] != $pos) {
        seek $self->{handles}[$f], $pos, 0
            or croak "File::LinearRaid: couldn't seek $self->{files}[$f]: $!";
    }

    $b = read $self->{handles}[$f], $_[1], $this_read, $offset;

    defined $b
        or croak "File::LinearRaid: error reading from $self->{files}[$f]: $!";

    $self->{pos} += $this_read;

    if ( $b < $this_read ) {
        # pad out rest of chunk with nulls
        substr($_[1], $offset + $b) = "\x0" x ($this_read - $b);
    }

    if ($this_read == $length) {
        return $length;
    } else {
        return $this_read + $self->READ($_[1], $length - $this_read, $offset + $this_read);
    }
}

sub READLINE {
    my $self   = shift;
    my $oldpos = $self->{pos};

    return undef if $self->EOF;

    my $buf = "";

    if (not defined $/) {
        $self->READ($buf, $self->{length} - $oldpos);
    } elsif (ref $/) {
        $self->READ($buf, ${$/});
    } else {

        while (index($buf, $/) == -1 and not $self->EOF) {
            $self->READ($buf, 1024, length $buf);
        }

        if (index($buf, $/) != -1) {
            substr($buf, index($buf, $/) + length($/)) = "";
            $self->{pos} = $oldpos + length $buf;
        }
    }

    return $buf;

}

sub GETC {
    my $c;
    $_[0]->READ($c, 1);
    return $c;
}



sub WRITE {
    my ($self, undef, $length, $offset) = @_;

    $offset ||= 0;

    if ($self->EOF) {
        return 0;
    }

    my $pos = $self->{pos};

    my $f = 0;
    while ($pos >= $self->{sizes}[$f]) {
        $pos -= $self->{sizes}[$f];
        $f++;
    }

    my $this_write = ($pos + $length > $self->{sizes}[$f])
        ? $self->{sizes}[$f] - $pos
        : $length;

    if (tell $self->{handles}[$f] != $pos) {
        seek $self->{handles}[$f], $pos, 0
            or croak "File::LinearRaid: couldn't seek $self->{files}[$f]: $!";
    }

    print { $self->{handles}[$f] } substr($_[1], $offset, $this_write)
        or return 0;

    $self->{pos} += $this_write;

    if ($this_write == $length) {
        return 1;
    } else {
        return $self->WRITE($_[1], $length - $this_write, $offset + $this_write);
    }
}

sub PRINT {
    my $self = shift;
    my $buf = join +(defined $, ? $, : "") => @_;
    $self->WRITE($buf, length($buf), 0);
}

sub PRINTF {
    my $self = shift;
    my $fmt  = shift;
    $self->PRINT( sprintf $fmt, @_ );
}



sub SEEK {
    my ($self, $offset, $whence) = @_;

    my $pos = $self->{pos};

    $whence == 0 and $pos = $offset;
    $whence == 1 and $pos += $offset;
    $whence == 2 and $pos = $self->{size} + $offset;

    return 0 if $pos < 0;
    $self->{pos} = $pos;
    return 1;
}

sub TELL {
    $_[0]->{pos};
}

sub EOF {
    my $self = shift;
    return $self->{pos} == $self->{length};
}

sub CLOSE {
    close $_ for @{ $_[0]->{handles} };
    $_[0] = undef;
}

sub OPEN {
    croak "File::LinearRaid::OPEN Unimplemented";
}
1;

__END__