r6127@000-443-371 (orig r9960): rkinyon | 2007-09-20 21:13:08 -0400

[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / File.pm

diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm
index 2862ca5..3f8511e 100644 (file)
--- 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.0002);
 
-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,38 +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};
+    # 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 );
-
-    $self->{transaction_id}++;
-}
-
-sub end_transaction {
-    my $self = shift;
-
-#    seek( $fh, $self->{transaction_offset}, SEEK_SET );
-
-    $self->{transaction_id} = 0;
-}
-
-sub transaction_id {
-    my $self = shift;
-
-    return $self->{transaction_id};
+    return 1;
 }
 
-#sub commit {
-#}
-
 1;
 __END__
-