File Coverage

blib/lib/IO/All/MLDBM.pm
Criterion Covered Total %
statement 9 29 31.0
branch 0 8 0.0
condition n/a
subroutine 3 5 60.0
pod 1 2 50.0
total 13 44 29.5


line stmt bran cond sub pod time code
1 2     2   1340 use strict; use warnings;
  2     2   4  
  2         51  
  2         10  
  2         3  
  2         70  
2             package IO::All::MLDBM;
3              
4 2     2   580 use IO::All::DBM -base;
  2         6  
  2         20  
5              
6             field _serializer => 'Data::Dumper';
7              
8             sub mldbm {
9 0     0 1   my $self = shift;
10 0           bless $self, __PACKAGE__;
11 0           my ($serializer) = grep { /^(Storable|Data::Dumper|FreezeThaw)$/ } @_;
  0            
12 0 0         $self->_serializer($serializer) if defined $serializer;
13 0           my @dbm_list = grep { not /^(Storable|Data::Dumper|FreezeThaw)$/ } @_;
  0            
14 0           $self->_dbm_list([@dbm_list]);
15 0           return $self;
16             }
17              
18             sub tie_dbm {
19 0     0 0   my $self = shift;
20 0           my $filename = $self->name;
21 0           my $dbm_class = $self->_dbm_class;
22 0           my $serializer = $self->_serializer;
23 0           eval "use MLDBM qw($dbm_class $serializer)";
24 0 0         $self->throw("Can't open '$filename' as MLDBM:\n$@") if $@;
25 0           my $hash;
26             my $db = tie %$hash, 'MLDBM', $filename, $self->mode, $self->perms,
27 0 0         @{$self->_dbm_extra}
  0            
28             or $self->throw("Can't open '$filename' as MLDBM file:\n$!");
29 0 0         $self->add_utf8_dbm_filter($db)
30             if $self->_has_utf8;
31 0           $self->tied_file($hash);
32             }
33              
34             1;