From 43bf18aa5c367e5cc0ce168d2e51e7527708e041 Mon Sep 17 00:00:00 2001
From: Murray <murray@minty.org>
Date: Fri, 26 Jun 2009 00:09:58 +0100
Subject: [PATCH] Allow cache directory to be set by caller.
---
lib/App/Cache.pm | 52 ++++++++++++++++++++++++++++++++--------------
t/lib/App/Cache/Test.pm | 19 +++++++++++++++++
t/simple.t | 3 +-
3 files changed, 57 insertions(+), 17 deletions(-)
diff --git a/lib/App/Cache.pm b/lib/App/Cache.pm
index f754149..77bbfcb 100644
--- a/lib/App/Cache.pm
+++ b/lib/App/Cache.pm
@@ -2,6 +2,7 @@ package App::Cache;
use strict;
use File::Find::Rule;
use File::HomeDir;
+use File::Path qw( mkpath );
use File::stat;
use HTTP::Cookies;
use LWP::UserAgent;
@@ -20,16 +21,14 @@ sub new {
$self->application($caller);
}
- my $directory = dir(home(), "." . $self->_clean($self->application), "cache");
- $self->directory($directory);
-
- my $topdirectory = dir(home(), "." . $self->_clean($self->application));
- unless (-d $topdirectory) {
- mkdir($topdirectory) || die "Error mkdiring $topdirectory: $!";
+ unless ($self->directory) {
+ my $dir = dir(home(), "." . $self->_clean($self->application), "cache");
+ $self->directory($dir);
}
-
- unless (-d $directory) {
- mkdir($directory) || die "Error mkdiring $directory: $!";
+ my $dir = $self->directory;
+ unless (-d "$dir") {
+ mkpath("$dir")
+ || die "Error mkdiring " . $self->directory . ": $!";
}
return $self;
@@ -176,14 +175,35 @@ per-application cache.
=head2 new
-The constructor creates an L<App::Cache> object. It takes two optional
-parameters: a ttl parameter which contains the number of seconds in
-which a cache entry expires, and an application parameter which
-signifies the application name. If you are calling new() from a class,
-the application is automagically set to the calling class, so you should
-rarely need to pass it in:
+The constructor creates an L<App::Cache> object. It takes three optional
+parameters:
- my $cache = App::Cache->new({ ttl => 60*60 });
+=over
+
+=item *
+
+ttl contains the number of seconds in which a cache entry expires. The default
+is 30 minutes.
+
+ my $cache = App::Cache->new({ ttl => 30*60 });
+
+=item *
+
+application sets the application name. If you are calling new() from a class,
+the application is automagically set to the calling class, so you should rarely
+need to pass it in:
+
+ my $cache = App::Cache->new({ application => 'Your::Module' });
+
+=item *
+
+directory sets the directory to be used for the cache. Normally this is just
+set for you and will be based on the application name and be created in the
+users home directory. Sometimes for testing, it can be useful to set this.
+
+ my $cache = App::Cache->new({ directory => '/tmp/your/cache/dir' });
+
+=back
=head2 clear
diff --git a/t/lib/App/Cache/Test.pm b/t/lib/App/Cache/Test.pm
index 4bf32f3..ed23d75 100644
--- a/t/lib/App/Cache/Test.pm
+++ b/t/lib/App/Cache/Test.pm
@@ -7,6 +7,8 @@ use Path::Class qw();
use Storable qw(nstore retrieve);
use File::Path qw(rmtree);
use Test::More;
+use File::Temp qw(tempdir);
+use File::Path qw(mkpath rmtree);
use base qw( Class::Accessor::Chained::Fast );
__PACKAGE__->mk_accessors(qw());
@@ -103,5 +105,22 @@ sub scratch {
}
}
+sub dir {
+ my $self = shift;
+ my $tmp_dir = tempdir( CLEANUP => 1 );
+ $self->with_dir($tmp_dir);
+ rmtree( $tmp_dir );
+ ok(!-d $tmp_dir, 'tmp_dir removed successfully');
+ $self->with_dir($tmp_dir);
+}
+
+sub with_dir {
+ my ($self, $dir) = @_;
+ my $cache = App::Cache->new({ directory => $dir });
+ isa_ok( $cache, 'App::Cache' );
+ is( $cache->directory, $dir );
+ ok( -d $dir, 'tmp_dir exists ok' );
+}
+
1;
diff --git a/t/simple.t b/t/simple.t
index 75f0185..577bd35 100644
--- a/t/simple.t
+++ b/t/simple.t
@@ -1,7 +1,7 @@
#!perl
use strict;
use lib qw(lib t/lib);
-use Test::More tests => 40;
+use Test::More tests => 47;
use File::Spec::Functions qw(rel2abs);
use_ok('App::Cache');
use_ok('App::Cache::Test');
@@ -9,6 +9,7 @@ use_ok('App::Cache::Test');
my $cache = App::Cache::Test->new();
$cache->code;
$cache->file;
+$cache->dir;
$cache->scratch;
$cache->url( 'file:/' . rel2abs( $INC{'App/Cache/Test.pm'} ) );
$cache->url('
http://www.astray.com/');
--
1.6.0.4
