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