summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJason Woodward2006-04-11 05:30:12 +0000
committerJason Woodward2006-04-11 05:30:12 +0000
commit94d4d84ee00bfbae01056d7fb25f9a6193b87311 (patch)
treeaf37bd84a1722a9760598c794e06821a5feb3b65
parent2a54be5a02e552a1291d95e905bf58e953b7a71d (diff)
downloadJaos-DBI-94d4d84ee00bfbae01056d7fb25f9a6193b87311.tar.gz
updated caching to use Cache::Memcached
-rw-r--r--Changes2
-rw-r--r--lib/Jaos/DBI.pm72
-rw-r--r--t/cache.t13
3 files changed, 66 insertions, 21 deletions
diff --git a/Changes b/Changes
index bc9ff8a..60ea5cf 100644
--- a/Changes
+++ b/Changes
@@ -3,7 +3,7 @@ Revision history for Perl extension Jaos::DBI
0.3.2
- documentation updates
- added has_a support
- - added caching support
+ - added caching support via Cache::Memcached
0.3.1
- fixed virtual_columns handling
diff --git a/lib/Jaos/DBI.pm b/lib/Jaos/DBI.pm
index 25f83a0..d74b462 100644
--- a/lib/Jaos/DBI.pm
+++ b/lib/Jaos/DBI.pm
@@ -101,6 +101,8 @@ __PACKAGE__->mk_classdata('_manual_update' => 0);
__PACKAGE__->mk_classdata('_is_changed' => 0);
__PACKAGE__->mk_classdata('_has_a');
__PACKAGE__->mk_classdata('_cache');
+__PACKAGE__->mk_classdata('_cache_servers' => ['127.0.0.1:11211']);
+__PACKAGE__->mk_classdata('_compress_threshold' => 10_000);
=head1 METHODS
@@ -896,27 +898,73 @@ sub has_a
=head2 cache
-Enable or disable the use of internal caching.
-
-This should only be enabled full time in single thread/process applications, or during a series of related lookups.
+Enable or disable the use of internal caching using Cache::Memcached.
__PACKAGE__->cache(1);
- # do a series of lookups with lots of object lookups
- __PACKAGE__->cache(0);
=cut
sub cache
{
my $self = shift;
+
if (@_) {
+
$self->_cache(@_);
- $Jaos::DBI::cache = {} unless $_[0];
+
+ if ($_[0]) {
+ eval {
+ require Cache::Memcached;
+ $Jaos::DBI::cache = Cache::Memcached->new({
+ servers => $self->_cache_servers(),
+ compress_threshold => $self->_compress_threshold(),
+ });
+ };
+ if ($@) {
+ carp $@,'...disabling caching';
+ $self->_cache(0);
+ }
+ }
+
}
$self->_cache;
}
+=head2 cache_servers
+
+Specify the caching servers to use (see Cache::Memcached)
+
+ __PACKAGE__->cache_servers( qw/ 127.0.0.1:11211 10.1.1.2:11212 / );
+
+=cut
+
+sub cache_servers
+{
+ my $self = shift;
+ if (@_) {
+ $self->_cache_servers([@_]);
+ }
+ $self->_cache_servers();
+}
+
+=head2 compress_threshold
+
+Specify the caching servers to use (see Cache::Memcached)
+
+ __PACKAGE__->compress_threshold( 10_000 );
+
+=cut
+
+sub compress_threshold
+{
+ my $self = shift;
+ if (@_) {
+ $self->_compress_threshold(@_);
+ }
+ $self->_compress_threshold();
+}
+
sub _add_obj_to_cache
{
my ($self,$obj) = @_;
@@ -926,7 +974,7 @@ sub _add_obj_to_cache
if (my $key = $obj->primary_column) {
if (my $id = $obj->{$key}) {
- $Jaos::DBI::cache->{$class}->{$id} = $obj;
+ $Jaos::DBI::cache->set("$class:$id",$obj);
}
}
@@ -939,8 +987,8 @@ sub _lookup_obj_in_cache
return undef unless $self->_cache;
my $class = ref($self) || $self;
- if ($Jaos::DBI::cache->{$class}) {
- return $Jaos::DBI::cache->{$class}->{$key} || undef;
+ if (my $obj = $Jaos::DBI::cache->get("$class:$key")) {
+ return $obj || undef;
}
return undef;
@@ -952,11 +1000,7 @@ sub _del_obj_from_cache
return unless $self->_cache;
my $class = ref($self) || $self;
- if ($Jaos::DBI::cache->{$class}) {
- if ($Jaos::DBI::cache->{$class}->{$key}) {
- delete $Jaos::DBI::cache->{$class}->{$key}
- }
- }
+ $Jaos::DBI::cache->delete("$class:$key");
}
sub _del_self_from_cache
diff --git a/t/cache.t b/t/cache.t
index 1a52b45..9e7b80d 100644
--- a/t/cache.t
+++ b/t/cache.t
@@ -14,7 +14,11 @@ BEGIN
or plan skip_all =>
"DBD::CSV is needed for this test";
- plan tests => 10;
+ eval { require Cache::Memcached; }
+ or plan skip_all =>
+ "Cache::Memcached is needed for this test";
+
+ plan tests => 7;
unlink('baz_table') if ( -e 'baz_table' );
unlink('bar_table') if ( -e 'bar_table' );
@@ -37,17 +41,14 @@ BEGIN
ok(Bar->cache(1),'setting cache');
ok(4 == Bar->retrieve_all(),'retrieve all objects');
-ok(4 == scalar keys %{$Jaos::DBI::cache->{'Bar'}},'check cache is populated');
+ok(4 == scalar keys %{$Jaos::DBI::cache->get_multi( qw/Bar:1 Bar:2 Bar:3 Bar:4/ )},'check cache is initially populated');
# extract our baz objects into the cache
$_->baz foreach Bar->retrieve_all();
-ok(2 == scalar keys %{$Jaos::DBI::cache},'Count objects cached');
-ok(4 == scalar keys %{$Jaos::DBI::cache->{'Bar'}},'count cached Bar objects');
-ok(4 == scalar keys %{$Jaos::DBI::cache->{'Baz'}},'cached Baz objects');
+ok(8 == scalar keys %{$Jaos::DBI::cache->get_multi( qw/Bar:1 Bar:2 Bar:3 Bar:4 Baz:1 Baz:2 Baz:3 Baz:4/ )},'check cache is populated');
ok(!Bar->cache(0),'unsetting cache');
-ok(0 == scalar keys %{$Jaos::DBI::cache->{'Bar'}},'check cache is not populated');
END
{