use strict;
use Fcntl;
use POSIX qw(:stdio_h);
sub block_shift {
my ($self, $position, $nelements, $distance) = @_;
my $fh = $self->fh;
my $reclen = $self->reclen;
my $block;
$self->seek_index($position);
unless (read $fh, $block, $nelements * $reclen) {
return;
}
$self->seek_index($position + $distance);
print $fh $block;
}
sub seek_index {
my ($self, $index) = @_;
seek($self->fh, $index * $self->reclen, SEEK_SET);
}
sub tell_index {
my $self = shift;
my $pos = tell($self->fh) / $self->reclen;
ceil($pos);
}
sub block_move {
my ($self, $index, $newindex, $blocksize) = @_;
my $fh = $self->fh;
my $reclen = $self->reclen;
return unless $newindex != $index;
# Copy the block to be moved.
my @block = map $self->FETCH($_), ($index..$index+$blocksize-1);
# Store the block in its new location.
my $n = $newindex;;
$self->STORE($n++, shift @block) while(@block);
1;
}
sub tester {
my $testfile = shift;
unlink $testfile;
unless ($testfile =~ /\.dbf$/) {
die ("Filename '$testfile' does not end with .dbf");
}
my @part = (
['x_lycos.com', 8000],
['x_msn.com',6140],
);
my $flat;
$flat = tie my @dbf, 'Tie::FlatFile::Array', $testfile,
O_RDWR | O_CREAT, 0644, { packformat => 'A30N' }
or die("Tie failed: $!");
push @dbf, ['google.com', 14592];
push @dbf, ['yahoo.com', 10126];
push @dbf, ['ask.com', 8114];
push @dbf, ['tyson.com', 314];
push @dbf, ['janesearch.com', 559], ['waits.org', 1029];
# $flat->block_move(1,0,2);
foreach my $n (0..$#dbf) {
print "@{$dbf[$n]}\n";
}
undef $flat;
untie @dbf;
}
1;