/[A3C]/lib/A3C/Cache.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /lib/A3C/Cache.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 228 - (show annotations)
Fri Jun 27 19:09:13 2008 UTC (15 years, 9 months ago) by dpavlin
File size: 1930 byte(s)
unbless blessed variables before dumping them to JSON
1 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 dir) );
8 use File::Slurp;
9 use JSON::XS;
10 use Carp qw/confess/;
11 use Data::Dump qw/dump/;
12 use Data::Structure::Util qw(unbless);
13 use Clone qw/clone/;
14
15 =head1 NAME
16
17 A3C::Cache
18
19 =head1 DESCRIPTION
20
21 Fast JSON on-disk cache for long running operations
22
23 B<Doesn't expire any file by itself!>
24
25 =head1 METHODS
26
27 =head2 new
28
29 my $cache = A3C::Cache->new({ instance => 'foobar', dir => 'strix' });
30
31 =head2 cache_path
32
33 Generate unique name for specified values
34
35 my $path = $strix->cache_path( $var, ... );
36
37 Variables have to be path-safe (e.g. use C<uri_encode> if needed)
38
39 =cut
40
41 sub cache_path {
42 my $self = shift;
43
44 #warn "# cache_path",dump( @_ );
45
46 my $dir = $self->dir || 'strix';
47
48 my $path = Jifty::Util->absolute_path( "var/$dir" );
49
50 if ( ! -e $path ) {
51 mkdir($path) || warn "can't create $path: $!";
52 }
53
54 #warn "## caller = ",dump( (caller(2))[3] );
55 my $uid = (caller(2))[3] || '';
56 if ( $uid =~ s/^[^:]+::// ) {
57 $uid .= '-';
58 }
59 $uid .= join('-', @_) if @_;
60 $uid .= '.js';
61
62 return $path . '/' . $self->instance . '-' . $uid;
63 }
64
65 our $json = JSON::XS->new;
66 #$json->allow_nonref( 1 );
67
68 =head2 write_cache
69
70 $self->write_cache( $data, $key_var, ... );
71
72 =cut
73
74 sub write_cache {
75 my $self = shift;
76 my $data = shift || confess "no data?";
77 my $path = $self->cache_path( @_ );
78 #warn "# write_cache(",dump( $data )," , $path )";
79 if ( ref($data) ) {
80 my $data2 = clone($data);
81 unbless $data2;
82 $data = $data2;
83 }
84 write_file( $path, $json->encode( $data )) || die "can't save into $path: $!";
85 }
86
87 =head2 read_cache
88
89 my $data = $self->read_cache( 'format-%d', $var ... );
90
91 =cut
92
93 sub read_cache {
94 my $self = shift;
95 my $path = $self->cache_path( @_ );
96 return unless -e $path;
97 #warn "# read_cache( $path )";
98 return $json->decode( read_file( $path ) ) || die "can't read $path: $!";
99 }
100
101 1;

  ViewVC Help
Powered by ViewVC 1.1.26