forked from miyagawa/remedie
/
Cache.pm
113 lines (90 loc) · 2.52 KB
/
Cache.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
package Plagger::Cache;
use strict;
use File::Path;
use File::Spec;
use HTTP::Cookies;
use UNIVERSAL::require;
sub new {
my($class, $conf, $name) = @_;
mkdir $conf->{base}, 0700 unless -e $conf->{base} && -d _;
# Cache default configuration
$conf->{class} ||= 'Cache::FileCache';
$conf->{params} ||= {
cache_root => File::Spec->catfile($conf->{base}, 'cache'),
default_expires_in => $conf->{expires} || 'never',
directory_umask => 0077,
};
$conf->{class}->require;
# If class is not loadable, falls back to on memory cache
if ($@) {
Plagger->context->log(error => "Can't load $conf->{class}. Fallbacks to Plagger::Cache::Null");
require Plagger::Cache::Null;
$conf->{class} = 'Plagger::Cache::Null';
}
my $self = bless {
base => $conf->{base},
cache => $conf->{class}->new($conf->{params}),
to_purge => $conf->{expires} ? 1 : 0,
}, $class;
}
sub path_to {
my($self, @path) = @_;
if (@path > 1) {
my @chunk = @path[0..$#path-1];
mkpath(File::Spec->catfile($self->{base}, @chunk), 0, 0700);
}
File::Spec->catfile($self->{base}, @path);
}
sub get {
my $self = shift;
my $value;
if ( $self->{cache}->isa('Cache') ) {
eval { $value = $self->{cache}->thaw(@_) };
if ($@ && $@ =~ /Storable binary/) {
$value = $self->{cache}->get(@_);
}
} else {
$value = $self->{cache}->get(@_);
}
my $hit_miss = defined $value ? "HIT" : "MISS";
Plagger->context->log(debug => "Cache $hit_miss: $_[0]");
$value;
}
sub get_callback {
my $self = shift;
my($key, $callback, $expiry) = @_;
my $data = $self->get($key);
if (defined $data) {
return $data;
}
$data = $callback->();
if (defined $data) {
$self->set($key => $data, $expiry);
}
$data;
}
sub set {
my $self = shift;
my($key, $value, $expiry) = @_;
my $setter = $self->{cache}->isa('Cache') && ref $value ? 'freeze' : 'set';
$self->{cache}->$setter(@_);
}
sub remove {
my $self = shift;
$self->{cache}->remove(@_);
}
sub cookie_jar {
my($self, $ns) = @_;
my $file = $ns ? "$ns.dat" : "global.dat";
my $dir = File::Spec->catfile($self->{base}, 'cookies');
mkdir $dir, 0700 unless -e $dir && -d _;
return HTTP::Cookies->new(
file => File::Spec->catfile($dir, $file),
autosave => 1,
);
}
sub DESTROY {
my $self = shift;
$self->{cache}->purge() if $self->{to_purge};
}
1;