From: rkinyon Date: Wed, 19 Apr 2006 17:00:27 +0000 (+0000) Subject: Cleaned up auditing some more X-Git-Tag: 0-99_01~16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cfd97a7f63c295750c44d5a5be469cf57841b867;p=dbsrgits%2FDBM-Deep.git Cleaned up auditing some more --- diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 13259f7..51e3f95 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -384,14 +384,23 @@ sub _is_writable { sub _find_parent { my $self = shift; - if ( $self->{parent} ) { - my $base = $self->{parent}->_find_parent(); - if ( $self->{parent}->_type eq TYPE_HASH ) { - return $base . "\{$self->{parent_key}\}"; + + my $base = ''; + if ( my $parent = $self->{parent} ) { + my $child = $self; + while ( 1 ) { + $base = ( + $parent->_type eq TYPE_HASH + ? "\{$child->{parent_key}\}" + : "\[$child->{parent_key}\]" + ) . $base; + + $child = $parent; + $parent = $parent->{parent}; + last unless $parent; } - return $base . "\[$self->{parent_key}\]"; } - return '$db->'; + return '$db->' . $base; } sub STORE { @@ -406,7 +415,7 @@ sub STORE { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } - if ( my $afh = $self->_fileobj->{audit_fh} ) { +# if ( my $afh = $self->_fileobj->{audit_fh} ) { if ( defined $orig_key ) { my $lhs = $self->_find_parent; if ( $self->_type eq TYPE_HASH ) { @@ -426,7 +435,12 @@ sub STORE { $rhs = '[]'; } else { - $rhs = "'$value'"; + if ( defined $value ) { + $rhs = "'$value'"; + } + else { + $rhs = "undef"; + } } if ( my $c = Scalar::Util::blessed( $value ) ) { @@ -438,7 +452,7 @@ sub STORE { # print( $afh "$lhs = $rhs; # " . localtime(time) . "\n" ); # flock( $afh, LOCK_UN ); } - } +# } ## # Request exclusive lock for writing diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index a15f871..687cb19 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -48,6 +48,7 @@ sub FETCH { $self->lock( $self->LOCK_SH ); + my $orig_key = $key eq 'length' ? undef : $key; if ( $key =~ /^-?\d+$/ ) { if ( $key < 0 ) { $key += $self->FETCHSIZE; @@ -60,7 +61,7 @@ sub FETCH { $key = pack($self->{engine}{long_pack}, $key); } - my $rv = $self->SUPER::FETCH( $key ); + my $rv = $self->SUPER::FETCH( $key, $orig_key ); $self->unlock;