Skip Menu |
 

This queue is for tickets about the DBIx-Class-Cursor-Cached CPAN distribution.

Report information
The Basics
Id: 102223
Status: resolved
Priority: 0/
Queue: DBIx-Class-Cursor-Cached

People
Owner: Nobody in particular
Requestors: TIMB [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: 1.001003
Fixed in: (no value)

Attachments
0001-Refactor-slightly-to-enable-useful-subclassing.patch



Subject: Refactor slightly to enable useful subclassing [PATCH]
Download (untitled) / with headers
text/plain 333b
During some recent debugging work I found it useful to hack DBIx::Class::Cursor::Cached to track some extra information and emit a stack trace, with that info, on certain cache misses. Rather than hard-code that logic I figured I'd submit a patch that would enable me to do the same thing by subclassing DBIx::Class::Cursor::Cached.
Subject: 0001-Refactor-slightly-to-enable-useful-subclassing.patch
From c424b39b5d1b4ec854b17a86f2065f546233bb28 Mon Sep 17 00:00:00 2001 From: Tim Bunce <tim@tigerlms.com> Date: Fri, 20 Feb 2015 01:28:07 +0000 Subject: [PATCH] Refactor slightly to enable useful subclassing --- lib/DBIx/Class/Cursor/Cached.pm | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/lib/DBIx/Class/Cursor/Cached.pm b/lib/DBIx/Class/Cursor/Cached.pm index 08fc6dd..9a8c64f 100644 --- a/lib/DBIx/Class/Cursor/Cached.pm +++ b/lib/DBIx/Class/Cursor/Cached.pm @@ -64,10 +64,14 @@ sub _build_cache_key { $conn = $connect_info->[0]->(); } } - + + return $class->_build_cache_key_hash([ $ref, $conn->{Name}, $conn->{Username} || '' ]); +} + +sub _build_cache_key_hash { + my ($class, $key_data) = @_; local $Storable::canonical = 1; - return Digest::SHA::sha1_hex(Storable::nfreeze( [ $ref, $conn->{Name}, $conn->{Username} || '' ] )); - + return Digest::SHA::sha1_hex(Storable::nfreeze( $key_data )); } sub _fill_data { @@ -75,12 +79,17 @@ sub _fill_data { my $cache = $self->{cache_object}; my $key = $self->{cache_key}; return $cache->get($key) || do { - my $data = [ $self->{inner}->all ]; + my $data = $self->_fill_data_fetch_all(); $cache->set($key, $data, $self->{cache_for}); $data; }; } +sub _fill_data_fetch_all { + my ($self) = @_; + return [ $self->{inner}->all ]; +} + sub clear_cache { my ($self) = @_; $self->{cache_object}->remove($self->{cache_key}); -- 2.1.2
Thanks. Any idea when the next release might be?


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.