use strict;
use File::Temp ('mkstemp');
use Carp ('confess');
our @ISA = ('Filesys::POSIX::IO::Handle');
my $DEFAULT_MAX = 16384;
my $DEFAULT_DIR = '/tmp';
sub new {
my ( $class, %opts ) = @_;
return bless {
'fh' => undef,
'buf' => '',
'max' => defined $opts{'max'} ? $opts{'max'} : $DEFAULT_MAX,
'dir' => defined $opts{'dir'} ? $opts{'dir'} : $DEFAULT_DIR,
'inode' => $opts{'inode'},
'size' => 0,
'pos' => 0
}, $class;
}
sub DESTROY {
my ($self) = @_;
close $self->{'fh'} if $self->{'fh'};
if ( $self->{'file'} && -f $self->{'file'} ) {
unlink $self->{'file'};
}
}
sub open {
my ( $self, $flags ) = @_;
$flags ||= 0;
confess('Already opened') if $self->{'fh'};
if ( $flags & $O_APPEND ) {
$self->{'pos'} = $self->{'size'};
}
elsif ( $flags & $O_TRUNC ) {
$self->{'pos'} = 0;
$self->{'size'} = 0;
}
if ( $self->{'file'} ) {
sysopen( my $fh, $self->{'file'}, $flags ) or confess("Unable to reopen bucket $self->{'file'}: $!");
$self->{'fh'} = $fh;
}
if ( $flags & $O_TRUNC ) {
$self->{'size'} = 0;
$self->{'inode'}->{'size'} = 0;
undef $self->{'buf'};
$self->{'buf'} = '';
}
return $self;
}
sub _flush_to_disk {
my ( $self, $len ) = @_;
confess('Already flushed to disk') if $self->{'file'};
my ( $fh, $file ) = eval { mkstemp("$self->{'dir'}/.bucket-XXXXXX") };
confess("mkstemp() failure: $@") if $@;
my $offset = 0;
for ( my $left = $self->{'size'}; $left > 0; $left -= $len ) {
my $wrlen = $left > $len ? $len : $left;
syswrite( $fh, substr( $self->{'buf'}, $offset, $wrlen ), $wrlen );
$offset += $wrlen;
}
@{$self}{qw/fh file/} = ( $fh, $file );
}
sub write {
my ( $self, $buf, $len ) = @_;
my $ret = 0;
unless ( $self->{'fh'} ) {
$self->_flush_to_disk($len) if $self->{'pos'} + $len > $self->{'max'};
}
if ( $self->{'fh'} ) {
confess("Unable to write to disk bucket") unless fileno( $self->{'fh'} );
$ret = syswrite( $self->{'fh'}, $buf );
}
else {
if ( ( my $gap = $self->{'pos'} - $self->{'size'} ) > 0 ) {
$self->{'buf'} .= "\x00" x $gap;
}
substr( $self->{'buf'}, $self->{'pos'}, $len ) = substr( $buf, 0, $len );
$ret = $len;
}
$self->{'pos'} += $ret;
$self->{'size'} += $ret;
if ( $self->{'pos'} > $self->{'size'} ) {
$self->{'size'} = $self->{'pos'};
}
$self->{'inode'}->{'size'} = $self->{'size'};
return $ret;
}
sub read {
my $self = shift;
my $len = pop;
my $ret = 0;
if ( $self->{'fh'} ) {
confess("Unable to read bucket: $!") unless fileno( $self->{'fh'} );
$ret = sysread( $self->{'fh'}, $_[0], $len );
}
else {
my $pos = $self->{'pos'} > $self->{'size'} ? $self->{'size'} : $self->{'pos'};
my $maxlen = $self->{'size'} - $pos;
$len = $maxlen if $len > $maxlen;
unless ($len) {
$_[0] = '';
return 0;
}
$_[0] = substr( $self->{'buf'}, $self->{'pos'}, $len );
$ret = $len;
}
$self->{'pos'} += $ret;
return $ret;
}
sub seek {
my ( $self, $pos, $whence ) = @_;
my $newpos;
if ( $self->{'fh'} ) {
$newpos = sysseek( $self->{'fh'}, $pos, $whence );
}
elsif ( $whence == $SEEK_SET ) {
$newpos = $pos;
}
elsif ( $whence == $SEEK_CUR ) {
$newpos = $self->{'pos'} + $pos;
}
elsif ( $whence == $SEEK_END ) {
$newpos = $self->{'size'} + $pos;
}
else {
confess('Invalid argument');
}
return $self->{'pos'} = $newpos;
}
sub tell {
return shift->{'pos'};
}
sub close {
my ($self) = @_;
if ( $self->{'fh'} ) {
close $self->{'fh'};
undef $self->{'fh'};
}
$self->{'pos'} = 0;
}
1;