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