From: rkinyon Date: Mon, 10 Mar 2008 06:03:23 +0000 (+0000) Subject: Removed _fh() method from DBM::Deep and refactored appropriately X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6e78585cfdedc2754b455639da5cc877d7f25cab;p=dbsrgits%2FDBM-Deep.git Removed _fh() method from DBM::Deep and refactored appropriately --- diff --git a/Changes b/Changes index d6066b3..e752491 100644 --- a/Changes +++ b/Changes @@ -2,6 +2,11 @@ Revision history for DBM::Deep. 1.0008 Mar 09 20:00:00 2008 EDT - (This version is compatible with 1.0007) + - Internal refactorings to prepare for some optimizations. + - _fh() has been removed. It was marked as private, don't complain. + +1.0008 Mar 09 20:00:00 2008 EDT + - (This version is compatible with 1.0007) - Fixed a number of Win32 issues (Reported by Steven Samelson - thank you!) - Much thanks to Nigel Sandever and David Golden for their help debugging the issues, particularly with DBM::Deep's usage of diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index 36a40a4..1769c90 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -5,12 +5,11 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0008); +our $VERSION = q(1.0009); use Fcntl qw( :flock ); use Digest::MD5 (); -use FileHandle::Fmode (); use Scalar::Util (); use DBM::Deep::Engine; @@ -300,8 +299,9 @@ sub optimize { #XXX Do we have to lock the tempfile? #XXX Should we use tempfile() here instead of a hard-coded name? + my $temp_filename = $self->_storage->{file} . '.tmp'; my $db_temp = DBM::Deep->new( - file => $self->_storage->{file} . '.tmp', + file => $temp_filename, type => $self->_type, # Bring over all the parameters that we need to bring over @@ -318,12 +318,7 @@ sub optimize { ## # Attempt to copy user, group and permissions over to new file ## - my @stats = stat($self->_fh); - my $perms = $stats[2] & 07777; - my $uid = $stats[4]; - my $gid = $stats[5]; - chown( $uid, $gid, $self->_storage->{file} . '.tmp' ); - chmod( $perms, $self->_storage->{file} . '.tmp' ); + $self->_storage->copy_stats( $temp_filename ); # q.v. perlport for more information on this variable if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) { @@ -337,8 +332,8 @@ sub optimize { $self->_storage->close; } - if (!rename $self->_storage->{file} . '.tmp', $self->_storage->{file}) { - unlink $self->_storage->{file} . '.tmp'; + if (!rename $temp_filename, $self->_storage->{file}) { + unlink $temp_filename; $self->unlock(); $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!"); } @@ -442,11 +437,6 @@ sub _staleness { return $self->{staleness}; } -sub _fh { - my $self = $_[0]->_get_self; - return $self->_storage->{fh}; -} - ## # Utility methods ## @@ -468,7 +458,7 @@ sub STORE { my $self = shift->_get_self; my ($key, $value) = @_; - if ( !FileHandle::Fmode::is_W( $self->_fh ) ) { + unless ( $self->_storage->is_writable ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } @@ -520,7 +510,7 @@ sub DELETE { my $self = shift->_get_self; my ($key) = @_; - if ( !FileHandle::Fmode::is_W( $self->_fh ) ) { + unless ( $self->_storage->is_writable ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } @@ -568,7 +558,7 @@ sub CLEAR { ## my $self = shift->_get_self; - if ( !FileHandle::Fmode::is_W( $self->_fh ) ) { + unless ( $self->_storage->is_writable ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); } diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm index e12e7c9..817b3cf 100644 --- a/lib/DBM/Deep/Array.pm +++ b/lib/DBM/Deep/Array.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0008); +our $VERSION = q(1.0009); # This is to allow DBM::Deep::Array to handle negative indices on # its own. Otherwise, Perl would intercept the call to negative diff --git a/lib/DBM/Deep/Engine.pm b/lib/DBM/Deep/Engine.pm index a6d69b6..d2d0f4b 100644 --- a/lib/DBM/Deep/Engine.pm +++ b/lib/DBM/Deep/Engine.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0008); +our $VERSION = q(1.0009); use Scalar::Util (); diff --git a/lib/DBM/Deep/File.pm b/lib/DBM/Deep/File.pm index a37b4a3..042cbaa 100644 --- a/lib/DBM/Deep/File.pm +++ b/lib/DBM/Deep/File.pm @@ -5,9 +5,10 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0008); +our $VERSION = q(1.0009); use Fcntl qw( :DEFAULT :flock :seek ); +use FileHandle::Fmode (); sub new { my $class = shift; @@ -235,5 +236,22 @@ sub flush { return 1; } +sub is_writable { + my $self = shift; + return FileHandle::Fmode::is_W( $self->{fh} ); +} + +sub copy_stats { + my $self = shift; + my ($temp_filename) = @_; + + my @stats = stat( $self->{fh} ); + my $perms = $stats[2] & 07777; + my $uid = $stats[4]; + my $gid = $stats[5]; + chown( $uid, $gid, $temp_filename ); + chmod( $perms, $temp_filename ); +} + 1; __END__ diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index 0ee6fca..d4ae61d 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -5,7 +5,7 @@ use 5.006_000; use strict; use warnings; -our $VERSION = q(1.0008); +our $VERSION = q(1.0009); use base 'DBM::Deep'; diff --git a/t/11_optimize.t b/t/11_optimize.t index 61741bf..5fb6d11 100644 --- a/t/11_optimize.t +++ b/t/11_optimize.t @@ -49,9 +49,9 @@ delete $db->{a}{b}; ## # take byte count readings before, and after optimize ## -my $before = (stat($db->_fh()))[7]; +my $before = (stat($filename))[7]; my $result = $db->optimize(); -my $after = (stat($db->_fh()))[7]; +my $after = (stat($filename))[7]; ok( $result, "optimize succeeded" ); ok( $after < $before, "file size has shrunk" ); # make sure file shrunk diff --git a/t/13_setpack.t b/t/13_setpack.t index 9b468b4..e7ef34b 100644 --- a/t/13_setpack.t +++ b/t/13_setpack.t @@ -18,7 +18,7 @@ my ($default, $small, $medium, $large); ); $db->{key1} = "value1"; $db->{key2} = "value2"; - $default = (stat($db->_fh()))[7]; + $default = (stat($filename))[7]; } { @@ -32,7 +32,7 @@ my ($default, $small, $medium, $large); $db->{key1} = "value1"; $db->{key2} = "value2"; - $medium = (stat($db->_fh()))[7]; + $medium = (stat($filename))[7]; } # This tests the header to verify that the pack_size is really there @@ -59,7 +59,7 @@ my ($default, $small, $medium, $large); $db->{key1} = "value1"; $db->{key2} = "value2"; - $small = (stat($db->_fh()))[7]; + $small = (stat($filename))[7]; } # This tests the header to verify that the pack_size is really there @@ -89,7 +89,7 @@ SKIP: { $db->{key1} = "value1"; $db->{key2} = "value2"; - $large = (stat($db->_fh()))[7]; + $large = (stat($filename))[7]; } # This tests the header to verify that the pack_size is really there diff --git a/t/26_scalar_ref.t b/t/26_scalar_ref.t index d04b439..7f6e3e7 100644 --- a/t/26_scalar_ref.t +++ b/t/26_scalar_ref.t @@ -28,7 +28,7 @@ my $x = 25; 'Storage of code refs not supported'; throws_ok { - $db->{scalarref} = $db->_get_self->_fh; + $db->{scalarref} = $fh; } qr/Storage of references of type 'GLOB' is not supported/, 'Storage of glob refs not supported'; diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t index 6c7abde..53711e6 100644 --- a/t/44_upgrade_db.t +++ b/t/44_upgrade_db.t @@ -16,7 +16,7 @@ BEGIN { } } -plan tests => 232; +plan tests => 252; use t::common qw( new_fh ); use File::Spec; @@ -68,7 +68,7 @@ my @output_versions = ( '0.981', '0.982', '0.983', '0.99_01', '0.99_02', '0.99_03', '0.99_04', '1.00', '1.000', '1.0000', '1.0001', '1.0002', - '1.0003', '1.0004', '1.0005', '1.0006', '1.0007', + '1.0003', '1.0004', '1.0005', '1.0006', '1.0007', '1.0008', '1.0009', ); foreach my $input_filename ( @@ -121,7 +121,7 @@ foreach my $input_filename ( die "$output\n" if $output; my $db; - if ( $v =~ /^1\.000[3-7]/ ) { + if ( $v =~ /^1\.000[3-9]/ ) { push @INC, 'lib'; eval "use DBM::Deep"; $db = DBM::Deep->new( $output_filename ); diff --git a/utils/upgrade_db.pl b/utils/upgrade_db.pl index ac6d97e..3c36b31 100755 --- a/utils/upgrade_db.pl +++ b/utils/upgrade_db.pl @@ -71,7 +71,7 @@ my %db; { my $ver = $opts{version}; - if ( $ver =~ /^1\.000[3-7]/) { + if ( $ver =~ /^1\.000[3-9]/) { $ver = 3; } elsif ( $ver =~ /^1\.000?[0-2]?/) {