lib/A3C/Cache.pm

package A3C::Cache;

use strict;
use warnings;

use base qw(Jifty::Object Class::Accessor::Fast);
__PACKAGE__->mk_accessors( qw(instance) );
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' });

=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 $path = Jifty::Util->absolute_path( 'var/strix' );

        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			__PACKAGE__->mk_accessors( qw(instance) );
8			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			my $cache = A3C::Cache->new({ instance => 'foobar' });
27
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			my $path = Jifty::Util->absolute_path( 'var/strix' );
44
45			if ( ! -e $path ) {
46			mkdir $path \|\| die "can't create $path: $!";
47			}
48
49			#warn "## caller = ",dump( (caller(2))[3] );
50			my $uid = (caller(2))[3];
51			$uid =~ s/^[^:]+:://;
52			$uid .= '-' . join('-', @_) if @_;
53			$uid .= '.js';
54
55			return $path . '/' . $self->instance . '-' . $uid;
56			}
57
58			=head2 write_cache
59
60			write_cache( $data, $key_var, ... );
61
62			=cut
63
64			sub write_cache {
65			my $self = shift;
66			my $data = shift \|\| confess "no data?";
67			my $path = $self->cache_path( @_ );
68			write_file( $path, encode_json( $data )) \|\| die "can't save into $path: $!";
69			}
70
71			=head2 read_cache
72
73			my $data = read_cache( 'format-%d', $var ... );
74
75			=cut
76
77			sub read_cache {
78			my $self = shift;
79			my $path = $self->cache_path( @_ );
80			return unless -e $path;
81			#warn "# read_cache( $path )";
82			return decode_json( read_file( $path ) ) \|\| die "can't read $path: $!";
83			}
84
85			1;