From: rkinyon Date: Mon, 6 Mar 2006 14:08:28 +0000 (+0000) Subject: Branched for fixes off of 0.98 X-Git-Tag: 0-99_01~76 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=994ccd8e3cac357677196eb4ad5dad76089626a7;p=dbsrgits%2FDBM-Deep.git Branched for fixes off of 0.98 --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 6aeaed8..8e27817 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -102,14 +102,13 @@ sub _init { # Setup $self and bless into this class. ## my $class = shift; - my $args = shift; + my ($args) = @_; # These are the defaults to be optionally overridden below my $self = bless { type => TYPE_HASH, engine => DBM::Deep::Engine->new, }, $class; - $self->{base_offset} = length( $self->{engine}->SIG_FILE ); foreach my $param ( keys %$self ) { @@ -151,8 +150,8 @@ sub lock { # times before unlock(), then the same number of unlocks() must # be called before the lock is released. ## - my $self = $_[0]->_get_self; - my $type = $_[1]; + my $self = shift->_get_self; + my ($type) = @_; $type = LOCK_EX unless defined $type; if (!defined($self->_fh)) { return; } @@ -189,7 +188,7 @@ sub unlock { # If db locking is set, unlock the db file. See note in lock() # regarding calling lock() multiple times. ## - my $self = $_[0]->_get_self; + my $self = shift->_get_self; if (!defined($self->_fh)) { return; } @@ -262,7 +261,7 @@ sub export { ## # Recursively export into standard Perl hashes and arrays. ## - my $self = $_[0]->_get_self; + my $self = shift->_get_self; my $temp; if ($self->_type eq TYPE_HASH) { $temp = {}; } @@ -282,8 +281,8 @@ sub import { #XXX This use of ref() seems to be ok if (!ref($_[0])) { return; } # Perl calls import() on use -- ignore - my $self = $_[0]->_get_self; - my $struct = $_[1]; + my $self = shift->_get_self; + my ($struct) = @_; #XXX This use of ref() seems to be ok if (!ref($struct)) { @@ -315,7 +314,7 @@ sub optimize { # Rebuild entire database into new file, then move # it back on top of original. ## - my $self = $_[0]->_get_self; + my $self = shift->_get_self; #XXX Need to create a new test for this # if ($self->_root->{links} > 1) { @@ -373,7 +372,7 @@ sub clone { ## # Make copy of object and return ## - my $self = $_[0]->_get_self; + my $self = shift->_get_self; return DBM::Deep->new( type => $self->_type, @@ -394,9 +393,9 @@ sub clone { ## # Setup filter function for storing or fetching the key or value ## - my $self = $_[0]->_get_self; - my $type = lc $_[1]; - my $func = $_[2] ? $_[2] : undef; + my $self = shift->_get_self; + my $type = lc shift; + my $func = shift; if ( $is_legal_filter{$type} ) { $self->_root->{"filter_$type"} = $func; @@ -419,14 +418,6 @@ sub _root { return $self->{root}; } -sub _fh { - ## - # Get access to the raw fh - ## - my $self = $_[0]->_get_self; - return $self->_root->{fh}; -} - sub _type { ## # Get type of current node (TYPE_HASH or TYPE_ARRAY) @@ -443,6 +434,14 @@ sub _base_offset { return $self->{base_offset}; } +sub _fh { + ## + # Get access to the raw fh + ## + my $self = $_[0]->_get_self; + return $self->_root->{fh}; +} + ## # Utility methods ## diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index 7a1a65c..72d0690 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -158,9 +158,12 @@ sub open { seek($fh, 0 + $obj->_root->{file_offset}, SEEK_SET); print( $fh SIG_FILE); + $obj->_root->{end} = length( SIG_FILE ); + + $obj->{base_offset} = $self->_request_space($obj, $self->{index_size}); + $self->create_tag( - $obj, $obj->_base_offset, $obj->_type, - chr(0) x $self->{index_size}, + $obj, $obj->_base_offset, $obj->_type, chr(0) x $self->{index_size}, ); # Flush the filehandle @@ -881,6 +884,22 @@ sub _find_in_buckets { return; } +sub _request_space { + my $self = shift; + my ($obj, $size) = @_; + + my $loc = $obj->_root->{end}; + + return $loc; +} + +sub _release_space { + my $self = shift; + my ($obj, $size, $loc) = @_; + + return; +} + 1; __END__ diff --git a/t/04_array.t b/t/04_array.t index f652ded..7529056 100644 --- a/t/04_array.t +++ b/t/04_array.t @@ -201,5 +201,5 @@ is($returned[0], "middle ABC"); $db->[0] = [ 1 .. 3 ]; $db->[1] = { a => 'foo' }; -is( $db->[0]->length, 3, "Reuse of same space with array successful" ); is( $db->[1]->fetch('a'), 'foo', "Reuse of same space with hash successful" ); +is( $db->[0]->length, 3, "Reuse of same space with array successful" );