Initial breakout into engine code
rkinyon [Tue, 28 Feb 2006 19:40:05 +0000 (19:40 +0000)]
MANIFEST
lib/DBM/Deep.pm
lib/DBM/Deep/Engine.pm [new file with mode: 0644]
t/23_misc.t

index af4e0b4..7edec17 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,6 +7,7 @@ META.yml
 lib/DBM/Deep.pm
 lib/DBM/Deep/Array.pm
 lib/DBM/Deep/Hash.pm
+lib/DBM/Deep/Engine.pm
 t/01_basic.t
 t/02_hash.t
 t/03_bighash.t
index 3dcbc19..6c08cca 100644 (file)
@@ -80,7 +80,7 @@ our ($DIGEST_FUNC, $HASH_SIZE);
 # Precalculate index and bucket sizes based on values above.
 ##
 #my $HASH_SIZE = 16;
-my ($INDEX_SIZE, $BUCKET_SIZE, $BUCKET_LIST_SIZE);
+our ($INDEX_SIZE, $BUCKET_SIZE, $BUCKET_LIST_SIZE);
 
 set_digest();
 #set_pack();
@@ -182,7 +182,7 @@ sub _init {
         ? $args->{root}
         : DBM::Deep::_::Root->new( $args );
 
-    if (!defined($self->_fh)) { $self->_open(); }
+    if (!defined($self->_fh)) { $self->{engine}->open( $self ); }
 
     return $self;
 }
@@ -203,100 +203,6 @@ sub TIEARRAY {
 #sub DESTROY {
 #}
 
-sub _open {
-       ##
-       # Open a fh to the database, create if nonexistent.
-       # Make sure file signature matches DBM::Deep spec.
-       ##
-    my $self = $_[0]->_get_self;
-
-       if (defined($self->_fh)) { $self->_close(); }
-       
-    eval {
-        local $SIG{'__DIE__'};
-        # Theoretically, adding O_BINARY should remove the need for the binmode
-        # Of course, testing it is going to be ... interesting.
-        my $flags = O_RDWR | O_CREAT | O_BINARY;
-
-        my $fh;
-        sysopen( $fh, $self->_root->{file}, $flags )
-            or $fh = undef;
-        $self->_root->{fh} = $fh;
-    }; if ($@ ) { $self->_throw_error( "Received error: $@\n" ); }
-       if (! defined($self->_fh)) {
-               return $self->_throw_error("Cannot sysopen file: " . $self->_root->{file} . ": $!");
-       }
-
-    my $fh = $self->_fh;
-
-    #XXX Can we remove this by using the right sysopen() flags?
-    # Maybe ... q.v. above
-    binmode $fh; # for win32
-
-    if ($self->_root->{autoflush}) {
-        my $old = select $fh;
-        $|=1;
-        select $old;
-    }
-    
-    seek($fh, 0 + $self->_root->{file_offset}, SEEK_SET);
-
-    my $signature;
-    my $bytes_read = read( $fh, $signature, length(SIG_FILE));
-    
-    ##
-    # File is empty -- write signature and master index
-    ##
-    if (!$bytes_read) {
-        seek($fh, 0 + $self->_root->{file_offset}, SEEK_SET);
-        print( $fh SIG_FILE);
-        $self->_create_tag($self->_base_offset, $self->_type, chr(0) x $INDEX_SIZE);
-
-        my $plain_key = "[base]";
-        print( $fh pack($DATA_LENGTH_PACK, length($plain_key)) . $plain_key );
-
-        # Flush the filehandle
-        my $old_fh = select $fh;
-        my $old_af = $|; $| = 1; $| = $old_af;
-        select $old_fh;
-
-        my @stats = stat($fh);
-        $self->_root->{inode} = $stats[1];
-        $self->_root->{end} = $stats[7];
-
-        return 1;
-    }
-    
-    ##
-    # Check signature was valid
-    ##
-    unless ($signature eq SIG_FILE) {
-        $self->_close();
-        return $self->_throw_error("Signature not found -- file is not a Deep DB");
-    }
-
-       my @stats = stat($fh);
-       $self->_root->{inode} = $stats[1];
-    $self->_root->{end} = $stats[7];
-        
-    ##
-    # Get our type from master index signature
-    ##
-    my $tag = $self->_load_tag($self->_base_offset);
-
-#XXX We probably also want to store the hash algorithm name and not assume anything
-#XXX The cool thing would be to allow a different hashing algorithm at every level
-
-    if (!$tag) {
-       return $self->_throw_error("Corrupted file, no master index record");
-    }
-    if ($self->{type} ne $tag->{signature}) {
-       return $self->_throw_error("File type mismatch");
-    }
-    
-    return 1;
-}
-
 sub _close {
        ##
        # Close database fh
@@ -937,7 +843,7 @@ sub lock {
                        # double-check file inode, in case another process
                        # has optimize()d our file while we were waiting.
                        if ($stats[1] != $self->_root->{inode}) {
-                               $self->_open(); # re-open
+                               $self->{engine}->open($self); # re-open
                                flock($self->_fh, $type); # re-lock
                                $self->_root->{end} = (stat($self->_fh))[7]; # re-end
                        }
@@ -1130,7 +1036,7 @@ sub optimize {
        
        $self->unlock();
        $self->_close();
-       $self->_open();
+       $self->{engine}->open($self);
        
        return 1;
 }
diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm
new file mode 100644 (file)
index 0000000..ff262fc
--- /dev/null
@@ -0,0 +1,103 @@
+package DBM::Deep::Engine;
+
+use strict;
+
+use Fcntl qw( :DEFAULT :flock :seek );
+
+sub open {
+       ##
+       # Open a fh to the database, create if nonexistent.
+       # Make sure file signature matches DBM::Deep spec.
+       ##
+    shift;
+    my $self = shift;
+
+       if (defined($self->_fh)) { $self->_close(); }
+       
+    eval {
+        local $SIG{'__DIE__'};
+        # Theoretically, adding O_BINARY should remove the need for the binmode
+        # Of course, testing it is going to be ... interesting.
+        my $flags = O_RDWR | O_CREAT | O_BINARY;
+
+        my $fh;
+        sysopen( $fh, $self->_root->{file}, $flags )
+            or $fh = undef;
+        $self->_root->{fh} = $fh;
+    }; if ($@ ) { $self->_throw_error( "Received error: $@\n" ); }
+       if (! defined($self->_fh)) {
+               return $self->_throw_error("Cannot sysopen file: " . $self->_root->{file} . ": $!");
+       }
+
+    my $fh = $self->_fh;
+
+    #XXX Can we remove this by using the right sysopen() flags?
+    # Maybe ... q.v. above
+    binmode $fh; # for win32
+
+    if ($self->_root->{autoflush}) {
+        my $old = select $fh;
+        $|=1;
+        select $old;
+    }
+    
+    seek($fh, 0 + $self->_root->{file_offset}, SEEK_SET);
+
+    my $signature;
+    my $bytes_read = read( $fh, $signature, length(DBM::Deep->SIG_FILE));
+    
+    ##
+    # File is empty -- write signature and master index
+    ##
+    if (!$bytes_read) {
+        seek($fh, 0 + $self->_root->{file_offset}, SEEK_SET);
+        print( $fh DBM::Deep->SIG_FILE);
+        $self->_create_tag($self->_base_offset, $self->_type, chr(0) x $DBM::Deep::INDEX_SIZE);
+
+        my $plain_key = "[base]";
+        print( $fh pack($DBM::Deep::DATA_LENGTH_PACK, length($plain_key)) . $plain_key );
+
+        # Flush the filehandle
+        my $old_fh = select $fh;
+        my $old_af = $|; $| = 1; $| = $old_af;
+        select $old_fh;
+
+        my @stats = stat($fh);
+        $self->_root->{inode} = $stats[1];
+        $self->_root->{end} = $stats[7];
+
+        return 1;
+    }
+    
+    ##
+    # Check signature was valid
+    ##
+    unless ($signature eq DBM::Deep->SIG_FILE) {
+        $self->_close();
+        return $self->_throw_error("Signature not found -- file is not a Deep DB");
+    }
+
+       my @stats = stat($fh);
+       $self->_root->{inode} = $stats[1];
+    $self->_root->{end} = $stats[7];
+        
+    ##
+    # Get our type from master index signature
+    ##
+    my $tag = $self->_load_tag($self->_base_offset);
+
+#XXX We probably also want to store the hash algorithm name and not assume anything
+#XXX The cool thing would be to allow a different hashing algorithm at every level
+
+    if (!$tag) {
+       return $self->_throw_error("Corrupted file, no master index record");
+    }
+    if ($self->{type} ne $tag->{signature}) {
+       return $self->_throw_error("File type mismatch");
+    }
+    
+    return 1;
+}
+
+1;
+__END__
index 9a06cf4..4c376e6 100644 (file)
@@ -16,7 +16,8 @@ $db->{key1} = "value1";
 is( $db->{key1}, "value1", "Value set correctly" );
 
 # Testing to verify that the close() will occur if open is called on an open DB.
-$db->_open;
+#XXX WOW is this hacky ...
+$db->_get_self->{engine}->open( $db->_get_self );
 
 is( $db->{key1}, "value1", "Value still set after re-open" );