From 8af3eb2c69040945ece0f90cbc3431f68e67bc1c Mon Sep 17 00:00:00 2001
From: Doug Bell <doug@plainblack.com>
Date: Thu, 29 Apr 2010 11:34:50 -0500
Subject: [PATCH] add CHI cache module

---
 lib/WebGUI/Cache/CHI.pm | 79 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 79 insertions(+)
 create mode 100644 lib/WebGUI/Cache/CHI.pm

diff --git a/lib/WebGUI/Cache/CHI.pm b/lib/WebGUI/Cache/CHI.pm
new file mode 100644
index 000000000..4bee8d0a6
--- /dev/null
+++ b/lib/WebGUI/Cache/CHI.pm
@@ -0,0 +1,79 @@
+package WebGUI::Cache::CHI;
+
+use strict;
+use base 'WebGUI::Cache';
+use CHI;
+
+sub delete {
+    my ( $self ) = @_;
+    return $self->{_chi}->remove( $self->{_key} );
+}
+
+sub deleteChunk {
+    my ( $self, $key ) = @_;
+    $key = $self->parseKey( $key );
+    for my $checkKey ( $self->{_chi}->get_keys ) {
+        if ( $checkKey =~ /^\Q$key/ ) {
+            $self->{_chi}->remove( $checkKey );
+        }
+    }
+}
+
+sub flush {
+    my ( $self ) = @_;
+    $self->{_chi}->purge;
+}
+
+sub get {
+    my ( $self ) = @_;
+    return $self->{_chi}->get( $self->{_key} );
+}
+
+sub new { 
+    my ( $class, $session, $key, $namespace ) = @_;
+    my $namespace ||= $session->config->getFilename;
+    $key    = $class->parseKey( $key );
+
+    # Create CHI object from config
+    my $chi;
+    unless ( $chi = $session->stow->get( "CHI" ) ) {
+        my $cacheConf    = $session->config->get('cache');
+        $cacheConf->{namespace} = $namespace;
+
+        # Default values
+        my $resolveConf = sub {
+            my ($config) = @_;
+            if ( $config->{driver} =~ /DBI/ ) {
+                $config->{ dbh } = $session->db->dbh;
+            }
+            if ( $config->{driver} =~ /File|FastMmap|BerkeleyDB/ ) {
+                $config->{ root_dir } ||= tempdir();
+            }
+        };
+
+        $resolveConf->( $cacheConf );
+        if ( $cacheConf->{l1_cache} ) {
+            $resolveConf->( $cacheConf->{l1_cache} );
+        }
+
+        $chi = CHI->new( %{$cacheConf} );
+        $session->stow->set( "CHI", $chi );
+    }
+
+    return bless { _session => $session, _key => $key, _chi => $chi }, $class;
+}
+
+sub set {
+    my ( $self, $content, $ttl ) = @_;
+    $ttl ||= 60;
+    $self->{_chi}->set( $self->{_key}, $content, $ttl );
+    return;
+}
+
+sub stats {
+    my ( $self ) = @_;
+    return $self->{_chi}->get_size;
+}
+
+
+1;