From: rkinyon Date: Mon, 25 Dec 2006 04:18:43 +0000 (+0000) Subject: Removed lava in DBM::Deep::File X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=aee0d0e8c955416f1d7944eb4d512321d72affce;p=dbsrgits%2FDBM-Deep.git Removed lava in DBM::Deep::File --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 60d717e..16a132f 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -120,9 +120,6 @@ sub _init { type => TYPE_HASH, base_offset => undef, - parent => undef, - parent_key => undef, - storage => undef, engine => undef, }, $class; @@ -329,8 +326,6 @@ sub clone { base_offset => $self->_base_offset, storage => $self->_storage, engine => $self->_engine, - parent => $self->{parent}, - parent_key => $self->{parent_key}, ); } @@ -411,34 +406,6 @@ sub _throw_error { die "DBM::Deep: $_[1]\n"; } -sub _find_parent { - my $self = shift; - - my $base = ''; - #XXX This if() is redundant - if ( my $parent = $self->{parent} ) { - my $child = $self; - while ( $parent->{parent} ) { - $base = ( - $parent->_type eq TYPE_HASH - ? "\{q{$child->{parent_key}}\}" - : "\[$child->{parent_key}\]" - ) . $base; - - $child = $parent; - $parent = $parent->{parent}; - } - - if ( $base ) { - $base = "\$db->get( q{$child->{parent_key}} )->" . $base; - } - else { - $base = "\$db->get( q{$child->{parent_key}} )"; - } - } - return $base; -} - sub STORE { ## # Store single hash key/value or array element in database. @@ -451,46 +418,6 @@ sub STORE { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - #XXX The second condition needs to disappear - if ( !( $self->_type eq TYPE_ARRAY && $orig_key eq 'length') ) { - my $rhs; - - my $r = Scalar::Util::reftype( $value ) || ''; - if ( $r eq 'HASH' ) { - $rhs = '{}'; - } - elsif ( $r eq 'ARRAY' ) { - $rhs = '[]'; - } - elsif ( defined $value ) { - $rhs = "'$value'"; - } - else { - $rhs = "undef"; - } - - if ( my $c = Scalar::Util::blessed( $value ) ) { - $rhs = "bless $rhs, '$c'"; - } - - my $lhs = $self->_find_parent; - if ( $lhs ) { - if ( $self->_type eq TYPE_HASH ) { - $lhs .= "->\{q{$orig_key}\}"; - } - else { - $lhs .= "->\[$orig_key\]"; - } - - $lhs .= "=$rhs;"; - } - else { - $lhs = "\$db->put(q{$orig_key},$rhs);"; - } - - $self->_storage->audit($lhs); - } - ## # Request exclusive lock for writing ## @@ -545,16 +472,6 @@ sub DELETE { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - if ( defined $orig_key ) { - my $lhs = $self->_find_parent; - if ( $lhs ) { - $self->_storage->audit( "delete $lhs;" ); - } - else { - $self->_storage->audit( "\$db->delete('$orig_key');" ); - } - } - ## # Request exclusive lock for writing ## @@ -603,19 +520,6 @@ sub CLEAR { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - { - my $lhs = $self->_find_parent; - - if ( $self->_type eq TYPE_HASH ) { - $lhs = '%{' . $lhs . '}'; - } - else { - $lhs = '@{' . $lhs . '}'; - } - - $self->_storage->audit( "$lhs = ();" ); - } - ## # Request exclusive lock for writing ## @@ -799,11 +703,6 @@ needs. If you open it read-only and attempt to write, an exception will be throw open it write-only or append-only, an exception will be thrown immediately as DBM::Deep needs to read from the fh. -=item * audit_file / audit_fh - -These are just like file/fh, except for auditing. Please see L for -more information. - =item * file_offset This is the offset within the file that the DBM::Deep db starts. Most of the time, you will @@ -1501,14 +1400,6 @@ object tree (such as I or even the built-in C or C methods) will result in an infinite loop. This will be fixed in a future release. -=head1 AUDITING - -New in 0.99_01 is the ability to audit your databases actions. By passing in -audit_file (or audit_fh) to the constructor, all actions will be logged to -that file. The format is one that is suitable for eval'ing against the -database to replay the actions. Please see t/33_audit_trail.t for an example -of how to do this. - =head1 TRANSACTIONS New in 0.99_01 is ACID transactions. Every DBM::Deep object is completely diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm index 649f0b9..bbb87f8 100644 --- a/lib/DBM/Deep/File.pm +++ b/lib/DBM/Deep/File.pm @@ -14,8 +14,6 @@ sub new { my ($args) = @_; my $self = bless { - audit_fh => undef, - audit_file => undef, autobless => 1, autoflush => undef, end => 0, @@ -28,13 +26,6 @@ sub new { 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,36 +40,9 @@ 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; @@ -201,9 +165,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; } @@ -269,133 +230,5 @@ sub flush { return 1; } -sub set_transaction_offset { - my $self = shift; - $self->{transaction_offset} = shift; -} - -sub audit { - 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 $@; - } - } - - return 1; -} - 1; __END__ -