WebService::Simpleでキャッシュを使えない -解決-

とりあえず解決したのでメモ。

#!/usr/bin/perl

use strict;
use warnings;

use WebService::Simple;
use Data::Dumper;

{
    package MyCache;
    
    use Cache::File;
    use Safe;

    use base qw(Cache::File);

    my $safe = Safe->new;
    $safe->permit(qw(:default require));
    my $reval = sub { $safe->reval($_[0]) };

    sub set {
        my $self = shift;
        local $Storable::Deparse = 1;
        local $Storable::Eval = $reval;
        $self->SUPER::freeze(@_);
    }

    sub get {
        my $self = shift;
        local $Storable::Deparse = 1;
        local $Storable::Eval = $reval;
        $self->SUPER::thaw(@_);
    }
}

my $cache = MyCache->new(
    cache_root => "$ENV{HOME}/perl/tmp",
    lock_level => Cache::File::LOCK_LOCAL(),
    default_expires => '30 min',
);

my $google = WebService::Simple->new(
    base_url        => "http://ajax.googleapis.com/ajax/services/search/web",
    cache           => $cache,
    response_parser => 'JSON',
    params          => { v => "1.0", rsz=> "large" }
);

my $response =  $google->get( { q => "cat" , start=> 0 } );
print Dumper $response->parse_response;

まずStorableというモジュールを使うとオブジェクトを保存し、取り出すことができる。Cache::FileでStorableを使うようにするには、thaw()とfreeze()と使う。
404 Blog Not Found:perl - Cache::File と Storable

なにしろ、$cache->get()を$cache->thaw()に、$cache->set()を$cache->freeze()にそれぞれ変えればいいだけなのですから楽すぎます。

WebService::SimpleはCacheオブジェクトのget()とset()を呼び出しているので、Cache::Fileを継承して、get()でthaw()を、set()でfreeze()を呼び出すようにする。

ただし、thaw()とfreeze()に変えただけは以下のようなエラーが出るので、

Can't store CODE items at ../../lib/Storable.pm
(autosplit into ../../lib/auto/Storable/_freeze.al)
line 290, at /usr/lib/perl5/site_perl/5.8/Cache/Entry.pm line 317

下記のコードを参考にして、$Storable::Deparseと$Strable::Evalを設定する。
Storable - Perlデータ構造体の永続化

use Storable qw(freeze thaw);
use Safe;
use strict;
my $safe = new Safe;
# opcodeを"require"することを許すことは"use strict"を使う時には必須です
$safe->permit(qw(:default require));
local $Storable::Deparse = 1;
local $Storable::Eval = sub { $safe->reval($_[0]) };
my $serialized = freeze(sub { print "42\n" });
my $code = thaw($serialized);
$code->(); # prints 42