summaryrefslogtreecommitdiffstats
path: root/lib/Jaos/DBI.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Jaos/DBI.pm')
-rw-r--r--lib/Jaos/DBI.pm72
1 files changed, 58 insertions, 14 deletions
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