File Coverage

blib/lib/CHI/Driver/DBIC.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package CHI::Driver::DBIC;
2              
3 1     1   17250 use 5.008;
  1         2  
  1         40  
4 1     1   4 use strict;
  1         1  
  1         30  
5 1     1   4 use warnings;
  1         4  
  1         29  
6 1     1   507 use Params::Validate qw/:all/;
  1         8862  
  1         178  
7 1     1   244 use Moose;
  0            
  0            
8             extends 'CHI::Driver';
9              
10             =head1 NAME
11              
12             CHI::Driver::DBIC - DBIx::Class Driver for CHI.
13              
14             =head1 VERSION
15              
16             Version 0.002
17              
18             =cut
19              
20             our $VERSION = '0.002';
21              
22             =head1 SYNOPSIS
23              
24             This module allow the CHI caching interface to use a database as a backend
25             via DBIx::Class.
26              
27             It implements the methods which are required by a CHI::Driver: store, fetch,
28             remove and clear. It should not be necessary to access these methods directly.
29              
30             It should be noted that most database supported by DBIx::Class are slower
31             than caches or NoSQL databases.
32              
33             =head2 Example Object Creation
34              
35             $chi = CHI->new(
36             driver => 'DBIC',
37             resultset => $schema->resultset('Mbfl2Session'),
38             expires_on_backend => 1,
39             expires_in => 30
40             ),
41              
42             =head2 Example get and set
43              
44             $val = $chi->get($key);
45              
46             $chi->set( $key, $val );
47              
48             =head2 Example Table Definition (Oracle)
49              
50             SQL> desc mbfl2_sessions
51             Name Null? Type
52             ----------------------------------------- -------- ----------------------------
53             ID NOT NULL VARCHAR2(72)
54             SESSION_DATA BLOB
55             EXPIRES NUMBER
56              
57             =head1 EXPORT
58              
59             Nothing.
60              
61             =head1 METHODS
62              
63             =cut
64              
65             =head2 Attributes
66              
67             =over
68              
69             =item resultset
70              
71             The DBIx::Class ResultSet which will be use to operate on the database table.
72             Internally the calls will be $self->schema->($self->resultset) etc.
73              
74             =item column_map
75              
76             A hash ref with the keys key, data and expires_in. Used to map to the table columns.
77             Defaults to:
78              
79             {
80             key => 'id',
81             data => 'session_data',
82             expires_in => 'timestamp'
83             }
84              
85             =item expiry_calc_in
86              
87             =item expiry_calc_out
88              
89             =back
90              
91             =cut
92              
93             has 'resultset' => ( 'is' => 'ro', 'isa' => 'Object', 'required' => 1 );
94             has 'expiry_calc_in' => (
95             'is' => 'ro',
96             'isa' => 'CodeRef',
97             default => sub {
98             my $self = shift;
99             return sub { my $expiry = shift; $expiry += time(); }
100             },
101             lazy => 1
102             );
103             has 'expiry_calc_out' => (
104             'is' => 'ro',
105             'isa' => 'CodeRef',
106             default => sub {
107             return sub { my ( $self, $expiry ); return $expiry; }
108             },
109             lazy => 1
110             );
111              
112             has 'column_map' => (
113             'is' => 'ro',
114             'isa' => 'HashRef',
115             default => sub {
116             return {
117             key => 'id',
118             data => 'session_data',
119             expires_in => 'expires'
120             };
121             }
122             );
123              
124             has '_rs' => (
125             'is' => 'ro',
126             'isa' => 'Object',
127             'lazy' => 1,
128             'default' => sub { my $self = shift; $self->resultset; }
129             );
130              
131             =head2 store
132              
133             =cut
134              
135             sub store {
136             my ( $self, $key, $data, $expires_in ) = validate_pos( @_, 1, 1, 1, 0 );
137             my $cm = $self->column_map;
138             my $hr = {
139             $cm->{key} => $key,
140             $cm->{data} => $data
141             };
142              
143             $hr->{ $cm->{expires_in} } = $self->expiry_calc_in->($expires_in);
144             $self->_rs->update_or_create($hr);
145             return 1;
146             }
147              
148             =head2 fetch
149              
150             =cut
151              
152             sub fetch {
153             my ( $self, $key ) = validate_pos( @_, 1, 1 );
154              
155             my $id = $self->column_map->{key};
156             my $result = $self->_rs->find( { $id => $key } );
157             return $result->session_data if $result;
158             return;
159             }
160              
161             =head2 remove
162              
163             =cut
164              
165             sub remove {
166             my ( $self, $key ) = validate_pos( @_, 1, 1 );
167             my $result = $self->_rs->find( { $self->column_map->{key} => $key } );
168             $result->delete if $result;
169             return 1;
170             }
171              
172             =head2 clear
173              
174             =cut
175              
176             sub clear {
177             my ($self) = validate_pos( @_, 1 );
178             $self->_rs->search( {} )->delete;
179             return 1;
180             }
181              
182             =head1 AUTHOR
183              
184             Motortrak Ltd, C<< <duncan.garland at motortrak.com> >>
185              
186             =head1 BUGS
187              
188             Please report any bugs or feature requests to C<bug-chi-driver-dbic at rt.cpan.org>, or through
189             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CHI-Driver-DBIC>. I will be notified, and then you'll
190             automatically be notified of progress on your bug as I make changes.
191              
192             =head1 SUPPORT
193              
194             You can find documentation for this module with the perldoc command.
195              
196             perldoc CHI::Driver::DBIC
197              
198              
199             You can also look for information at:
200              
201             =over 4
202              
203             =item * RT: CPAN's request tracker (report bugs here)
204              
205             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CHI-Driver-DBIC>
206              
207             =item * AnnoCPAN: Annotated CPAN documentation
208              
209             L<http://annocpan.org/dist/CHI-Driver-DBIC>
210              
211             =item * CPAN Ratings
212              
213             L<http://cpanratings.perl.org/d/CHI-Driver-DBIC>
214              
215             =item * Search CPAN
216              
217             L<http://search.cpan.org/dist/CHI-Driver-DBIC/>
218              
219             =back
220              
221              
222             =head1 ACKNOWLEDGEMENTS
223              
224              
225             =head1 LICENSE AND COPYRIGHT
226              
227             Copyright 2014 Motortrak Ltd.
228              
229             This program is free software; you can redistribute it and/or modify it
230             under the terms of the the Artistic License (2.0). You may obtain a
231             copy of the full license at:
232              
233             L<http://www.perlfoundation.org/artistic_license_2_0>
234              
235             Any use, modification, and distribution of the Standard or Modified
236             Versions is governed by this Artistic License. By using, modifying or
237             distributing the Package, you accept this license. Do not use, modify,
238             or distribute the Package, if you do not accept this license.
239              
240             If your Modified Version has been derived from a Modified Version made
241             by someone other than you, you are nevertheless required to ensure that
242             your Modified Version complies with the requirements of this license.
243              
244             This license does not grant you the right to use any trademark, service
245             mark, tradename, or logo of the Copyright Holder.
246              
247             This license includes the non-exclusive, worldwide, free-of-charge
248             patent license to make, have made, use, offer to sell, sell, import and
249             otherwise transfer the Package with respect to any patent claims
250             licensable by the Copyright Holder that are necessarily infringed by the
251             Package. If you institute patent litigation (including a cross-claim or
252             counterclaim) against any party alleging that the Package constitutes
253             direct or contributory patent infringement, then this Artistic License
254             to you shall terminate on the date that such litigation is filed.
255              
256             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
257             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
258             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
259             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
260             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
261             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
262             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
263             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
264              
265              
266             =cut
267              
268             __PACKAGE__->meta->make_immutable;
269              
270             1; # End of CHI::Driver::DBIC