File Coverage

blib/lib/IPC/PubSub/Cache/DBM_Deep.pm
Criterion Covered Total %
statement 47 49 95.9
branch 7 10 70.0
condition 2 5 40.0
subroutine 14 15 93.3
pod 0 9 0.0
total 70 88 79.5


line stmt bran cond sub pod time code
1             package IPC::PubSub::Cache::DBM_Deep;
2 2     2   12 use strict;
  2         4  
  2         76  
3 2     2   10 use warnings;
  2         3  
  2         63  
4 2     2   9 use base 'IPC::PubSub::Cache';
  2         3  
  2         1221  
5 2     2   2280 use Storable qw/ nfreeze thaw /;
  2         7382  
  2         176  
6 2     2   17 use DBM::Deep;
  2         4  
  2         24  
7 2     2   57 use File::Temp qw/ tempfile /;
  2         5  
  2         1236  
8              
9             sub new {
10 2     2 0 4 my $class = shift;
11 2         4 my $file = shift;
12 2 50 33     31 my $mem = DBM::Deep->new(
13             file => ((defined $file and length $file) ? $file : $class->default_config),
14             locking => 1,
15             autoflush => 1,
16             );
17 2         75121 bless(\$mem, $class);
18             }
19              
20             sub default_config {
21 0     0 0 0 my (undef, $filename) = tempfile(UNLINK => 1);
22 0         0 return $filename;
23             }
24              
25             sub fetch {
26 10     10 0 16 my $self = shift;
27 10         63 return map { thaw($$self->get($_)) } @_;
  9         3333  
28             }
29              
30             sub store {
31 11     11 0 28 my ($self, $key, $val, $time, $expiry) = @_;
32 11         78 $$self->put($key => nfreeze([$time, $val]));
33             }
34              
35             sub publisher_indices {
36 28     28 0 62 my ($self, $chan) = @_;
37 28 100       48 return { %{ $$self->get("pubs:$chan") || {} } };
  28         443  
38             }
39              
40             sub add_publisher {
41 7     7 0 21 my ($self, $chan, $pub) = @_;
42 7 100       35 my $pubs = { %{ $$self->get("pubs:$chan") || {} } };
  7         53  
43 7         20088 $pubs->{$pub} = 0;
44 7         194 $$self->put("pubs:$chan", $pubs);
45             }
46              
47             sub remove_publisher {
48 7     7 0 18 my ($self, $chan, $pub) = @_;
49 7 50       14 my $pubs = { %{ $$self->get("pubs:$chan") || {} } };
  7         48  
50 7         34152 delete $pubs->{$pub};
51 7         428 $$self->put("pubs:$chan", $pubs);
52             }
53              
54             sub get_index {
55 2     2 0 8 my ($self, $chan, $pub) = @_;
56 2   50     20 ($$self->get("pubs:$chan") || {})->{$pub};
57             }
58              
59             sub set_index {
60 9     9 0 34 my ($self, $chan, $pub, $idx) = @_;
61 9 50       17 my $pubs = { %{ $$self->get("pubs:$chan") || {} } };
  9         65  
62 9         60795 $pubs->{$pub} = $idx;
63 9         1693 $$self->put("pubs:$chan", $pubs);
64             }
65              
66             1;