Revision history for DBM::Deep (ordered by revision number).
+1.0020 Feb 16 22:00:00 2010 EST
+ (This version is compatible with 1.0016)
+ - Fixed t/43_transaction_maximum.t so that it doesn't error out on systems
+ which cannot fork > 255 children at one time.
+ - Improved code coverage
+ - Added t/96_virtual_functions.t which helps describe what actually
+ needs to be overridden in a new plugin.
+
+
1.0019_003 Feb 16 22:00:00 2010 EST
(This is the third developer release for 1.0020.)
(This version is compatible with 1.0016)
use warnings FATAL => 'all';
no warnings 'recursion';
-our $VERSION = q(1.0019_003);
+our $VERSION = q(1.0020);
use Scalar::Util ();
}, $class;
unless ( exists $args->{engine} ) {
- my $class = exists $args->{dbi}
- ? 'DBM::Deep::Engine::DBI'
- : 'DBM::Deep::Engine::File';
+ my $class =
+ exists $args->{dbi} ? 'DBM::Deep::Engine::DBI' :
+ exists $args->{_test} ? 'DBM::Deep::Engine::Test' :
+ 'DBM::Deep::Engine::File' ;
eval "use $class"; die $@ if $@;
$args->{engine} = $class->new({
return $self->_engine->lock_exclusive( $self, @_ );
}
*lock = \&lock_exclusive;
+
sub lock_shared {
my $self = shift->_get_self;
-use Carp qw( cluck ); use Data::Dumper;
-cluck Dumper($self) unless $self->_engine;
+ # cluck() the problem with cached File objects.
+ unless ( $self->_engine ) {
+ require Carp;
+ require Data::Dumper;
+ Carp::cluck( Data::Dumper->Dump( [$self], ['self'] ) );
+ }
return $self->_engine->lock_shared( $self, @_ );
}
return 1;
}
-#sub _copy_node {
-# die "Must be implemented in a child class\n";
-#}
-#
-#sub _repr {
-# die "Must be implemented in a child class\n";
-#}
-
sub export {
my $self = shift->_get_self;
L<Devel::Cover> is used to test the code coverage of the tests. Below is the
L<Devel::Cover> report on this distribution's test suite.
- ------------------------------------------ ------ ------ ------ ------ ------
- File stmt bran cond sub total
- ------------------------------------------ ------ ------ ------ ------ ------
- blib/lib/DBM/Deep.pm 97.2 90.9 83.3 100.0 95.4
- blib/lib/DBM/Deep/Array.pm 100.0 95.7 100.0 100.0 99.0
- blib/lib/DBM/Deep/Engine.pm 95.6 84.7 81.6 98.4 92.5
- blib/lib/DBM/Deep/File.pm 97.2 81.6 66.7 100.0 91.9
- blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0
- Total 96.7 87.5 82.2 99.2 94.1
- ------------------------------------------ ------ ------ ------ ------ ------
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ File stmt bran cond sub pod time total
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
+ blib/lib/DBM/Deep.pm 100.0 90.0 81.8 100.0 100.0 32.4 98.2
+ blib/lib/DBM/Deep/Array.pm 100.0 94.4 100.0 100.0 100.0 5.2 98.8
+ blib/lib/DBM/Deep/Engine.pm 100.0 92.9 100.0 100.0 100.0 7.5 100.0
+ ...ib/DBM/Deep/Engine/DBI.pm 93.3 71.2 100.0 100.0 100.0 1.5 89.0
+ ...b/DBM/Deep/Engine/File.pm 91.8 77.8 88.9 100.0 100.0 4.9 89.9
+ blib/lib/DBM/Deep/Hash.pm 100.0 100.0 100.0 100.0 100.0 3.9 100.0
+ .../lib/DBM/Deep/Iterator.pm 100.0 n/a n/a 100.0 100.0 0.0 100.0
+ .../DBM/Deep/Iterator/DBI.pm 100.0 100.0 n/a 100.0 100.0 1.4 100.0
+ ...DBM/Deep/Iterator/File.pm 92.5 84.6 n/a 100.0 66.7 0.6 90.0
+ ...erator/File/BucketList.pm 100.0 75.0 n/a 100.0 66.7 0.4 93.8
+ ...ep/Iterator/File/Index.pm 100.0 100.0 n/a 100.0 100.0 0.2 100.0
+ blib/lib/DBM/Deep/Null.pm 87.5 n/a n/a 75.0 n/a 0.0 83.3
+ blib/lib/DBM/Deep/Sector.pm 91.7 n/a n/a 83.3 0.0 6.7 74.4
+ ...ib/DBM/Deep/Sector/DBI.pm 96.8 83.3 n/a 100.0 0.0 1.0 89.8
+ ...p/Sector/DBI/Reference.pm 98.9 86.4 100.0 100.0 0.0 2.2 89.2
+ ...Deep/Sector/DBI/Scalar.pm 100.0 100.0 n/a 100.0 0.0 1.1 92.9
+ ...b/DBM/Deep/Sector/File.pm 96.0 87.5 100.0 92.3 25.0 2.2 91.0
+ ...Sector/File/BucketList.pm 98.2 85.7 83.3 100.0 0.0 3.3 89.4
+ .../Deep/Sector/File/Data.pm 100.0 n/a n/a 100.0 0.0 0.1 90.9
+ ...Deep/Sector/File/Index.pm 100.0 80.0 33.3 100.0 0.0 0.8 83.1
+ .../Deep/Sector/File/Null.pm 100.0 100.0 n/a 100.0 0.0 0.0 91.7
+ .../Sector/File/Reference.pm 100.0 90.0 80.0 100.0 0.0 1.4 91.5
+ ...eep/Sector/File/Scalar.pm 98.3 87.5 n/a 100.0 0.0 0.8 91.5
+ blib/lib/DBM/Deep/Storage.pm 100.0 n/a n/a 100.0 100.0 0.0 100.0
+ ...b/DBM/Deep/Storage/DBI.pm 97.3 70.8 n/a 100.0 38.5 6.7 87.0
+ .../DBM/Deep/Storage/File.pm 96.6 77.1 80.0 95.7 100.0 15.8 91.8
+ Total 99.2 84.8 84.7 99.8 63.3 100.0 97.6
+ ---------------------------- ------ ------ ------ ------ ------ ------ ------
=head1 MORE INFORMATION
=cut
+=head1 METHODS
+
=head2 read_value( $obj, $key )
This takes an object that provides _base_offset() and a string. It returns the
# XXX Need to add logic about resetting the iterator if any key in the
# reference has changed
unless ( defined $prev_key ) {
+ eval "use " . $self->iterator_class; die $@ if $@;
$obj->{iterator} = $self->iterator_class->new({
base_offset => $obj->_base_offset,
engine => $self,
sub load_sector { $_[0]->sector_type->load( @_ ) }
-=head2 clear
-
-=cut
-
=head2 clear( $obj )
This takes an object that provides _base_offset() and deletes all its
=cut
+sub clear { die "clear must be implemented in a child class" }
+
=head2 cache / clear_cache
This is the cache of loaded Reference sectors.
sub supports { die "supports must be implemented in a child class" }
-=head2 ACCESSORS
+=head1 ACCESSORS
The following are readonly attributes.
=item * sector_type
+=item * iterator_class
+
=back
=cut
sub storage { $_[0]{storage} }
sub sector_type { die "sector_type must be implemented in a child class" }
+sub iterator_class { die "iterator_class must be implemented in a child class" }
# This code is to make sure we write all the values in the $value to the
# disk and to make sure all changes to $value after the assignment are
return 1;
}
-sub begin_work {
- my $self = shift;
- die "Transactions are not supported by this engine"
- unless $self->supports('transactions');
-
- if ( $self->in_txn ) {
- DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
- }
-
- $self->storage->begin_work;
-
- $self->in_txn( 1 );
-
- return 1;
-}
-
-sub rollback {
- my $self = shift;
- die "Transactions are not supported by this engine"
- unless $self->supports('transactions');
-
- if ( !$self->in_txn ) {
- DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
- }
-
- $self->storage->rollback;
-
- $self->in_txn( 0 );
-
- return 1;
-}
-
-sub commit {
- my $self = shift;
- die "Transactions are not supported by this engine"
- unless $self->supports('transactions');
-
- if ( !$self->in_txn ) {
- DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
- }
-
- $self->storage->commit;
-
- $self->in_txn( 0 );
-
- return 1;
-}
-
-sub in_txn {
- my $self = shift;
- $self->{in_txn} = shift if @_;
- $self->{in_txn};
-}
+#sub begin_work {
+# my $self = shift;
+# die "Transactions are not supported by this engine"
+# unless $self->supports('transactions');
+#
+# if ( $self->in_txn ) {
+# DBM::Deep->_throw_error( "Cannot begin_work within an active transaction" );
+# }
+#
+# $self->storage->begin_work;
+#
+# $self->in_txn( 1 );
+#
+# return 1;
+#}
+#
+#sub rollback {
+# my $self = shift;
+# die "Transactions are not supported by this engine"
+# unless $self->supports('transactions');
+#
+# if ( !$self->in_txn ) {
+# DBM::Deep->_throw_error( "Cannot rollback without an active transaction" );
+# }
+#
+# $self->storage->rollback;
+#
+# $self->in_txn( 0 );
+#
+# return 1;
+#}
+#
+#sub commit {
+# my $self = shift;
+# die "Transactions are not supported by this engine"
+# unless $self->supports('transactions');
+#
+# if ( !$self->in_txn ) {
+# DBM::Deep->_throw_error( "Cannot commit without an active transaction" );
+# }
+#
+# $self->storage->commit;
+#
+# $self->in_txn( 0 );
+#
+# return 1;
+#}
+#
+#sub in_txn {
+# my $self = shift;
+# $self->{in_txn} = shift if @_;
+# $self->{in_txn};
+#}
sub supports {
my $self = shift;
DBM::Deep::Internals
-=head1 DESCRIPTION
+=head1 OUT OF DATE
+
+This document is out-of-date. It describes an intermediate file format used
+during the development from 0.983 to 1.0000. It will be rewritten soon.
-B<NOTE>: This document is out-of-date. It describes an intermediate file
-format used during the development from 0.983 to 1.0000. It will be rewritten
-soon.
+=head1 DESCRIPTION
This is a document describing the internal workings of L<DBM::Deep>. It is
not necessary to read this document if you only intend to be a user. This
use strict;
use warnings FATAL => 'all';
-use DBM::Deep::Iterator::DBI ();
-use DBM::Deep::Iterator::File ();
-
=head1 NAME
DBM::Deep::Iterator
}
sub _init {}
-#sub clone { die "clone must be implemented in a child class" }
+
sub clone {
my $self = shift;
return ref($self)->new({
use DBM::Deep::Sector::DBI::Reference ();
use DBM::Deep::Sector::DBI::Scalar ();
-sub _init {
-}
-
sub free {
my $self = shift;
return $self->{size};
}
-sub free_meth { return '_add_free_blist_sector' }
+sub free_meth { '_add_free_blist_sector' }
sub free {
my $self = shift;
# $self->{dbh}->commit;
}
-sub begin_work {
- my $self = shift;
- $self->{dbh}->begin_work;
-}
-
-sub commit {
- my $self = shift;
- $self->{dbh}->commit;
-}
-
-sub rollback {
- my $self = shift;
- $self->{dbh}->rollback;
-}
+#sub begin_work {
+# my $self = shift;
+# $self->{dbh}->begin_work;
+#}
+#
+#sub commit {
+# my $self = shift;
+# $self->{dbh}->commit;
+#}
+#
+#sub rollback {
+# my $self = shift;
+# $self->{dbh}->rollback;
+#}
sub read_from {
my $self = shift;
This will return the size of the DB. If file_offset is set, this will take that into account.
+B<NOTE>: This function isn't used internally anywhere.
+
=cut
sub size {
use strict;
use warnings FATAL => 'all';
-# Need to have an explicit plan in order for the sub-testing to work right.
-#XXX Figure out how to use subtests for that.
-use Test::More tests => 14;
+use Test::More;
use Test::Exception;
use t::common qw( new_fh );
+# Need to have an explicit plan in order for the sub-testing to work right.
+#XXX Figure out how to use subtests for that.
+my $pre_fork_tests = 14;
+plan tests => $pre_fork_tests + 2;
+
use_ok( 'DBM::Deep' );
{
} qr/Cannot write to a readonly filehandle/, "Can't write to a read-only filehandle";
ok( !$db->exists( 'foo' ), "foo doesn't exist" );
+ throws_ok {
+ delete $db->{foo};
+ } qr/Cannot write to a readonly filehandle/, "Can't delete from a read-only filehandle";
+
+ throws_ok {
+ %$db = ();
+ } qr/Cannot write to a readonly filehandle/, "Can't clear from a read-only filehandle";
+
SKIP: {
skip( "No inode tests on Win32", 1 )
if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
my ($fh,$filename) = new_fh();
print $fh "#!$^X\n";
- print $fh <<'__END_FH__';
+ print $fh <<"__END_FH__";
use strict;
use Test::More 'no_plan';
Test::More->builder->no_ending(1);
-Test::More->builder->{Curr_Test} = 12;
+Test::More->builder->{Curr_Test} = $pre_fork_tests;
use_ok( 'DBM::Deep' );
-my $db = DBM::Deep->new({
+my \$db = DBM::Deep->new({
fh => *DATA,
});
-is($db->{x}, 'b', "and get at stuff in the database");
+is(\$db->{x}, 'b', "and get at stuff in the database");
__END_FH__
print $fh "__DATA__\n";
close $fh;
use_ok( 'DBM::Deep' );
-my $max_txns = 255;
+my $max_txns = 220;
my $dbm_factory = new_dbm(
num_txns => $max_txns,
--- /dev/null
+#vim: ft=perl
+
+use strict;
+use warnings FATAL => 'all';
+
+use Test::More;
+use Test::Exception;
+
+use lib 't/lib';
+
+use_ok( 'DBM::Deep' );
+
+throws_ok {
+ DBM::Deep->new({ _test => 1 });
+} qr/lock_exclusive must be implemented in a child class/, 'Must define lock_exclusive in Storage';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Storage::Test::lock_exclusive"} = sub { 1 };
+}
+
+throws_ok {
+ DBM::Deep->new({ _test => 1 });
+} qr/setup must be implemented in a child class/, 'Must define setup in Engine';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Engine::Test::setup"} = sub { 1 };
+}
+
+throws_ok {
+ DBM::Deep->new({ _test => 1 });
+} qr/unlock must be implemented in a child class/, 'Must define unlock in Storage';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Storage::Test::unlock"} = sub { 1 };
+}
+
+throws_ok {
+ DBM::Deep->new({ _test => 1 });
+} qr/flush must be implemented in a child class/, 'Must define flush in Storage';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Storage::Test::flush"} = sub { 1 };
+}
+
+my $db;
+lives_ok {
+ $db = DBM::Deep->new({ _test => 1 });
+} "We finally have enough defined to instantiate";
+
+throws_ok {
+ $db->lock_shared;
+} qr/lock_shared must be implemented in a child class/, 'Must define lock_shared in Storage';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Storage::Test::lock_shared"} = sub { 1 };
+}
+
+lives_ok {
+ $db->lock_shared;
+} 'We have lock_shared defined';
+
+# Yes, this is ordered for good reason. Think about it.
+my @methods = (
+ 'begin_work' => [
+ Engine => 'begin_work',
+ ],
+ 'rollback' => [
+ Engine => 'rollback',
+ ],
+ 'commit' => [
+ Engine => 'commit',
+ ],
+ 'supports' => [
+ Engine => 'supports',
+ ],
+ 'store' => [
+ Storage => 'is_writable',
+ Engine => 'write_value',
+ ],
+ 'fetch' => [
+ Engine => 'read_value',
+ ],
+ 'delete' => [
+ Engine => 'delete_key',
+ ],
+ 'exists' => [
+ Engine => 'key_exists',
+ ],
+ # Why is this one's error message bleeding through?
+ 'clear' => [
+ Engine => 'clear',
+ ],
+);
+
+# Add the following:
+# in_txn
+
+# If only I could use natatime(). *sighs*
+while ( @methods ) {
+ my ($entry, $requirements) = splice @methods, 0, 2;
+ if ( $entry eq 'clear' ) {
+ diag "Please ignore the spurious die for clear. I can't figure out how to prevent it"
+ }
+ while ( @$requirements ) {
+ my ($class, $child_method) = splice @$requirements, 0, 2;
+
+ throws_ok {
+ $db->$entry( 1 );
+ } qr/$child_method must be implemented in a child class/,
+ "'$entry' requires '$child_method' to be defined in the '$class'";
+
+ {
+ no strict 'refs';
+ *{"DBM::Deep::${class}::Test::${child_method}"} = sub { 1 };
+ }
+ }
+
+ lives_ok {
+ $db->$entry( 1 );
+ } "Finally have enough for '$entry' to work";
+}
+
+throws_ok {
+ $db->_engine->sector_type;
+} qr/sector_type must be implemented in a child class/, 'Must define sector_type in Storage';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Engine::Test::sector_type"} = sub { 'DBM::Deep::Iterator::Test' };
+}
+
+lives_ok {
+ $db->_engine->sector_type;
+} 'We have sector_type defined';
+
+throws_ok {
+ $db->first_key;
+} qr/iterator_class must be implemented in a child class/, 'Must define iterator_class in Iterator';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Engine::Test::iterator_class"} = sub { 'DBM::Deep::Iterator::Test' };
+}
+
+throws_ok {
+ $db->first_key;
+} qr/reset must be implemented in a child class/, 'Must define reset in Iterator';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Iterator::Test::reset"} = sub { 1 };
+}
+
+throws_ok {
+ $db->first_key;
+} qr/get_next_key must be implemented in a child class/, 'Must define get_next_key in Iterator';
+
+{
+ no strict 'refs';
+ *{"DBM::Deep::Iterator::Test::get_next_key"} = sub { 1 };
+}
+
+lives_ok {
+ $db->first_key;
+} 'Finally have enough for first_key to work.';
+
+done_testing;
--- /dev/null
+package DBM::Deep::Engine::Test;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Engine );
+
+use DBM::Deep::Storage::Test;
+
+sub new {
+ return bless {
+ storage => DBM::Deep::Storage::Test->new,
+ }, shift;
+}
+
+1;
+__END__
--- /dev/null
+package DBM::Deep::Iterator::Test;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Iterator );
+
+1;
+__END__
--- /dev/null
+package DBM::Deep::Storage::Test;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( DBM::Deep::Storage );
+
+sub new {
+ return bless {
+ }, shift;
+}
+
+1;
+__END__
projects / dbsrgits/DBM-Deep.git / commitdiff