lib/A3C/Cache.pm

package A3C::Cache;

use strict;
use warnings;

use base qw(Jifty::Object Class::Accessor::Fast);
__PACKAGE__->mk_accessors( qw(instance dir) );
use File::Slurp;
use JSON::XS;
use Carp qw/confess/;

=head1 NAME

A3C::Cache

=head1 DESCRIPTION

Fast JSON on-disk cache for long running operations

B<Doesn't expire any file by itself!>

=head1 METHODS

=head2 new

  my $cache = A3C::Cache->new({ instance => 'foobar', dir => 'strix' });

=head2 cache_path

Generate unique name for specified values

  my $path = $strix->cache_path( $var, ... );

Variables have to be path-safe (e.g. use C<uri_encode> if needed)

=cut

sub cache_path {
        my $self = shift;

        #warn "# cache_path",dump( @_ );

        my $dir = $self->dir || 'strix';

        my $path = Jifty::Util->absolute_path( "var/$dir" );

        if ( ! -e $path ) {
                mkdir $path || die "can't create $path: $!";
        }

        #warn "## caller = ",dump( (caller(2))[3] );
        my $uid = (caller(2))[3];
        $uid =~ s/^[^:]+:://;
        $uid .= '-' . join('-', @_) if @_;
        $uid .= '.js';

        return $path . '/' . $self->instance . '-' . $uid;
}

=head2 write_cache

  write_cache( $data, $key_var, ... );

=cut

sub write_cache {
        my $self = shift;
        my $data = shift || confess "no data?";
        my $path = $self->cache_path( @_ );
        write_file( $path, encode_json( $data )) || die "can't save into $path: $!";
}

=head2 read_cache

        my $data = read_cache( 'format-%d', $var ... );

=cut

sub read_cache {
        my $self = shift;
        my $path = $self->cache_path( @_ );
        return unless -e $path;
        #warn "# read_cache( $path )";
        return decode_json( read_file( $path ) ) || die "can't read $path: $!";
}

1;
1	dpavlin	219	package A3C::Cache;
2
3			use strict;
4			use warnings;
5
6			use base qw(Jifty::Object Class::Accessor::Fast);
7	dpavlin	227	__PACKAGE__->mk_accessors( qw(instance dir) );
8	dpavlin	219	use File::Slurp;
9			use JSON::XS;
10			use Carp qw/confess/;
11
12			=head1 NAME
13
14			A3C::Cache
15
16			=head1 DESCRIPTION
17
18			Fast JSON on-disk cache for long running operations
19
20			B<Doesn't expire any file by itself!>
21
22			=head1 METHODS
23
24			=head2 new
25
26	dpavlin	227	my $cache = A3C::Cache->new({ instance => 'foobar', dir => 'strix' });
27	dpavlin	219
28			=head2 cache_path
29
30			Generate unique name for specified values
31
32			my $path = $strix->cache_path( $var, ... );
33
34			Variables have to be path-safe (e.g. use C<uri_encode> if needed)
35
36			=cut
37
38			sub cache_path {
39			my $self = shift;
40
41			#warn "# cache_path",dump( @_ );
42
43	dpavlin	227	my $dir = $self->dir \|\| 'strix';
44	dpavlin	219
45	dpavlin	227	my $path = Jifty::Util->absolute_path( "var/$dir" );
46
47	dpavlin	219	if ( ! -e $path ) {
48			mkdir $path \|\| die "can't create $path: $!";
49			}
50
51			#warn "## caller = ",dump( (caller(2))[3] );
52			my $uid = (caller(2))[3];
53			$uid =~ s/^[^:]+:://;
54			$uid .= '-' . join('-', @_) if @_;
55			$uid .= '.js';
56
57			return $path . '/' . $self->instance . '-' . $uid;
58			}
59
60			=head2 write_cache
61
62			write_cache( $data, $key_var, ... );
63
64			=cut
65
66			sub write_cache {
67			my $self = shift;
68			my $data = shift \|\| confess "no data?";
69			my $path = $self->cache_path( @_ );
70			write_file( $path, encode_json( $data )) \|\| die "can't save into $path: $!";
71			}
72
73			=head2 read_cache
74
75			my $data = read_cache( 'format-%d', $var ... );
76
77			=cut
78
79			sub read_cache {
80			my $self = shift;
81			my $path = $self->cache_path( @_ );
82			return unless -e $path;
83			#warn "# read_cache( $path )";
84			return decode_json( read_file( $path ) ) \|\| die "can't read $path: $!";
85			}
86
87			1;