Tie-Amazon-S3

 view release on metacpan or  search on metacpan

lib/Tie/Amazon/S3.pm  view on Meta::CPAN

package Tie::Amazon::S3;

use warnings;
use strict;

use Carp 'croak';
use Net::Amazon::S3;

=head1 NAME

Tie::Amazon::S3 - tie Amazon S3 buckets to Perl hashes

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';
our @ISA = qw(Net::Amazon::S3);

=head1 SYNOPSIS

    use Tie::Amazon::S3;

    tie my %bucket, 'Tie::Amazon::S3', 'my-amazon-aws-id',
        'my-amazon-aws-secret', 'my-amazon-s3-bucket';

    # use it as you would any Perl hash
    $bucket{testfile} = 'this is a testfile';
    print $bucket{testfile};
    ...

=head1 METHODS

=head2 TIEHASH

Constructor for tying a L<Net::Amazon::S3> object to a Perl hash.

=cut

sub TIEHASH {
    my ( $class, $id, $key, $bucket ) = @_;
    my $self = $class->SUPER::new(
        {
            aws_access_key_id => $id,
            aws_secret_access_key => $key,
        },
    );
    $self->{BUCKET} = $self->bucket($bucket);
    my %key = ();
    my $list = $self->{BUCKET}->list_all or $self->s3_croak;
    map { $key{$_} => sub { $self->{BUCKET}->get_key($_)
                                or $self->s3_croak; } }
        @{ $list->{keys} };
    $self->{KEYS} = \%key;
    bless $self => $class;
}

=head2 STORE

Store some scalar into an S3 bucket (Perl hash) key.

=cut

sub STORE {
    my ( $self, $key, $value ) = @_;
    $self->{BUCKET}->add_key( $key, $value ) or $self->s3_croak;
    $self->{KEYS}->{$key} = sub { $self->{BUCKET}->get_key($key)
                              or $self->s3_croak };
}

=head2 FETCH

Fetch an S3 bucket key.

=cut

sub FETCH {
    my ( $self, $key ) = @_;
    if ( exists $self->{KEYS}->{$key} ) {
            $self->{KEYS}->{$key}->()->{value};
    } else {
        return undef;
    }
}

=head2 EXISTS

Check if a given key exists in the bucket.

=cut

sub EXISTS {
    my ( $self, $key ) = @_;
    exists $self->{KEYS}->{$key};
}

=head2 DELETE

Delete a key from the bucket.

=cut

sub DELETE {
    my ( $self, $key ) = @_;
    # emulate native delete, returning whatever FETCH returned for this
    # key
    my $value = $self->FETCH( $key );
    $self->{BUCKET}->delete_key( $key ) or $self->s3_croak;
    my $deleted = delete $self->{KEYS}->{$key};
    return $value;
}

=head2 CLEAR

Clear the bucket of keys.

 view all matches for this distribution
 view release on metacpan -  search on metacpan

( run in 1.406 second using v1.00-cache-2.02-grep-82fe00e-cpan-d29e8ade9f55 )