From: rkinyon Date: Tue, 28 Feb 2006 19:22:56 +0000 (+0000) Subject: Removed error/clear_error functions X-Git-Tag: 0-99_01~118 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=95967a5ee0a385bc0107632a13233a2be0f36613;p=dbsrgits%2FDBM-Deep.git Removed error/clear_error functions --- diff --git a/Changes b/Changes index 01d9924..21b318e 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for DBM::Deep. +0.99_01 ??? ?? ??;??:?? 2006 Pacific + - Removed error()/clear_error() + 0.98 Feb 28 11:00:00 2006 Pacific - Added in patch by David Cantrell to allow use of DATA filehandle - Fixed bug where attempting to export() a structure that used autobless would die diff --git a/lib/DBM/Deep.pm b/lib/DBM/Deep.pm index b6dc04f..c79fbfd 100644 --- a/lib/DBM/Deep.pm +++ b/lib/DBM/Deep.pm @@ -35,6 +35,8 @@ use Fcntl qw( :DEFAULT :flock :seek ); use Digest::MD5 (); use Scalar::Util (); +use DBM::Deep::Engine; + use vars qw( $VERSION ); $VERSION = q(0.99_01); @@ -163,8 +165,9 @@ sub _init { # These are the defaults to be optionally overridden below my $self = bless { - type => TYPE_HASH, + type => TYPE_HASH, base_offset => length(SIG_FILE), + engine => 'DBM::Deep::Engine', }, $class; foreach my $param ( keys %$self ) { @@ -1207,48 +1210,12 @@ sub _base_offset { return $self->{base_offset}; } -sub error { - ## - # Get last error string, or undef if no error - ## - return $_[0] - ? ( $_[0]->_get_self->{root}->{error} or undef ) - : $@; -} - ## # Utility methods ## sub _throw_error { - ## - # Store error string in self - ## - my $error_text = $_[1]; - - if ( Scalar::Util::blessed $_[0] ) { - my $self = $_[0]->_get_self; - $self->_root->{error} = $error_text; - - unless ($self->_root->{debug}) { - die "DBM::Deep: $error_text\n"; - } - - warn "DBM::Deep: $error_text\n"; - return; - } - else { - die "DBM::Deep: $error_text\n"; - } -} - -sub clear_error { - ## - # Clear error state - ## - my $self = $_[0]->_get_self; - - undef $self->_root->{error}; + die "DBM::Deep: $_[1]\n"; } sub _precalc_sizes { @@ -1323,9 +1290,9 @@ sub STORE { ## # Make sure file is open ## - if (!defined($self->_fh) && !$self->_open()) { - return; - } +# if (!defined($self->_fh) && !$self->_open()) { +# return; +# } unless ( _is_writable( $self->_fh ) ) { $self->_throw_error( 'Cannot write to a readonly filehandle' ); @@ -1393,7 +1360,7 @@ sub FETCH { ## # Make sure file is open ## - if (!defined($self->_fh)) { $self->_open(); } +# if (!defined($self->_fh)) { $self->_open(); } my $md5 = $DIGEST_FUNC->($key); @@ -1435,7 +1402,7 @@ sub DELETE { ## # Make sure file is open ## - if (!defined($self->_fh)) { $self->_open(); } +# if (!defined($self->_fh)) { $self->_open(); } ## # Request exclusive lock for writing @@ -1480,7 +1447,7 @@ sub EXISTS { ## # Make sure file is open ## - if (!defined($self->_fh)) { $self->_open(); } +# if (!defined($self->_fh)) { $self->_open(); } ## # Request shared lock for reading @@ -1516,7 +1483,7 @@ sub CLEAR { ## # Make sure file is open ## - if (!defined($self->_fh)) { $self->_open(); } +# if (!defined($self->_fh)) { $self->_open(); } ## # Request exclusive lock for writing @@ -1934,10 +1901,6 @@ Data going in and out. q.v. adjusting the interal parameters. -=item * error() / clear_error() - -Error handling methods. These are deprecated and will be removed in 1.00. -. =back =head2 HASHES @@ -2309,27 +2272,12 @@ actually numerical index numbers, and are not filtered. =head1 ERROR HANDLING Most DBM::Deep methods return a true value for success, and call die() on -failure. You can wrap calls in an eval block to catch the die. Also, the -actual error message is stored in an internal scalar, which can be fetched by -calling the C method. +failure. You can wrap calls in an eval block to catch the die. my $db = DBM::Deep->new( "foo.db" ); # create hash eval { $db->push("foo"); }; # ILLEGAL -- push is array-only call print $@; # prints error message - print $db->error(); # prints error message - -You can then call C to clear the current error state. - - $db->clear_error(); - -If you set the C option to true when creating your DBM::Deep object, -all errors are considered NON-FATAL, and dumped to STDERR. This should only -be used for debugging purposes and not production work. DBM::Deep expects errors -to be thrown, not propagated back up the stack. - -B: error() and clear_error() are considered deprecated and I be removed -in 1.00. Please don't use them. Instead, wrap all your functions with in eval-blocks. =head1 LARGEFILE SUPPORT diff --git a/lib/DBM/Deep/Hash.pm b/lib/DBM/Deep/Hash.pm index 0c0e909..9dcc7ec 100644 --- a/lib/DBM/Deep/Hash.pm +++ b/lib/DBM/Deep/Hash.pm @@ -66,7 +66,7 @@ sub FIRSTKEY { ## # Make sure file is open ## - if (!defined($self->_fh)) { $self->_open(); } +# if (!defined($self->_fh)) { $self->_open(); } ## # Request shared lock for reading @@ -97,7 +97,7 @@ sub NEXTKEY { ## # Make sure file is open ## - if (!defined($self->_fh)) { $self->_open(); } +# if (!defined($self->_fh)) { $self->_open(); } ## # Request shared lock for reading diff --git a/t/01_basic.t b/t/01_basic.t index a9af6d3..8d3bff0 100644 --- a/t/01_basic.t +++ b/t/01_basic.t @@ -13,8 +13,8 @@ use_ok( 'DBM::Deep' ); ## unlink "t/test.db"; my $db = eval { DBM::Deep->new( "t/test.db" ) }; -if ( DBM::Deep::error( $db ) || !$db ) { - diag "ERROR: " . (DBM::Deep::error($db) || $@ || "UNKNOWN\n"); +if ( $@ ) { + diag "ERROR: $@"; Test::More->builder->BAIL_OUT( "Opening a new file fails" ); } diff --git a/t/02_hash.t b/t/02_hash.t index 67c7c95..6632b80 100644 --- a/t/02_hash.t +++ b/t/02_hash.t @@ -9,9 +9,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # put/get key @@ -95,9 +92,6 @@ is( $db->get("key1"), "value222222222222222222222222", "We set a value before cl ## undef $db; $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} is( $db->get("key1"), "value222222222222222222222222", "The value we set is still there after closure" ); ## diff --git a/t/03_bighash.t b/t/03_bighash.t index 3dacd84..d9092fb 100644 --- a/t/03_bighash.t +++ b/t/03_bighash.t @@ -11,9 +11,6 @@ my $db = DBM::Deep->new( file => "t/test.db", type => DBM::Deep->TYPE_HASH ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # put/get many keys diff --git a/t/04_array.t b/t/04_array.t index 7398265..cdef14e 100644 --- a/t/04_array.t +++ b/t/04_array.t @@ -15,9 +15,6 @@ my $db = DBM::Deep->new( file => "t/test.db", type => DBM::Deep->TYPE_ARRAY ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} TODO: { local $TODO = "How is this test ever supposed to pass?"; diff --git a/t/05_bigarray.t b/t/05_bigarray.t index afca57f..f2999c3 100644 --- a/t/05_bigarray.t +++ b/t/05_bigarray.t @@ -11,9 +11,6 @@ my $db = DBM::Deep->new( file => "t/test.db", type => DBM::Deep->TYPE_ARRAY ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # put/get many keys diff --git a/t/06_error.t b/t/06_error.t index 01297e3..2385710 100644 --- a/t/06_error.t +++ b/t/06_error.t @@ -9,9 +9,6 @@ use Test::Exception; use_ok( 'DBM::Deep' ); ## -# make sure you can clear the error state -## -## # test a corrupted file ## open FH, '>t/test.db'; diff --git a/t/07_locking.t b/t/07_locking.t index b840d45..e2d9df7 100644 --- a/t/07_locking.t +++ b/t/07_locking.t @@ -15,9 +15,6 @@ my $db = DBM::Deep->new( file => "t/test.db", locking => 1, ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # basic put/get diff --git a/t/08_deephash.t b/t/08_deephash.t index 5d1d87f..6e349d8 100644 --- a/t/08_deephash.t +++ b/t/08_deephash.t @@ -14,9 +14,6 @@ unlink "t/test.db"; my $db = DBM::Deep->new( file => "t/test.db", ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # basic deep hash diff --git a/t/09_deeparray.t b/t/09_deeparray.t index 1afe366..7b8dab8 100644 --- a/t/09_deeparray.t +++ b/t/09_deeparray.t @@ -16,9 +16,6 @@ my $db = DBM::Deep->new( file => "t/test.db", type => DBM::Deep->TYPE_ARRAY, ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} $db->[0] = []; my $temp_db = $db->[0]; diff --git a/t/10_largekeys.t b/t/10_largekeys.t index 929ef92..5fe52c5 100644 --- a/t/10_largekeys.t +++ b/t/10_largekeys.t @@ -10,9 +10,6 @@ unlink "t/test.db"; my $db = DBM::Deep->new( file => "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # large keys diff --git a/t/11_optimize.t b/t/11_optimize.t index 9d15a23..cbc5910 100644 --- a/t/11_optimize.t +++ b/t/11_optimize.t @@ -11,9 +11,6 @@ my $db = DBM::Deep->new( file => "t/test.db", autoflush => 1, ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # create some unused space @@ -49,10 +46,6 @@ my $before = (stat($db->_fh()))[7]; my $result = $db->optimize(); my $after = (stat($db->_fh()))[7]; -if ($db->error()) { - die "ERROR: " . $db->error(); -} - ok( $result, "optimize succeeded" ); ok( $after < $before, "file size has shrunk" ); # make sure file shrunk @@ -90,9 +83,6 @@ SKIP: { autoflush => 1, locking => 1 ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } # optimize and exit $db->optimize(); @@ -109,9 +99,6 @@ SKIP: { autoflush => 1, locking => 1 ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } # sleep for 1 second to make sure optimize() is running in the other fork sleep(1); diff --git a/t/12_clone.t b/t/12_clone.t index 8aaf388..10f1d3c 100644 --- a/t/12_clone.t +++ b/t/12_clone.t @@ -10,9 +10,6 @@ unlink "t/test.db"; my $db = DBM::Deep->new( file => "t/test.db", ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} $db->{key1} = "value1"; diff --git a/t/13_setpack.t b/t/13_setpack.t index ab5401e..f442f7b 100644 --- a/t/13_setpack.t +++ b/t/13_setpack.t @@ -11,9 +11,6 @@ my $db = DBM::Deep->new( file => "t/test.db", autoflush => 1 ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} $db->{key1} = "value1"; $db->{key2} = "value2"; my $before = (stat($db->_fh()))[7]; @@ -29,9 +26,6 @@ $db = DBM::Deep->new( file => "t/test.db", autoflush => 1 ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} $db->{key1} = "value1"; $db->{key2} = "value2"; my $after = (stat($db->_fh()))[7]; diff --git a/t/14_filter.t b/t/14_filter.t index aaf5005..f6af52f 100644 --- a/t/14_filter.t +++ b/t/14_filter.t @@ -10,9 +10,6 @@ unlink "t/test.db"; my $db = DBM::Deep->new( file => "t/test.db", ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ok( !$db->set_filter( 'floober', sub {} ), "floober isn't a value filter key" ); diff --git a/t/15_digest.t b/t/15_digest.t index 9fa0817..1f3704e 100644 --- a/t/15_digest.t +++ b/t/15_digest.t @@ -16,9 +16,6 @@ unlink "t/test.db"; my $db = new DBM::Deep( file => "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # Set digest handler diff --git a/t/16_circular.t b/t/16_circular.t index b08cce5..24594dc 100644 --- a/t/16_circular.t +++ b/t/16_circular.t @@ -8,9 +8,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # put/get simple keys diff --git a/t/17_import.t b/t/17_import.t index 5f3e275..34fd75a 100644 --- a/t/17_import.t +++ b/t/17_import.t @@ -8,9 +8,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # Create structure in memory diff --git a/t/18_export.t b/t/18_export.t index 725857b..c76a747 100644 --- a/t/18_export.t +++ b/t/18_export.t @@ -8,9 +8,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # Create structure in DB diff --git a/t/19_crossref.t b/t/19_crossref.t index 56f96de..626873c 100644 --- a/t/19_crossref.t +++ b/t/19_crossref.t @@ -8,15 +8,9 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} unlink "t/test2.db"; my $db2 = DBM::Deep->new( "t/test2.db" ); -if ($db2->error()) { - die "ERROR: " . $db2->error(); -} ## # Create structure in $db diff --git a/t/20_tie.t b/t/20_tie.t index 151e28a..7fff003 100644 --- a/t/20_tie.t +++ b/t/20_tie.t @@ -15,12 +15,7 @@ use_ok( 'DBM::Deep' ); my %hash; my $db = tie %hash, 'DBM::Deep', 't/test.db'; - if ($db->error()) { - print "ERROR: " . $db->error(); - ok(0); - exit(0); - } - else { ok(1, "Tied an hash with an array for params" ); } + ok(1, "Tied an hash with an array for params" ); } { @@ -30,12 +25,7 @@ use_ok( 'DBM::Deep' ); file => 't/test.db', }; - if ($db->error()) { - print "ERROR: " . $db->error(); - ok(0); - exit(0); - } - else { ok(1, "Tied a hash with a hashref for params" ); } + ok(1, "Tied a hash with a hashref for params" ); } { @@ -43,12 +33,7 @@ use_ok( 'DBM::Deep' ); my @array; my $db = tie @array, 'DBM::Deep', 't/test.db'; - if ($db->error()) { - print "ERROR: " . $db->error(); - ok(0); - exit(0); - } - else { ok(1, "Tied an array with an array for params" ); } + ok(1, "Tied an array with an array for params" ); is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" ); } @@ -60,12 +45,7 @@ use_ok( 'DBM::Deep' ); file => 't/test.db', }; - if ($db->error()) { - print "ERROR: " . $db->error(); - ok(0); - exit(0); - } - else { ok(1, "Tied an array with a hashref for params" ); } + ok(1, "Tied an array with a hashref for params" ); is( $db->{type}, DBM::Deep->TYPE_ARRAY, "TIE_ARRAY sets the correct type" ); } diff --git a/t/22_internal_copy.t b/t/22_internal_copy.t index 6c80ba2..000519f 100644 --- a/t/22_internal_copy.t +++ b/t/22_internal_copy.t @@ -8,9 +8,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} ## # Create structure in $db diff --git a/t/23_misc.t b/t/23_misc.t index 9e6944b..9a06cf4 100644 --- a/t/23_misc.t +++ b/t/23_misc.t @@ -11,9 +11,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; my $db = DBM::Deep->new( "t/test.db" ); -if ($db->error()) { - die "ERROR: " . $db->error(); -} $db->{key1} = "value1"; is( $db->{key1}, "value1", "Value set correctly" ); diff --git a/t/24_autobless.t b/t/24_autobless.t index e039b31..f2d4e2b 100644 --- a/t/24_autobless.t +++ b/t/24_autobless.t @@ -17,9 +17,6 @@ unlink 't/test.db'; file => "t/test.db", autobless => 1, ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $obj = bless { a => 1, @@ -47,9 +44,6 @@ unlink 't/test.db'; file => 't/test.db', autobless => 1, ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $obj = $db->{blessed}; isa_ok( $obj, 'Foo' ); @@ -115,9 +109,6 @@ unlink 't/test.db'; my $db = DBM::Deep->new( file => 't/test.db', ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $obj = $db->{blessed}; isa_ok( $obj, 'DBM::Deep' ); @@ -149,9 +140,6 @@ unlink 't/test.db'; file => "t/test2.db", autobless => 1, ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $obj = bless { a => 1, b => [ 1 .. 3 ], @@ -165,9 +153,6 @@ unlink 't/test.db'; file => "t/test2.db", autobless => 1, ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $blessed = $db->{blessed}; isa_ok( $blessed, 'Foo' ); @@ -185,9 +170,6 @@ unlink 't/test.db'; file => "t/test3.db", autobless => 1, ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $obj = bless {}, 'Foo'; diff --git a/t/26_scalar_ref.t b/t/26_scalar_ref.t index 0de6cde..4ba6bea 100644 --- a/t/26_scalar_ref.t +++ b/t/26_scalar_ref.t @@ -7,9 +7,6 @@ use_ok( 'DBM::Deep' ); unlink "t/test.db"; { my $db = DBM::Deep->new( "t/test.db" ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $x = 25; my $y = 30; @@ -27,9 +24,6 @@ unlink "t/test.db"; { my $db = DBM::Deep->new( "t/test.db" ); - if ($db->error()) { - die "ERROR: " . $db->error(); - } my $x = 25; my $y = 30; diff --git a/t/28_DATA.t b/t/28_DATA.t index 7747b30..a80d780 100644 Binary files a/t/28_DATA.t and b/t/28_DATA.t differ