| 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; |