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
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;
#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
##
# 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' ) {
$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: $!");
}
return $self->{staleness};
}
-sub _fh {
- my $self = $_[0]->_get_self;
- return $self->_storage->{fh};
-}
-
##
# Utility methods
##
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' );
}
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' );
}
##
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' );
}
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
use strict;
use warnings;
-our $VERSION = q(1.0008);
+our $VERSION = q(1.0009);
use Scalar::Util ();
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;
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__
use strict;
use warnings;
-our $VERSION = q(1.0008);
+our $VERSION = q(1.0009);
use base 'DBM::Deep';
##
# 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
);
$db->{key1} = "value1";
$db->{key2} = "value2";
- $default = (stat($db->_fh()))[7];
+ $default = (stat($filename))[7];
}
{
$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
$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
$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
'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';
}
}
-plan tests => 232;
+plan tests => 252;
use t::common qw( new_fh );
use File::Spec;
'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 (
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 );
{
my $ver = $opts{version};
- if ( $ver =~ /^1\.000[3-7]/) {
+ if ( $ver =~ /^1\.000[3-9]/) {
$ver = 3;
}
elsif ( $ver =~ /^1\.000?[0-2]?/) {
projects / dbsrgits/DBM-Deep.git / commitdiff