| Class-DBI-Lite documentation | Contained in the Class-DBI-Lite distribution. |
Class::DBI::Lite::CacheManager - Base class for NoSQL cache managers.
You should not use this class directly - use Class::DBI::Lite::CacheManager::Memcached or Class::DBI::Lite::CacheManager::InMemory.
NOTE: "NoSQL" is "Not Only SQL" - not "No SQL".
Many - but not all - database queries can be avoided by using a simple cache system.
The CacheManager extentions for Class::DBI::Lite offer the following features:
Class::DBI::Lite::CacheManager::Memcached and Class::DBI::Lite::CacheManager::InMemory for implementation-specific details.
Copyright John Drago <jdrago_999@yahoo.com>. All rights reserved.
This software is Free software and may be used and redistributed under the same terms as perl itself.
| Class-DBI-Lite documentation | Contained in the Class-DBI-Lite distribution. |
package Class::DBI::Lite::CacheManager; use strict; use warnings 'all'; use Carp 'confess'; use Digest::MD5 'md5_hex'; sub new { my ($class, %args) = @_; my %defaults = ( __PACKAGE__->defaults, $class->defaults ); my %params = ( %defaults, %args, ); foreach my $arg ( keys %defaults ) { confess "Required param '$arg' was not provided" unless defined( $params{$arg} ); }# end foreach() my $s = bless \%args, $class; $s->init(); $s->auto_setup(); return $s; }# end new() sub init { } sub defaults {( do_auto_setup => 1, do_cache_retrieve => 1, do_cache_search => 0, search_options => [ ], class => undef )} sub do_auto_setup { shift->{do_auto_setup} } sub do_cache_retrieve { shift->{do_cache_retrieve} } sub do_cache_search { shift->{do_cache_search} } sub search_options { @{ shift->{search_options} } } sub cache_searches_containing { my ($s, @cols) = @_; my $sig = md5_hex( join ':', sort @cols ); push @{$s->{search_options}}, $sig; }# end cache_searches_containing() sub class { shift->{class} } sub set; sub get; sub delete; sub clear; sub auto_setup { my $s = shift; my $class = $s->class; if( $s->do_cache_retrieve ) { $class->add_trigger( before_retrieve => sub { my ($s, $id) = @_; my $key = $s->get_cache_key( $id ); $class->cache->get( $key ); }); $class->add_trigger( after_retrieve => sub { my $s = shift; $class->cache->set( $s->get_cache_key => $s->as_hashref ); }); }# end if() if( $s->do_cache_search ) { $class->add_trigger( before_search => sub { my ($s, $params) = @_; my $sig = md5_hex(join ':', sort keys %$params); return unless grep { $_ eq $sig } ( $s->cache->search_options ); my $id = md5_hex( join ':', map { "$_=$params->{$_}" } sort keys %$params ); my $key = $s->get_cache_key( $id ); my $cached = $class->cache->get( $key ) or return; my @res = grep { $_ } @{ $cached->{data} }; return unless @res; @res; }); $class->add_trigger( after_search => sub { my ($s, $params, $result_array) = @_; my $sig = md5_hex(join ':', sort keys %$params); return unless grep { $_ eq $sig } ( $s->cache->search_options ); my $id = md5_hex( join ':', map { "$_=$params->{$_}" } sort keys %$params ); my $key = $s->get_cache_key( $id ); my @objects = map { $_->as_hashref } @$result_array; $class->cache->set( $key => { data => \@objects } ); }); }# end if() $class->add_trigger( after_create => sub { my $s = shift; $class->cache->clear(); }); $class->add_trigger( after_update => sub { my $s = shift; $class->cache->clear(); }); $class->add_trigger( after_delete => sub { my $s = shift; $class->cache->clear(); }); }# end auto_setup() 1;# return true: