t/23_misc.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More;
   5 use Test::Exception;
   6 use t::common qw( new_fh );
   7
   8 use_ok( 'DBM::Deep' );
   9
  10 {
  11     my ($fh, $filename) = new_fh();
  12     print $fh "Not a DBM::Deep file";
  13
  14     my $old_fh = select $fh;
  15     my $old_af = $|; $| = 1; $| = $old_af;
  16     select $old_fh;
  17
  18     throws_ok {
  19         my $db = DBM::Deep->new( $filename );
  20     } qr/^DBM::Deep: Signature not found -- file is not a Deep DB/, "Only DBM::Deep DB files will be opened";
  21 }
  22
  23 my ($fh, $filename) = new_fh();
  24 my $db = DBM::Deep->new( $filename );
  25
  26 $db->{key1} = "value1";
  27 is( $db->{key1}, "value1", "Value set correctly" );
  28
  29 # Testing to verify that the close() will occur if open is called on an open DB.
  30 #XXX WOW is this hacky ...
  31 $db->_get_self->_engine->storage->open;
  32 is( $db->{key1}, "value1", "Value still set after re-open" );
  33
  34 throws_ok {
  35     my $db = DBM::Deep->new( 't' );
  36 } qr/^DBM::Deep: Cannot sysopen file 't': /, "Can't open a file we aren't allowed to touch";
  37
  38 {
  39     my $db = DBM::Deep->new(
  40         file => $filename,
  41         locking => 1,
  42     );
  43     $db->_get_self->_engine->storage->close( $db->_get_self );
  44     ok( !$db->lock, "Calling lock() on a closed database returns false" );
  45 }
  46
  47 {
  48     my $db = DBM::Deep->new(
  49         file => $filename,
  50         locking => 1,
  51     );
  52     $db->lock;
  53     $db->_get_self->_engine->storage->close( $db->_get_self );
  54     ok( !$db->unlock, "Calling unlock() on a closed database returns false" );
  55 }
  56
  57 done_testing;