root/trunk/plagger/lib/Plagger/Cache.pm

Revision 1026 (checked in by miyagawa, 14 years ago)

Purge cache on the global destruction phase of every run. Fixes #306.
via http://d.hatena.ne.jp/s_nobu/20060619/1150709563

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