File Coverage

blib/lib/Object/Attribute/Cached.pm
Criterion Covered Total %
statement 20 20 100.0
branch 2 2 100.0
condition 2 2 100.0
subroutine 5 5 100.0
pod n/a
total 29 29 100.0


line stmt bran cond sub pod time code
1             package Object::Attribute::Cached;
2              
3             our $VERSION = '1.00';
4              
5 1     1   778 use strict;
  1         3  
  1         34  
6 1     1   6 use warnings;
  1         2  
  1         66  
7              
8             =head1 NAME
9              
10             Object::Attribute::Cached - cache complex object attributes
11              
12             =head1 SYNOPSIS
13              
14             use Object::Attribute::Cached
15             attribute1 => sub { shift->some_complex_task },
16             squared => sub { shift->{num} ** 2 },
17             uptosquare => sub { 1 .. shift->squared },
18             squaredsquared => sub { map $_ ** 2, shift->uptosquare };
19              
20             =head1 DESCRIPTION
21              
22             This provides a simple interface to writing simple caching attribute methods.
23              
24             It avoids having to write code like:
25              
26             sub parsed_query {
27             my $self = shift;
28             $self->{_cached_parsed_query} ||= $self->parse_the_query;
29             return $self->{_cached_parsed_query};
30             }
31              
32             Instead you can just declare:
33              
34             use Object::Attribute::Cached
35             parsed_query => sub { shift->parse_the_query };
36              
37              
38             =head1 CAVEATS
39              
40             We try to allow an attribute to be a lists or hash and examine caller()
41             to try to do the right thing. This will work for simple cases, but if
42             you're running into problems, or trying to do something more complex,
43             it's always safer to use references instead.
44              
45             =cut
46              
47             sub import {
48 1     1   17 my ($self, @pairs) = @_;
49 1     1   6 no strict 'refs';
  1         5  
  1         363  
50 1         3 my $caller = caller();
51 1         6 while (my ($method, $code) = splice (@pairs, 0,2)) {
52 4         10 my $cache = "__cache_$method";
53 4         83 *{"$caller\::$method"} = sub {
54 13     13   4933 my $self = shift;
55 13   100     61 $self->{$cache} ||= [ $code->($self, @_) ];
56 13 100       1392 return @{ $self->{$cache} } if wantarray;
  7         113  
57 6         39 return $self->{$cache}->[0];
58 4         15 };
59             };
60             }
61              
62             =head1 AUTHOR
63              
64             Tony Bowden
65              
66             =head1 BUGS and QUERIES
67              
68             Please direct all correspondence regarding this module to:
69             bug-Object-Attribute-Cached@rt.cpan.org
70              
71             =head1 COPYRIGHT AND LICENSE
72              
73             Copyright (C) 2003-2005 Kasei
74              
75             This program is free software; you can redistribute it and/or modify it under
76             the terms of the GNU General Public License; either version 2 of the License,
77             or (at your option) any later version.
78              
79             This program is distributed in the hope that it will be useful, but WITHOUT
80             ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
81             FOR A PARTICULAR PURPOSE.
82              
83             =cut
84              
85             1;
86