X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep%2FFile.pm;h=83835d94bb92d1ed6919b17baa932b0b6e1c646e;hb=4301e8795213becc8854d413062d49746cdf5a31;hp=f11a66a30b81eb270646f756ff563d22c3a1c917;hpb=20b7f04742491a0dcc6b453625c06970092074e3;p=dbsrgits%2FDBM-Deep.git

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index f11a66a..83835d9 100644
--- a/lib/DBM/Deep/File.pm
+++ b/lib/DBM/Deep/File.pm
@@ -1,34 +1,32 @@
 package DBM::Deep::File;
 
-use 5.6.0;
+use 5.006_000;
 
 use strict;
 use warnings;
 
-use Fcntl qw( :DEFAULT :flock :seek );
+our $VERSION = q(1.0006);
 
-our $VERSION = '0.01';
+use Fcntl qw( :DEFAULT :flock :seek );
 
 sub new {
     my $class = shift;
     my ($args) = @_;
 
     my $self = bless {
-        autobless          => undef,
-        autoflush          => undef,
+        autobless          => 1,
+        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,
-
-        transaction_id        => 0,
-        transaction_offset    => 0,
     }, $class;
 
     # Grab the parameters we want to use
@@ -49,10 +47,17 @@ sub new {
 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;
+    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 )
@@ -82,6 +87,51 @@ sub close {
     return 1;
 }
 
+sub set_inode {
+    my $self = shift;
+
+    unless ( defined $self->{inode} ) {
+        my @stats = stat($self->{fh});
+        $self->{inode} = $stats[1];
+        $self->{end} = $stats[7];
+    }
+
+    return 1;
+}
+
+sub print_at {
+    my $self = shift;
+    my $loc  = shift;
+
+    local ($/,$\);
+
+    my $fh = $self->{fh};
+    if ( defined $loc ) {
+        seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
+    }
+
+    print( $fh @_ );
+
+    return 1;
+}
+
+sub read_at {
+    my $self = shift;
+    my ($loc, $size) = @_;
+
+    local ($/,$\);
+
+    my $fh = $self->{fh};
+    if ( defined $loc ) {
+        seek( $fh, $loc + $self->{file_offset}, SEEK_SET );
+    }
+
+    my $buffer;
+    read( $fh, $buffer, $size);
+
+    return $buffer;
+}
+
 sub DESTROY {
     my $self = shift;
     return unless $self;
@@ -91,6 +141,17 @@ sub DESTROY {
     return;
 }
 
+sub request_space {
+    my $self = shift;
+    my ($size) = @_;
+
+    #XXX Do I need to reset $self->{end} here? I need a testcase
+    my $loc = $self->{end};
+    $self->{end} += $size;
+
+    return $loc;
+}
+
 ##
 # If db locking is set, flock() the db file.  If called multiple
 # times before unlock(), then the same number of unlocks() must
@@ -99,6 +160,7 @@ sub DESTROY {
 sub lock {
     my $self = shift;
     my ($obj, $type) = @_;
+
     $type = LOCK_EX unless defined $type;
 
     if (!defined($self->{fh})) { return; }
@@ -113,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;
 
@@ -153,89 +215,16 @@ sub unlock {
     return;
 }
 
-sub set_transaction_offset {
+sub flush {
     my $self = shift;
-    $self->{transaction_offset} = shift;
-}
-
-sub begin_transaction {
-    my $self = shift;
-
-    my $fh = $self->{fh};
-
-    $self->lock;
-
-    seek( $fh, $self->{transaction_offset}, SEEK_SET );
-    my $buffer;
-    read( $fh, $buffer, 4 );
-    $buffer = unpack( 'N', $buffer );
-
-    for ( 1 .. 32 ) {
-        next if $buffer & (1 << ($_ - 1));
-        $self->{transaction_id} = $_;
-        $buffer &= (1 << $_);
-        last;
-    }
-
-    seek( $fh, $self->{transaction_offset}, SEEK_SET );
-    print( $fh pack( 'N', $buffer ) );
-
-    $self->unlock;
-
-    return $self->{transaction_id};
-}
-
-sub end_transaction {
-    my $self = shift;
-
-    my $fh = $self->{fh};
-
-    $self->lock;
-
-    seek( $fh, $self->{transaction_offset}, SEEK_SET );
-    my $buffer;
-    read( $fh, $buffer, 4 );
-    $buffer = unpack( 'N', $buffer );
 
-    # Unset $self->{transaction_id} bit
+    # Flush the filehandle
+    my $old_fh = select $self->{fh};
+    my $old_af = $|; $| = 1; $| = $old_af;
+    select $old_fh;
 
-    seek( $fh, $self->{transaction_offset}, SEEK_SET );
-    print( $fh pack( 'N', $buffer ) );
-
-    $self->unlock;
-
-    $self->{transaction_id} = 0;
-}
-
-sub current_transactions {
-    my $self = shift;
-
-    my $fh = $self->{fh};
-
-    $self->lock;
-
-    seek( $fh, $self->{transaction_offset}, SEEK_SET );
-    my $buffer;
-    read( $fh, $buffer, 4 );
-    $buffer = unpack( 'N', $buffer );
-
-    $self->unlock;
-
-    my @transactions;
-    for ( 1 .. 32 ) {
-        if ( $buffer & (1 << ($_ - 1)) ) {
-            push @transactions, $_;
-        }
-    }
-
-    return @transactions;
+    return 1;
 }
 
-sub transaction_id { return $_[0]->{transaction_id} }
-
-#sub commit {
-#}
-
 1;
 __END__
-