/[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

Annotation of /lib/A3C/Cache.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (hide annotations)
Sun Sep 7 21:54:26 2008 UTC (15 years, 6 months ago) by dpavlin
File size: 1948 byte(s)
enable utf8 encoding on saved json files
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 dpavlin 228 use Data::Dump qw/dump/;
12     use Data::Structure::Util qw(unbless);
13     use Clone qw/clone/;
14 dpavlin 219
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 dpavlin 227 my $cache = A3C::Cache->new({ instance => 'foobar', dir => 'strix' });
30 dpavlin 219
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 dpavlin 227 my $dir = $self->dir || 'strix';
47 dpavlin 219
48 dpavlin 227 my $path = Jifty::Util->absolute_path( "var/$dir" );
49    
50 dpavlin 219 if ( ! -e $path ) {
51 dpavlin 228 mkdir($path) || warn "can't create $path: $!";
52 dpavlin 219 }
53    
54     #warn "## caller = ",dump( (caller(2))[3] );
55 dpavlin 228 my $uid = (caller(2))[3] || '';
56     if ( $uid =~ s/^[^:]+::// ) {
57     $uid .= '-';
58     }
59     $uid .= join('-', @_) if @_;
60 dpavlin 219 $uid .= '.js';
61    
62     return $path . '/' . $self->instance . '-' . $uid;
63     }
64    
65 dpavlin 228 our $json = JSON::XS->new;
66 dpavlin 237 $json->utf8( 1 );
67 dpavlin 228 #$json->allow_nonref( 1 );
68    
69 dpavlin 219 =head2 write_cache
70    
71 dpavlin 228 $self->write_cache( $data, $key_var, ... );
72 dpavlin 219
73     =cut
74    
75     sub write_cache {
76     my $self = shift;
77     my $data = shift || confess "no data?";
78     my $path = $self->cache_path( @_ );
79 dpavlin 228 #warn "# write_cache(",dump( $data )," , $path )";
80     if ( ref($data) ) {
81     my $data2 = clone($data);
82     unbless $data2;
83     $data = $data2;
84     }
85     write_file( $path, $json->encode( $data )) || die "can't save into $path: $!";
86 dpavlin 219 }
87    
88     =head2 read_cache
89    
90 dpavlin 228 my $data = $self->read_cache( 'format-%d', $var ... );
91 dpavlin 219
92     =cut
93    
94     sub read_cache {
95     my $self = shift;
96     my $path = $self->cache_path( @_ );
97     return unless -e $path;
98     #warn "# read_cache( $path )";
99 dpavlin 228 return $json->decode( read_file( $path ) ) || die "can't read $path: $!";
100 dpavlin 219 }
101    
102     1;

  ViewVC Help
Powered by ViewVC 1.1.26