use strict;
use warnings;
-use Fcntl qw( :DEFAULT :flock :seek );
+our $VERSION = q(0.99_03);
-our $VERSION = '0.01';
+use Fcntl qw( :DEFAULT :flock :seek );
sub new {
my $class = shift;
# $args. They are here for documentation purposes.
transaction_id => 0,
transaction_offset => 0,
- trans_audit => undef,
+ transaction_audit => undef,
base_db_obj => undef,
}, $class;
sub set_db {
my $self = shift;
+
unless ( $self->{base_db_obj} ) {
$self->{base_db_obj} = shift;
Scalar::Util::weaken( $self->{base_db_obj} );
sub open {
my $self = shift;
- # Adding O_BINARY does remove the need for the binmode below. However,
+ # Adding O_BINARY should remove the need for the binmode below. However,
# I'm not going to remove it because I don't have the Win32 chops to be
# absolutely certain everything will be ok.
my $flags = O_RDWR | O_CREAT | O_BINARY;
sub lock {
my $self = shift;
my ($obj, $type) = @_;
+
+ #XXX This may not always be the correct thing to do
+ $obj = $self->{base_db_obj} unless defined $obj;
+
$type = LOCK_EX unless defined $type;
if (!defined($self->{fh})) { return; }
flock( $afh, LOCK_UN );
}
- if ( $self->{trans_audit} ) {
- push @{$self->{trans_audit}}, $string;
+ if ( $self->{transaction_audit} ) {
+ push @{$self->{transaction_audit}}, $string;
}
return 1;
$self->lock;
- seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET );
- my $buffer;
- read( $fh, $buffer, 4 );
- $buffer = unpack( 'N', $buffer );
+ my $buffer = $self->read_at( $self->{transaction_offset}, 4 );
+ my ($next, @trans) = unpack( 'C C C C C C C C C C C C C C C C', $buffer );
+
+ $self->{transaction_id} = ++$next;
+
+ die if $trans[-1] != 0;
- for ( 1 .. 32 ) {
- next if $buffer & (1 << ($_ - 1));
- $self->{transaction_id} = $_;
- $buffer |= (1 << $_-1 );
+ for ( my $i = 0; $i <= $#trans; $i++ ) {
+ next if $trans[$i] != 0;
+ $trans[$i] = $next;
last;
}
- seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET );
- print( $fh pack( 'N', $buffer ) );
+ $self->print_at(
+ $self->{transaction_offset},
+ pack( 'C C C C C C C C C C C C C C C C', $next, @trans),
+ );
$self->unlock;
- $self->{trans_audit} = [];
+ $self->{transaction_audit} = [];
return $self->{transaction_id};
}
$self->lock;
- seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET );
- my $buffer;
- read( $fh, $buffer, 4 );
- $buffer = unpack( 'N', $buffer );
+ my $buffer = $self->read_at( $self->{transaction_offset}, 4 );
+ my ($next, @trans) = unpack( 'C C C C C C C C C C C C C C C C', $buffer );
+
+ @trans = grep { $_ != $self->{transaction_id} } @trans;
- # Unset $self->{transaction_id} bit
- $buffer ^= (1 << $self->{transaction_id}-1);
+ $self->print_at(
+ $self->{transaction_offset},
+ pack( 'C C C C C C C C C C C C C C C C', $next, @trans),
+ );
- seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET );
- print( $fh pack( 'N', $buffer ) );
+ #XXX Need to free the space used by the current transaction
$self->unlock;
$self->{transaction_id} = 0;
- $self->{trans_audit} = undef;
+ $self->{transaction_audit} = undef;
+
+# $self->{base_db_obj}->optimize;
+# $self->{inode} = undef;
+# $self->set_inode;
return 1;
}
$self->lock;
- seek( $fh, $self->{transaction_offset} + $self->{file_offset}, SEEK_SET );
- my $buffer;
- read( $fh, $buffer, 4 );
- $buffer = unpack( 'N', $buffer );
+ my $buffer = $self->read_at( $self->{transaction_offset}, 4 );
+ my ($next, @trans) = unpack( 'C C C C C C C C C C C C C C C C', $buffer );
$self->unlock;
- my @transactions;
- for ( 1 .. 32 ) {
- if ( $buffer & (1 << ($_ - 1)) ) {
- push @transactions, $_;
- }
- }
-
- return grep { $_ != $self->{transaction_id} } @transactions;
+ return grep { $_ && $_ != $self->{transaction_id} } @trans;
}
sub transaction_id { return $_[0]->{transaction_id} }
sub commit_transaction {
my $self = shift;
- my @audit = @{$self->{trans_audit}};
+ my @audit = @{$self->{transaction_audit}};
$self->end_transaction;