File Coverage

blib/lib/Tie/CHI.pm
Criterion Covered Total %
statement 2 4 50.0
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 4 6 66.6


line stmt bran cond sub pod time code
1             package Tie::CHI;
2             BEGIN {
3 2     2   1359 $Tie::CHI::VERSION = '0.02';
4             }
5 2     2   2283 use CHI;
  0            
  0            
6             use Scalar::Util qw(blessed);
7             use strict;
8             use warnings;
9              
10             sub TIEHASH {
11             my ( $class, $cache ) = @_;
12              
13             if ( ref($cache) eq 'HASH' ) {
14             $cache = CHI->new(%$cache);
15             }
16             elsif ( !( blessed($cache) && $cache->isa('CHI::Driver') ) ) {
17             die "must pass a hash of options or a CHI object";
18             }
19             my $self = bless { _cache => $cache }, $class;
20             return $self;
21             }
22              
23             sub _cache {
24             return $_[0]->{_cache};
25             }
26              
27             sub STORE {
28             my ( $self, $key, $value ) = @_;
29             $self->_cache->set( $key, $value );
30             }
31              
32             sub FETCH {
33             my ( $self, $key ) = @_;
34             return $self->_cache->get($key);
35             }
36              
37             sub FIRSTKEY {
38             my ($self) = @_;
39             $self->{_keys_iterator} = $self->_cache->get_keys_iterator();
40             return $self->{_keys_iterator}->();
41             }
42              
43             sub NEXTKEY {
44             my ($self) = @_;
45             return $self->{_keys_iterator}->();
46             }
47              
48             sub EXISTS {
49             my ( $self, $key ) = @_;
50             return $self->_cache->is_valid($key);
51             }
52              
53             sub DELETE {
54             my ( $self, $key ) = @_;
55             $self->_cache->remove($key);
56             }
57              
58             sub CLEAR {
59             my ($self) = @_;
60             $self->_cache->clear();
61             }
62              
63             sub SCALAR {
64             my ($self) = @_;
65             defined( $self->FIRSTKEY );
66             }
67              
68             1;
69              
70              
71              
72             =pod
73              
74             =head1 NAME
75              
76             Tie::CHI - Tied hash to persistent CHI cache
77              
78             =head1 VERSION
79              
80             version 0.02
81              
82             =head1 SYNOPSIS
83              
84             use Tie::CHI;
85              
86             my %cache;
87              
88             # Pass CHI options to tie
89             #
90             tie %cache, 'Tie::CHI', { driver => 'File', root_dir => '/path/to/root' };
91             tie %cache, 'Tie::CHI',
92             {
93             driver => 'Memcached::libmemcached',
94             namespace => 'homepage',
95             servers => [ "10.0.0.15:11211", "10.0.0.15:11212" ],
96             default_expires_in => '10 min'
97             } );
98              
99             # or pass an existing CHI object
100             #
101             my $chi_object = CHI->new(...);
102             tie %cache, 'Tie::CHI', $chi_object;
103              
104             # Perform cache operations
105             #
106             my $customer = $cache{$name};
107             if ( !defined $customer ) {
108             $customer = get_customer_from_db($name);
109             $cache{$name} = $customer;
110             }
111             delete( $cache{$name} );
112              
113             # Break the binding
114             #
115             untie(%cache);
116              
117             =head1 DESCRIPTION
118              
119             Tie::CHI implements a tied hash connected to a L cache. It can be used
120             with any of CHI's backends (L,
121             L, L, etc.)
122              
123             Usage is one of the following:
124              
125             tie %cache, 'Tie::CHI', $hash_of_chi_options;
126             tie %cache, 'Tie::CHI', $existing_chi_cache;
127              
128             A read/write/delete on the tied hash will result in a C/C/C
129             on the underlying cache. C and C will be supported if the
130             underlying CHI driver supports C.
131              
132             There is no way to specify expiration for an individual C, but you can
133             pass C, C and/or C to the tie to
134             specify default expiration. e.g.
135              
136             tie %cache, 'Tie::CHI', {
137             namespace => 'products',
138             driver => 'DBI',
139             dbh => DBIx::Connector->new(...),
140             expires_in => '4 hours',
141             expires_variance => '0.2'
142             };
143              
144             =head1 SUPPORT AND DOCUMENTATION
145              
146             Questions and feedback are welcome, and should be directed to the perl-cache
147             mailing list:
148              
149             http://groups.google.com/group/perl-cache-discuss
150              
151             Bugs and feature requests will be tracked at RT:
152              
153             http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tie-CHI
154             bug-tie-chi@rt.cpan.org
155              
156             The latest source code can be browsed and fetched at:
157              
158             http://github.com/jonswar/perl-tie-chi/tree/master
159             git clone git://github.com/jonswar/perl-tie-chi.git
160              
161             =head1 SEE ALSO
162              
163             L
164              
165             =head1 AUTHOR
166              
167             Jonathan Swartz
168              
169             =head1 COPYRIGHT AND LICENSE
170              
171             This software is copyright (c) 2011 by Jonathan Swartz.
172              
173             This is free software; you can redistribute it and/or modify it under
174             the same terms as the Perl 5 programming language system itself.
175              
176             =cut
177              
178              
179             __END__