3 |
use strict; |
use strict; |
4 |
use warnings; |
use warnings; |
5 |
|
|
6 |
use base qw(Jifty::Object Class::Accessor::Fast); |
use base qw(Jifty::Object Class::Accessor::Fast A3C::Cache); |
7 |
__PACKAGE__->mk_accessors( qw(instance uid) ); |
__PACKAGE__->mk_accessors( qw(instance uid) ); |
8 |
|
|
9 |
use DBI; |
use DBI; |
11 |
use Carp qw/confess/; |
use Carp qw/confess/; |
12 |
use Jifty; |
use Jifty; |
13 |
|
|
|
use File::Slurp; |
|
|
use JSON::XS; |
|
14 |
use Carp qw/confess/; |
use Carp qw/confess/; |
15 |
use URI::Escape; |
use URI::Escape; |
16 |
|
|
328 |
|
|
329 |
} |
} |
330 |
|
|
|
=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: $!"; |
|
|
} |
|
|
|
|
331 |
1; |
1; |