[libapp-cache-perl] 01/05: Imported Upstream version 0.37
Jonas Genannt
jonas at brachium-system.net
Thu Aug 28 07:13:11 UTC 2014
This is an automated email from the git hooks/post-receive script.
hggh-guest pushed a commit to branch master
in repository libapp-cache-perl.
commit 678e8a6911010a7fb5bb8e09d75a4100d72018d4
Author: Jonas Genannt <jonas at brachium-system.net>
Date: Thu Aug 28 09:01:15 2014 +0200
Imported Upstream version 0.37
---
CHANGES | 37 ++++++
MANIFEST | 10 ++
META.yml | 30 +++++
Makefile.PL | 25 ++++
README | 123 ++++++++++++++++++++
lib/App/Cache.pm | 295 ++++++++++++++++++++++++++++++++++++++++++++++++
t/lib/App/Cache/Test.pm | 134 ++++++++++++++++++++++
t/pod.t | 6 +
t/pod_coverage.t | 6 +
t/simple.t | 18 +++
10 files changed, 684 insertions(+)
diff --git a/CHANGES b/CHANGES
new file mode 100644
index 0000000..9e60e24
--- /dev/null
+++ b/CHANGES
@@ -0,0 +1,37 @@
+CHANGES file for App::Cache:
+
+0.37 Tue Dec 8 20:29:10 GMT 2009
+ - add option to disable the cache (suggested by MSCHWERN)
+
+0.36 Fri Jun 26 16:35:05 BST 2009
+ - allow cache directory to be set by caller (patch by Murray)
+ - delete App::Cache::Test cache dir when done (patch by Murray)
+ - add POD for directory method (patch by Murray)
+ - add "use warnings"
+
+0.35 Wed Sep 10 20:26:08 BST 2008
+ - fixed manifest
+ - added human- and machine-readable license
+
+0.34 Thu Aug 14 11:50:28 CEST 2008
+ - make the tests still pass even if you are offline
+ (patch by Mark Fowler)
+
+0.33 Sat Sep 29 18:00:07 BST 2007
+ - fix the test suite (spotted by Andreas Koenig)
+ - perltidy
+ - use Makefile.PL instead of Build.PL
+
+0.32
+ - minor doc change
+
+0.31 Tue Jul 19 21:40:46 BST 2005
+ - fix one of the tests to now go to www.google.com/ncr
+ (no country redirect)
+
+0.30 Wed Jul 6 01:28:33 BST 2005
+ - fix a silly bug where we wouldn't create the cache directory
+ properly (thanks, dha)
+
+0.29 Tue Jul 5 17:54:10 BST 2005
+ - first release
\ No newline at end of file
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..25a9999
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,10 @@
+CHANGES
+lib/App/Cache.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+t/lib/App/Cache/Test.pm
+t/pod.t
+t/pod_coverage.t
+t/simple.t
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..95101b7
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,30 @@
+--- #YAML:1.0
+name: App-Cache
+version: 0.37
+abstract: Easy application-level caching
+author:
+ - Leon Brocard <acme at astray.com>
+license: perl
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Class::Accessor::Chained::Fast: 0
+ File::Find::Rule: 0
+ File::HomeDir: 0
+ File::stat: 0
+ HTTP::Cookies: 0
+ LWP::UserAgent: 0
+ Path::Class: 0
+ Storable: 0
+ Test::More: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.55_02
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..0dc62f3
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,25 @@
+#!perl
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'App::Cache',
+ 'VERSION_FROM' => 'lib/App/Cache.pm',
+ 'ABSTRACT' => 'Easy application-level caching',
+ 'LICENSE' => 'perl',
+ 'AUTHOR' => 'Leon Brocard <acme at astray.com>',
+ 'PREREQ_PM' => {
+ 'File::Find::Rule' => '0',
+ 'File::HomeDir' => '0',
+ 'Storable' => '0',
+ 'HTTP::Cookies' => '0',
+ 'Test::More' => '0',
+ 'Class::Accessor::Chained::Fast' => '0',
+ 'LWP::UserAgent' => '0',
+ 'Path::Class' => '0',
+ 'File::stat' => '0'
+ }
+);
+
diff --git a/README b/README
new file mode 100644
index 0000000..542d0ee
--- /dev/null
+++ b/README
@@ -0,0 +1,123 @@
+NAME
+ App::Cache - Easy application-level caching
+
+SYNOPSIS
+ # in your class:
+ my $cache = App::Cache->new({ ttl => 60*60 });
+ $cache->delete('test');
+ my $data = $cache->get('test');
+ my $code = $cache->get_code("code", sub { $self->calculate() });
+ my $html = $cache->get_url("http://www.google.com/");
+ $cache->set('test', 'one');
+ $cache->set('test', { foo => 'bar' });
+ my $scratch = $cache->scratch;
+ $cache->clear;
+
+DESCRIPTION
+ The App::Cache module lets an application cache data locally. There are
+ a few times an application would need to cache data: when it is
+ retrieving information from the network or when it has to complete a
+ large calculation.
+
+ For example, the Parse::BACKPAN::Packages module downloads a file off
+ the net and parses it, creating a data structure. Only then can it
+ actually provide any useful information for the programmer.
+ Parse::BACKPAN::Packages uses App::Cache to cache both the file download
+ and data structures, providing much faster use when the data is cached.
+
+ This module stores data in the home directory of the user, in a dot
+ directory. For example, the Parse::BACKPAN::Packages cache is actually
+ stored underneath "~/.parse_backpan_packages/cache/". This is so that
+ permisssions are not a problem - it is a per-user, per-application
+ cache.
+
+METHODS
+ new
+ The constructor creates an App::Cache object. It takes three optional
+ parameters:
+
+ * 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 });
+
+ * 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' });
+
+ * 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' });
+
+ * enabled can be set to 0 for testing, in which case you will always
+ get cache misses:
+
+ my $cache = App::Cache->new({ enabled => 0 });
+
+ clear
+ Clears the cache:
+
+ $cache->clear;
+
+ delete
+ Deletes an entry in the cache:
+
+ $cache->delete('test');
+
+ get
+ Gets an entry from the cache. Returns undef if the entry does not exist
+ or if it has expired:
+
+ my $data = $cache->get('test');
+
+ get_code
+ This is a convenience method. Gets an entry from the cache, but if the
+ entry does not exist, set the entry to the value of the code reference
+ passed:
+
+ my $code = $cache->get_code("code", sub { $self->calculate() });
+
+ get_url
+ This is a convenience method. Gets the content of a URL from the cache,
+ but if the entry does not exist, set the entry to the content of the URL
+ passed:
+
+ my $html = $cache->get_url("http://www.google.com/");
+
+ scratch
+ Returns a directory in the cache that the application may use for
+ scratch files:
+
+ my $scratch = $cache->scratch;
+
+ set
+ Set an entry in the cache. Note that an entry value may be an arbitrary
+ Perl data structure:
+
+ $cache->set('test', 'one');
+ $cache->set('test', { foo => 'bar' });
+
+ directory
+ Returns the full path to the cache directory. Primarily useful for when
+ you are writing tests that use App::Cache and want to clean up after
+ yourself. If you are doing that you may want to explicitly set the
+ 'application' constructor parameter to avoid later cleaning up a cache
+ dir that was already in use.
+
+ my $dir = $cache->directory;
+
+AUTHOR
+ Leon Brocard <acme at astray.com>
+
+COPYRIGHT
+ Copyright (C) 2005-7, Leon Brocard
+
+LICENSE
+ This module is free software; you can redistribute it or modify it under
+ the same terms as Perl itself.
+
diff --git a/lib/App/Cache.pm b/lib/App/Cache.pm
new file mode 100644
index 0000000..ae61cf4
--- /dev/null
+++ b/lib/App/Cache.pm
@@ -0,0 +1,295 @@
+package App::Cache;
+use strict;
+use warnings;
+use File::Find::Rule;
+use File::HomeDir;
+use File::Path qw( mkpath );
+use File::stat;
+use HTTP::Cookies;
+use LWP::UserAgent;
+use Path::Class;
+use Storable qw(nstore retrieve);
+use base qw( Class::Accessor::Chained::Fast );
+__PACKAGE__->mk_accessors(qw( application directory ttl enabled ));
+our $VERSION = '0.37';
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+
+ unless ( $self->application ) {
+ my $caller = (caller)[0];
+ $self->application($caller);
+ }
+
+ unless ( $self->directory ) {
+ my $dir = dir( home(), "." . $self->_clean( $self->application ),
+ "cache" );
+ $self->directory($dir);
+ }
+ my $dir = $self->directory;
+ unless ( -d "$dir" ) {
+ mkpath("$dir")
+ || die "Error mkdiring " . $self->directory . ": $!";
+ }
+
+ unless ( defined $self->enabled ) {
+ $self->enabled(1);
+ }
+
+ return $self;
+}
+
+sub clear {
+ my $self = shift;
+ foreach
+ my $filename ( File::Find::Rule->new->file->in( $self->directory ) )
+ {
+ unlink($filename) || die "Error unlinking $filename: $!";
+ }
+ foreach my $dirname ( sort { length($b) <=> length($a) }
+ File::Find::Rule->new->directory->in( $self->directory ) )
+ {
+ next if $dirname eq $self->directory;
+ rmdir($dirname) || die "Error unlinking $dirname: $!";
+ }
+}
+
+sub delete {
+ my ( $self, $key ) = @_;
+ my $filename = $self->_clean_filename($key);
+ return unless -f $filename;
+ unlink($filename) || die "Error unlinking $filename: $!";
+}
+
+sub get {
+ my ( $self, $key ) = @_;
+ return unless $self->enabled;
+ my $ttl = $self->ttl || 60 * 30; # default ttl of 30 minutes
+ my $filename = $self->_clean_filename($key);
+ return undef unless -f $filename;
+ my $now = time;
+ my $stat = stat($filename) || die "Error stating $filename: $!";
+ my $ctime = $stat->ctime;
+ my $age = $now - $ctime;
+ if ( $age < $ttl ) {
+ my $value = retrieve("$filename")
+ || die "Error reading from $filename: $!";
+ return $value->{value};
+ } else {
+ $self->delete($key);
+ return undef;
+ }
+}
+
+sub get_code {
+ my ( $self, $key, $code ) = @_;
+ my $data = $self->get($key);
+ unless ($data) {
+ $data = $code->();
+ $self->set( $key, $data );
+ }
+ return $data;
+}
+
+sub get_url {
+ my ( $self, $url ) = @_;
+ my $data = $self->get($url);
+ unless ($data) {
+ my $ua = LWP::UserAgent->new;
+ $ua->cookie_jar( HTTP::Cookies->new() );
+ my $response = $ua->get($url);
+ if ( $response->is_success ) {
+ $data = $response->content;
+ } else {
+ die "Error fetching $url: " . $response->status_line;
+ }
+ $self->set( $url, $data );
+ }
+ return $data;
+}
+
+sub scratch {
+ my $self = shift;
+ my $directory = $self->_clean_filename("_scratch");
+ unless ( -d $directory ) {
+ mkdir($directory) || die "Error mkdiring $directory: $!";
+ }
+ return $directory;
+}
+
+sub set {
+ my ( $self, $key, $value ) = @_;
+ return unless $self->enabled;
+ my $filename = $self->_clean_filename($key);
+ nstore( { value => $value }, "$filename" )
+ || die "Error writing to $filename: $!";
+}
+
+sub _clean {
+ my ( $self, $text ) = @_;
+ $text = lc $text;
+ $text =~ s/[^a-z0-9]+/_/g;
+ return $text;
+}
+
+sub _clean_filename {
+ my ( $self, $key ) = @_;
+ $key = $self->_clean($key);
+ my $filename = file( $self->directory, $key );
+ return $filename;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+App::Cache - Easy application-level caching
+
+=head1 SYNOPSIS
+
+ # in your class:
+ my $cache = App::Cache->new({ ttl => 60*60 });
+ $cache->delete('test');
+ my $data = $cache->get('test');
+ my $code = $cache->get_code("code", sub { $self->calculate() });
+ my $html = $cache->get_url("http://www.google.com/");
+ $cache->set('test', 'one');
+ $cache->set('test', { foo => 'bar' });
+ my $scratch = $cache->scratch;
+ $cache->clear;
+
+=head1 DESCRIPTION
+
+The L<App::Cache> module lets an application cache data locally. There
+are a few times an application would need to cache data: when it is
+retrieving information from the network or when it has to complete a
+large calculation.
+
+For example, the L<Parse::BACKPAN::Packages> module downloads a file off
+the net and parses it, creating a data structure. Only then can it
+actually provide any useful information for the programmer.
+L<Parse::BACKPAN::Packages> uses L<App::Cache> to cache both the file
+download and data structures, providing much faster use when the data is
+cached.
+
+This module stores data in the home directory of the user, in a dot
+directory. For example, the L<Parse::BACKPAN::Packages> cache is
+actually stored underneath "~/.parse_backpan_packages/cache/". This is
+so that permisssions are not a problem - it is a per-user,
+per-application cache.
+
+=head1 METHODS
+
+=head2 new
+
+The constructor creates an L<App::Cache> object. It takes three optional
+parameters:
+
+=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' });
+
+=item *
+
+enabled can be set to 0 for testing, in which case you will always get
+cache misses:
+
+ my $cache = App::Cache->new({ enabled => 0 });
+
+=back
+
+=head2 clear
+
+Clears the cache:
+
+ $cache->clear;
+
+=head2 delete
+
+Deletes an entry in the cache:
+
+ $cache->delete('test');
+
+=head2 get
+
+Gets an entry from the cache. Returns undef if the entry does not exist
+or if it has expired:
+
+ my $data = $cache->get('test');
+
+=head2 get_code
+
+This is a convenience method. Gets an entry from the cache, but if the
+entry does not exist, set the entry to the value of the code reference
+passed:
+
+ my $code = $cache->get_code("code", sub { $self->calculate() });
+
+=head2 get_url
+
+This is a convenience method. Gets the content of a URL from the cache,
+but if the entry does not exist, set the entry to the content of the URL
+passed:
+
+ my $html = $cache->get_url("http://www.google.com/");
+
+=head2 scratch
+
+Returns a directory in the cache that the application may use for
+scratch files:
+
+ my $scratch = $cache->scratch;
+
+=head2 set
+
+Set an entry in the cache. Note that an entry value may be an arbitrary
+Perl data structure:
+
+ $cache->set('test', 'one');
+ $cache->set('test', { foo => 'bar' });
+
+=head2 directory
+
+Returns the full path to the cache directory. Primarily useful for when you
+are writing tests that use App::Cache and want to clean up after yourself. If
+you are doing that you may want to explicitly set the 'application' constructor
+parameter to avoid later cleaning up a cache dir that was already in use.
+
+ my $dir = $cache->directory;
+
+=head1 AUTHOR
+
+Leon Brocard <acme at astray.com>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2005-7, Leon Brocard
+
+=head1 LICENSE
+
+This module is free software; you can redistribute it or modify it under
+the same terms as Perl itself.
diff --git a/t/lib/App/Cache/Test.pm b/t/lib/App/Cache/Test.pm
new file mode 100644
index 0000000..edec35a
--- /dev/null
+++ b/t/lib/App/Cache/Test.pm
@@ -0,0 +1,134 @@
+package App::Cache::Test;
+use strict;
+use warnings;
+use App::Cache;
+use Digest::MD5 qw(md5 md5_hex md5_base64);
+use LWP::Simple qw(get);
+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());
+
+sub cleanup {
+ my $self = shift;
+ my $cache = App::Cache->new;
+ rmtree( $cache->directory->parent->stringify );
+ ok( !-d $cache->directory->parent, 'removed cache dir' );
+}
+
+sub file {
+ my $self = shift;
+ my $cache = App::Cache->new;
+ isa_ok( $cache, 'App::Cache' );
+ is( $cache->application, 'App::Cache::Test' );
+ like( $cache->directory, qr/app_cache_test/ );
+
+ $cache->delete('test');
+ my $data = $cache->get('test');
+ is( $data, undef );
+
+ $cache->set( 'test', 'one' );
+ $data = $cache->get('test');
+ is( $data, 'one' );
+
+ $cache->clear;
+ $data = $cache->get('test');
+ is( $data, undef );
+
+ $cache->set( 'test', { foo => 'bar' } );
+ $data = $cache->get('test');
+ is_deeply( $data, { foo => 'bar' } );
+
+ $cache->ttl(1);
+ sleep 2;
+ $data = $cache->get('test');
+ is( $data, undef );
+}
+
+sub code {
+ my $self = shift;
+ my $cache = App::Cache->new( { ttl => 1 } );
+ my $data = $cache->get_code( "code", sub { $self->onetwothree() } );
+ is_deeply( $data, [ 1, 2, 3 ] );
+ $data = $cache->get_code( "code", sub { $self->onetwothree() } );
+ is_deeply( $data, [ 1, 2, 3 ] );
+ sleep 2;
+ $data = $cache->get_code( "code", sub { $self->onetwothree() } );
+ is_deeply( $data, [ 1, 2, 3 ] );
+}
+
+sub onetwothree {
+ my $self = shift;
+ return [ 1, 2, 3 ];
+}
+
+sub url {
+ my $self = shift;
+ my $url = shift;
+
+ my $test_html = get($url);
+SKIP:
+ {
+ skip "Can't access $url", 3
+ unless $test_html && $test_html =~ /Astray.com/;
+ my $cache = App::Cache->new( { ttl => 1 } );
+ my $orig = $cache->get_url($url);
+ like( $orig, qr{Astray.com} );
+ my $html = $cache->get_url($url);
+ is( $html, $orig );
+ sleep 2;
+ $html = $cache->get_url($url);
+ is( $html, $orig );
+ }
+}
+
+sub scratch {
+ my $self = shift;
+ my $cache = App::Cache->new( { ttl => 1 } );
+ my $scratch = $cache->scratch;
+ foreach my $i ( 1 .. 10 ) {
+ my $filename = Path::Class::File->new( $scratch, "$i.dat" );
+ nstore( { i => $i }, "$filename" )
+ || die "Error writing to $filename: $!";
+ }
+ foreach my $i ( 1 .. 10 ) {
+ my $filename = Path::Class::File->new( $scratch, "$i.dat" );
+ is( retrieve("$filename")->{i}, $i );
+ }
+ $cache->clear;
+ foreach my $i ( 1 .. 10 ) {
+ my $filename = Path::Class::File->new( $scratch, "$i.dat" );
+ ok( !-f $filename );
+ }
+}
+
+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' );
+}
+
+sub disabled {
+ my $self = shift;
+ my $cache = App::Cache->new( { enabled => 0 } );
+ $cache->set( 'a', '1' );
+ is( $cache->get('a'), undef, 'disabled does not cache' );
+}
+
+1;
+
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..5c3c791
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD: $@" if $@;
+all_pod_files_ok();
diff --git a/t/pod_coverage.t b/t/pod_coverage.t
new file mode 100644
index 0000000..703f91d
--- /dev/null
+++ b/t/pod_coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
diff --git a/t/simple.t b/t/simple.t
new file mode 100644
index 0000000..39f15c6
--- /dev/null
+++ b/t/simple.t
@@ -0,0 +1,18 @@
+#!perl
+use strict;
+use lib qw(lib t/lib);
+use Test::More tests => 48;
+use File::Spec::Functions qw(rel2abs);
+use_ok('App::Cache');
+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/');
+$cache->disabled;
+$cache->cleanup;
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libapp-cache-perl.git
More information about the Pkg-perl-cvs-commits
mailing list