App-Cache-0.37/0000755000175000017500000000000011307533506011563 5ustar acmeacmeApp-Cache-0.37/META.yml0000644000175000017500000000142411307533506013035 0ustar acmeacme--- #YAML:1.0 name: App-Cache version: 0.37 abstract: Easy application-level caching author: - Leon Brocard 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 App-Cache-0.37/README0000644000175000017500000001003611307533313012437 0ustar acmeacmeNAME 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 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. App-Cache-0.37/Makefile.PL0000644000175000017500000000146711221164162013536 0ustar acmeacme#!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 ', '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' } ); App-Cache-0.37/lib/0000755000175000017500000000000011307533506012331 5ustar acmeacmeApp-Cache-0.37/lib/App/0000755000175000017500000000000011307533443013051 5ustar acmeacmeApp-Cache-0.37/lib/App/Cache.pm0000644000175000017500000001663011307533443014420 0ustar acmeacmepackage 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 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 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 uses L 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 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 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 =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. App-Cache-0.37/CHANGES0000644000175000017500000000202311307533434012553 0ustar acmeacmeCHANGES 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 releaseApp-Cache-0.37/t/0000755000175000017500000000000011307533506012026 5ustar acmeacmeApp-Cache-0.37/t/lib/0000755000175000017500000000000011307533506012574 5ustar acmeacmeApp-Cache-0.37/t/lib/App/0000755000175000017500000000000011307533506013314 5ustar acmeacmeApp-Cache-0.37/t/lib/App/Cache/0000755000175000017500000000000011307533173014317 5ustar acmeacmeApp-Cache-0.37/t/lib/App/Cache/Test.pm0000644000175000017500000000664011307533173015602 0ustar acmeacmepackage 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; App-Cache-0.37/t/pod.t0000644000175000017500000000022011043554643012771 0ustar acmeacme#!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(); App-Cache-0.37/t/pod_coverage.t0000644000175000017500000000025411043554643014653 0ustar acmeacme#!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(); App-Cache-0.37/t/simple.t0000644000175000017500000000061211307533215013500 0ustar acmeacme#!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; App-Cache-0.37/MANIFEST0000644000175000017500000000021711062017263012707 0ustar acmeacmeCHANGES 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