CHIのDriverでAmazon S3にキャッシュ - CHI::Driver::S3

割とさくっといけそうだったので、S3用のDriverを書いてみました。
http://dann.g.hatena.ne.jp/dann/20080721/p6

expire周りの実装がまるで抜けてるのとエラー処理がないのでリリースするにはまだ早いですが、set, get, get_multi系はとりあえず動作します。

package CHI::Driver::S3;
use Carp;
use Net::Amazon::S3;
use Moose;
use strict;
use warnings;

extends 'CHI::Driver';

has 'aws_access_key_id'     => ( is => 'ro', isa => 'Str', reququired => 1 );
has 'aws_secret_access_key' => ( is => 'ro', isa => 'Str', required   => 1 );
has 'bucket_name'           => ( is => 'ro', isa => 'Str', required   => 1 );
has 'retry'                 => ( is => 'ro', isa => 'Int', default    => 1 );
has 'bucket'                => ( is => 'rw' );

__PACKAGE__->meta->make_immutable();

sub BUILD {
    my ( $self, $params ) = @_;

    my $api = Net::Amazon::S3->new(
        {   aws_access_key_id     => $self->{aws_access_key_id},
            aws_secret_access_key => $self->{aws_secret_access_key},
        }
    );
    $self->bucket( $api->bucket( $self->{bucket_name} ) );
}

sub get {
    my ( $self, $key, $options ) = @_;
    croak "must specify key" unless defined($key);
    my $response = $self->bucket->get_key($key);
    return $response->{value};
}

sub fetch {
    my ( $self, $key ) = @_;
    return $self->get($key);
}

sub set {
    my ( $self, $key, $value ) = @_;
    croak "must specify key" unless defined($key);
    return unless defined($value);

    $self->bucket->add_key( $key, $value );
}

sub store {
    my ( $self, $key, $data ) = @_;
    $self->set( $key, $data );
}

sub remove {
    my ( $self, $key ) = @_;
    $self->bucket->delete_key($key);
}

sub get_keys {
    my ($self)   = @_;
    my $bucket   = $self->bucket;
    my $response = $bucket->list_all
        or die $bucket->err . ": " . $bucket->errstr;
    my $keys = [];
    foreach my $key ( @{ $response->{keys} } ) {
        push @{$keys}, $key->{key};
    }
    return $keys;
}

sub expire {
    my ( $self, $key ) = @_;
}

sub expire_if {
    my ( $self, $key, $code ) = @_;
    return 1;
}

sub exists_and_is_expired {
    my ( $self, $key ) = @_;
    croak "must specify key" unless defined($key);

    if ( my $obj = $self->get($key) ) {
        return 1;
    }
    else {
        return;
    }
}

1;

__END__

次はCHI::Driver::TokyoCabinet