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

Diff of /lib/A3C/Cache.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 227 by dpavlin, Fri Jun 27 17:53:30 2008 UTC revision 228 by dpavlin, Fri Jun 27 19:09:13 2008 UTC
# Line 8  __PACKAGE__->mk_accessors( qw(instance d Line 8  __PACKAGE__->mk_accessors( qw(instance d
8  use File::Slurp;  use File::Slurp;
9  use JSON::XS;  use JSON::XS;
10  use Carp qw/confess/;  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  =head1 NAME
16    
# Line 45  sub cache_path { Line 48  sub cache_path {
48          my $path = Jifty::Util->absolute_path( "var/$dir" );          my $path = Jifty::Util->absolute_path( "var/$dir" );
49    
50          if ( ! -e $path ) {          if ( ! -e $path ) {
51                  mkdir $path || die "can't create $path: $!";                  mkdir($path) || warn "can't create $path: $!";
52          }          }
53    
54          #warn "## caller = ",dump( (caller(2))[3] );          #warn "## caller = ",dump( (caller(2))[3] );
55          my $uid = (caller(2))[3];          my $uid = (caller(2))[3] || '';
56          $uid =~ s/^[^:]+:://;          if ( $uid =~ s/^[^:]+::// ) {
57          $uid .= '-' . join('-', @_) if @_;                  $uid .= '-';
58            }
59            $uid .= join('-', @_) if @_;
60          $uid .= '.js';          $uid .= '.js';
61    
62          return $path . '/' . $self->instance . '-' . $uid;          return $path . '/' . $self->instance . '-' . $uid;
63  }  }
64    
65    our $json = JSON::XS->new;
66    #$json->allow_nonref( 1 );
67    
68  =head2 write_cache  =head2 write_cache
69    
70    write_cache( $data, $key_var, ... );    $self->write_cache( $data, $key_var, ... );
71    
72  =cut  =cut
73    
# Line 67  sub write_cache { Line 75  sub write_cache {
75          my $self = shift;          my $self = shift;
76          my $data = shift || confess "no data?";          my $data = shift || confess "no data?";
77          my $path = $self->cache_path( @_ );          my $path = $self->cache_path( @_ );
78          write_file( $path, encode_json( $data )) || die "can't save into $path: $!";          #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  =head2 read_cache
88    
89          my $data = read_cache( 'format-%d', $var ... );          my $data = $self->read_cache( 'format-%d', $var ... );
90    
91  =cut  =cut
92    
# Line 81  sub read_cache { Line 95  sub read_cache {
95          my $path = $self->cache_path( @_ );          my $path = $self->cache_path( @_ );
96          return unless -e $path;          return unless -e $path;
97          #warn "# read_cache( $path )";          #warn "# read_cache( $path )";
98          return decode_json( read_file( $path ) ) || die "can't read $path: $!";          return $json->decode( read_file( $path ) ) || die "can't read $path: $!";
99  }  }
100    
101  1;  1;
Legend:
Removed from v.227  
changed lines
  Added in v.228
  ViewVC Help
Powered by ViewVC 1.1.26