File Coverage

blib/lib/IPC/PubSub/Cacheable.pm
Criterion Covered Total %
statement 35 35 100.0
branch n/a
condition 3 6 50.0
subroutine 10 10 100.0
pod 0 2 0.0
total 48 53 90.5


line stmt bran cond sub pod time code
1             package IPC::PubSub::Cacheable;
2 2     2   8 use strict;
  2         3  
  2         52  
3 2     2   8 use warnings;
  2         3  
  2         40  
4 2     2   8 use Scalar::Util qw( refaddr );
  2         3  
  2         474  
5              
6             my %Cache;
7             sub new {
8 4     4 0 11 my $class = shift;
9 4         18 my $self = bless(\@_, $class);
10 4         18 $self->BUILD;
11 4         31 return $self;
12             }
13              
14             sub BUILD {
15 134     134 0 205 my $self = shift;
16 134   66     829 $Cache{ refaddr($self) } ||= do {
17 4         42 require "IPC/PubSub/Cache/$self->[0].pm";
18 4         13 "IPC::PubSub::Cache::$self->[0]"->new(@{$self->[1]});
  4         41  
19             };
20             }
21              
22             sub AUTOLOAD {
23 2     2   8 no strict 'refs';
  2         3  
  2         53  
24 2     2   18 no warnings 'uninitialized';
  2         3  
  2         339  
25              
26 12   33 12   12746 my $meth = (substr(our $AUTOLOAD, rindex($AUTOLOAD, '::') + 2) || $AUTOLOAD);
27             my $code = sub {
28 130     130   180647 my $self = shift;
29 130         409 my $cache = $self->BUILD;
30 130         321 unshift @_, $cache;
31 130         168 goto &{$cache->can($meth)};
  130         1328  
32 12         85 };
33 12         50 *$meth = $code;
34 12         47 goto &$code;
35             }
36              
37             sub DESTROY {
38 4     4   6736 my $self = shift;
39 4         48 delete $Cache{ refaddr($self) };
40             }
41              
42             1;