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