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 <jo...@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 <a...@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 <a...@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 <a...@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 <a...@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 _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits