1package Catalyst::Model::Memcached;
2
3use strict;
4use warnings;
5use 5.0100;
6
7use Moose;
8
9BEGIN { extends 'Catalyst::Model' };
10use Cache::Memcached::Fast;
11
12use version; our $VERSION = qv('0.02');
13
14my $primary_key;
15my $ttl;
16
17sub BUILD {
18	my $self = shift;
19	# Fix namespace
20	$self->{__ns_chunk} = lc ref $self;
21	$self->{__ns_chunk} =~ /.+::([^:]+)$/;
22	$self->{__ns_chunk} = $1 . '.';
23	$self->{__cache} //= Cache::Memcached::Fast->new( $self->{args} );
24	no strict 'refs';
25	$self->{primary_key} = ${(ref $self) . "::primary_key"};
26	die 'Primary key is a must' unless $self->{primary_key};
27	$self->{ttl} = ${(ref $self) . "::ttl"} if ${(ref $self) . "::ttl"};
28	return $self;
29}
30
31#######################################################################
32# Wrapper methods - imitating DBIx schema
33sub search {
34	my ( $self, $hash ) = @_;
35	if ( ref $hash ne 'HASH' || ! $hash->{ $self->{primary_key} } ) {
36		die 'Search needs hash ref with primary_key';
37	}
38	return $self->{__cache}->get( $self->{__ns_chunk} . $hash->{ $self->{primary_key} } );
39}
40
41sub find {
42	my ( $self, $hash ) = @_;
43	if ( ref $hash ne 'HASH' || ! $hash->{ $self->{primary_key} } ) {
44		die 'Find needs hash ref with primary_key';
45	}
46	return $self->{__cache}->get( $self->{__ns_chunk} . $hash->{ $self->{primary_key} } );
47}
48
49sub find_or_new {
50	my ( $self, $hash ) = @_;
51	if ( ref $hash ne 'HASH' || ! $hash->{ $self->{primary_key} } ) {
52		die 'Find_or_new needs hash ref with primary_key';
53	}
54	my $res = $self->find( $hash );
55	unless ( $res ) {
56		$self->create( $hash );
57		$res = $hash;
58	}
59	return $res;
60}
61
62sub create {
63	my ( $self, $hash ) = @_;
64	if ( ref $hash ne 'HASH' || ! $hash->{ $self->{primary_key} } ) {
65		die 'Create needs hash ref';
66	}
67	$self->{__cache}->set( $self->{__ns_chunk} . $hash->{ $self->{primary_key} }, $hash, $self->{ttl} );
68	return $hash;
69}
70
71sub delete {
72	my ( $self, $hash ) = @_;
73	if ( ref $hash ne 'HASH' || ! $hash->{ $self->{primary_key} } ) {
74		die 'Delete needs hash ref';
75	}
76	return $self->{__cache}->delete( $self->{__ns_chunk} . $hash->{ $self->{primary_key} } );
77
78}
79
80#######################################################################
81# internals
82sub set_primary_key {
83	my ( $class, $pk ) = @_;
84	$pk = $pk->[0] if ref $pk eq 'ARRAY';
85	no strict 'refs';
86	${$class."::primary_key"} = $pk;
87	return 1;
88}
89sub set_ttl {
90	my ( $class, $pk ) = @_;
91	$pk = $pk->[0] if ref $pk eq 'ARRAY';
92	no strict 'refs';
93	${$class."::ttl"} = $pk;
94	return 1;
95}
96
97END { }            # module clean-up code
98
991;
100
101__END__
102
103=pod
104
105=head1 NAME
106
107Catalyst::Model::Memcached - Wrapper for memcached imitating Catalyst models
108
109=head1 SYNOPSIS
110
111  package MyCatalyst::Model::Token;
112
113  use Moose;
114  use namespace::autoclean;
115
116  BEGIN { extends 'Catalyst::Model::Memcached' };
117
118  __PACKAGE__->config( args => { servers => [ '127.0.0.1:11211' ], namespace => 'db' } );
119  # Alternatively, this could be specified through config file
120
121  __PACKAGE__->set_primary_key( qw/token/ );
122  __PACKAGE__->set_ttl( 300 );
123
124  sub BUILD {
125    my $self = shift;
126    $self->{__once_initialized_object} = Object->new;
127    return $self;
128  }
129
130  sub create {
131    my ($self, $hash) = @_;
132    $hash->{token} = $self->{__once_initialized_object}->create_id();
133    return $self->SUPER::create($hash)
134  }
135
136  1;
137
138=head1 DESCRIPTION
139
140Simple Model for Catalyst for storing data in memcached
141
142=head1 USAGE
143
144B<Warning> Module requires perl >= 5.10 and Catalyst >= 5.8 !
145
146One subclass of model handle one set of primary_key and ttl params.
147You can think of it as one table in regular DB.
148
149In case you want to use memcached to store different entities through this
150model, you can configure it like this in config file:
151
152  Model:
153    Cached:
154      class: MyApp::Store::Cached
155      config:
156        args:
157          servers:
158            - 127.0.0.1:11211
159          namespace: 'db.'
160        ttl: 86400
161
162Assuming your model class is named MyApp::Model::Cached, your memcached
163server is started on localhost on port 11211.
164With this configuration all classes MyApp::Store::Cached::*
165will be loaded with same memcached configuration and default ttl of 86400.
166
167Primary key could be the same in different classes - to avoid clashes
168keys that are stored in memcached are constructed like
169'global_namespace.last_part_of_module_name.primary_key'.
170
171=head1 METHODS
172
173=over
174
175=item create( hashref )
176
177  $c->model( 'Cached::Token' )->create(
178    { token => 'aaaa', signature => 'abcd' }
179  );
180
181Creates record in memcached with key = C<primary_key>,
182data = C<hashref>, expire = C<ttl>.
183C<hashref> must contains C<primary_key>.
184
185=item search( hashref )
186
187  $c->model( 'Cached::Token' )->search( { token => 'aaaa' } );
188
189Searches data in memcached by C<primary_key> key and returns memcached answer.
190C<hashref> must contains C<primary_key>.
191
192=item find( hashref )
193
194The same as search.
195
196=item find_or_new( hashref )
197
198Calls find, if nothing found - calls create.
199
200=item delete( hashref )
201
202Delete record with C<primary_key>.
203
204=back
205
206=head1 AUTHOR
207
208    Denis Pokataev
209    CPAN ID: CATONE
210    Sponsored by Openstat.com
211    catone@cpan.org
212
213=head1 COPYRIGHT
214
215This program is free software; you can redistribute
216it and/or modify it under the same terms as Perl itself.
217
218The full text of the license can be found in the
219LICENSE file included with this module.
220
221
222=head1 SEE ALSO
223
224L<Catalyst>, L<Cache::Memcached::Fast>, perl(1).
225
226=cut
227
228
229