X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep%2FFile.pm;h=5216eaf3f8478c86fdbbe3a89d49198d195512be;hb=5a70a6c032a79557eddd062e8dd5f7c326690721;hp=2edf202157cc1bd59532d0cb19648dc07c30d828;hpb=3ad3bcb6eb2fe7fdec1e92bcaa872b96d03e707a;p=dbsrgits%2FDBM-Deep.git

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 2edf202..5216eaf 100644
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -1,11 +1,11 @@
 package DBM::Deep::File;
 
-use 5.6.0;
+use 5.006_000;
 
 use strict;
 use warnings;
 
-our $VERSION = q(0.99_03);
+our $VERSION = q(1.0007);
 
 use Fcntl qw( :DEFAULT :flock :seek );
 
@@ -14,27 +14,19 @@ sub new {
     my ($args) = @_;
 
     my $self = bless {
-        audit_fh           => undef,
-        audit_file         => undef,
         autobless          => 1,
-        autoflush          => undef,
+        autoflush          => 1,
         end                => 0,
         fh                 => undef,
         file               => undef,
         file_offset        => 0,
-        locking            => undef,
+        locking            => 1,
         locked             => 0,
+#XXX Migrate this to the engine, where it really belongs.
         filter_store_key   => undef,
         filter_store_value => undef,
         filter_fetch_key   => undef,
         filter_fetch_value => undef,
-
-        # These are values that are not expected to be passed in through
-        # $args. They are here for documentation purposes.
-        transaction_id     => 0,
-        transaction_offset => 0,
-        transaction_audit  => undef,
-        base_db_obj        => undef,
     }, $class;
 
     # Grab the parameters we want to use
@@ -49,43 +41,23 @@ sub new {
 
     $self->open unless $self->{fh};
 
-    if ( $self->{audit_file} && !$self->{audit_fh} ) {
-        my $flags = O_WRONLY | O_APPEND | O_CREAT;
-
-        my $fh;
-        sysopen( $fh, $self->{audit_file}, $flags )
-            or die "Cannot open audit file '$self->{audit_file}' for read/write: $!";
-
-        # Set the audit_fh to autoflush
-        my $old = select $fh;
-        $|=1;
-        select $old;
-
-        $self->{audit_fh} = $fh;
-    }
-
-
     return $self;
 }
 
-sub set_db {
-    my $self = shift;
-
-    unless ( $self->{base_db_obj} ) {
-        $self->{base_db_obj} = shift;
-        Scalar::Util::weaken( $self->{base_db_obj} );
-    }
-
-    return;
-}
-
 sub open {
     my $self = shift;
 
     # 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;
+    my $flags = O_CREAT | O_BINARY;
+
+    if ( !-e $self->{file} || -w _ ) {
+      $flags |= O_RDWR;
+    }
+    else {
+      $flags |= O_RDONLY;
+    }
 
     my $fh;
     sysopen( $fh, $self->{file}, $flags )
@@ -118,7 +90,7 @@ sub close {
 sub set_inode {
     my $self = shift;
 
-    unless ( $self->{inode} ) {
+    unless ( defined $self->{inode} ) {
         my @stats = stat($self->{fh});
         $self->{inode} = $stats[1];
         $self->{end} = $stats[7];
@@ -146,7 +118,6 @@ sub print_at {
 sub read_at {
     my $self = shift;
     my ($loc, $size) = @_;
-    print join(":",map{$_||''}caller) . " - read_at(@{[$loc || 'undef']}, $size)\n" if $::DEBUG;
 
     local ($/,$\);
 
@@ -161,17 +132,6 @@ sub read_at {
     return $buffer;
 }
 
-sub increment_pointer {
-    my $self = shift;
-    my ($size) = @_;
-
-    if ( defined $size ) {
-        seek( $self->{fh}, $size, SEEK_CUR );
-    }
-
-    return 1;
-}
-
 sub DESTROY {
     my $self = shift;
     return unless $self;
@@ -192,24 +152,6 @@ sub request_space {
     return $loc;
 }
 
-#sub release_space {
-#    my $self = shift;
-#    my ($size, $loc) = @_;
-#
-#    local($/,$\);
-#
-#    my $next_loc = 0;
-#
-#    my $fh = $self->{fh};
-#    seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
-#    print( $fh SIG_FREE
-#        . pack($self->{long_pack}, $size )
-#        . pack($self->{long_pack}, $next_loc )
-#    );
-#
-#    return;
-#}
-
 ##
 # If db locking is set, flock() the db file.  If called multiple
 # times before unlock(), then the same number of unlocks() must
@@ -219,9 +161,6 @@ 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; }
@@ -236,7 +175,7 @@ sub lock {
 
             # double-check file inode, in case another process
             # has optimize()d our file while we were waiting.
-            if ($stats[1] != $self->{inode}) {
+            if (defined($self->{inode}) && $stats[1] != $self->{inode}) {
                 $self->close;
                 $self->open;
 
@@ -276,133 +215,16 @@ sub unlock {
     return;
 }
 
-sub set_transaction_offset {
-    my $self = shift;
-    $self->{transaction_offset} = shift;
-}
-
-sub audit {
+sub flush {
     my $self = shift;
-    my ($string) = @_;
 
-    if ( my $afh = $self->{audit_fh} ) {
-        flock( $afh, LOCK_EX );
-
-        if ( $string =~ /^#/ ) {
-            print( $afh "$string " . localtime(time) . "\n" );
-        }
-        else {
-            print( $afh "$string # " . localtime(time) . "\n" );
-        }
-
-        flock( $afh, LOCK_UN );
-    }
-
-    if ( $self->{transaction_audit} ) {
-        push @{$self->{transaction_audit}}, $string;
-    }
-
-    return 1;
-}
-
-sub begin_transaction {
-    my $self = shift;
-
-    my $fh = $self->{fh};
-
-    $self->lock;
-
-    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 ( my $i = 0; $i <= $#trans; $i++ ) {
-        next if $trans[$i] != 0;
-        $trans[$i] = $next;
-        last;
-    }
-
-    $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->{transaction_audit} = [];
-
-    return $self->{transaction_id};
-}
-
-sub end_transaction {
-    my $self = shift;
-
-    my $fh = $self->{fh};
-
-    $self->lock;
-
-    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;
-
-    $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),
-    );
-
-    #XXX Need to free the space used by the current transaction
-
-    $self->unlock;
-
-    $self->{transaction_id} = 0;
-    $self->{transaction_audit} = undef;
-
-#    $self->{base_db_obj}->optimize;
-#    $self->{inode} = undef;
-#    $self->set_inode;
-
-    return 1;
-}
-
-sub current_transactions {
-    my $self = shift;
-
-    my $fh = $self->{fh};
-
-    $self->lock;
-
-    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;
-
-    return grep { $_ && $_ != $self->{transaction_id} } @trans;
-}
-
-sub transaction_id { return $_[0]->{transaction_id} }
-
-sub commit_transaction {
-    my $self = shift;
-
-    my @audit = @{$self->{transaction_audit}};
-
-    $self->end_transaction;
-
-    {
-        my $db = $self->{base_db_obj};
-        for ( @audit ) {
-            eval "$_;";
-            warn "$_: $@\n" if $@;
-        }
-    }
+    # Flush the filehandle
+    my $old_fh = select $self->{fh};
+    my $old_af = $|; $| = 1; $| = $old_af;
+    select $old_fh;
 
     return 1;
 }
 
 1;
 __END__
-