File Coverage

lib/Amazon/SimpleDB.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

package Amazon::SimpleDB;
use strict;
use warnings;

our $VERSION = '0.03';

use URI;
use LWP::UserAgent;
use Digest::HMAC_SHA1;
use MIME::Base64 qw(encode_base64);
use Carp qw( croak );

use Amazon::SimpleDB::Domain;
use Amazon::SimpleDB::Response;

use constant SERVICE_URI          => 'http://sdb.amazonaws.com/';
use constant KEEP_ALIVE_CACHESIZE => 10;

sub new {
    my $class = shift;
    my $args  = shift || {};
    my $self  = bless $args, $class;
    croak "No aws_access_key_id"     unless $self->{aws_access_key_id};
    croak "No aws_secret_access_key" unless $self->{aws_secret_access_key};
    unless ($self->{agent}) {
        my $agent = LWP::UserAgent->new(keep_alive => KEEP_ALIVE_CACHESIZE);
        $agent->timeout(10);
        $agent->env_proxy;
        $self->{agent} = $agent;
    }
    return $self;
}

sub domains {
    my $self   = shift;
    my $args   = shift || {};
    my $params = {};
    $params->{MaxNumberOfDomains} = $args->{'limit'} if $args->{'limit'};
    $params->{NextToken}          = $args->{'next'}  if $args->{'next'};
    my $res = $self->request('ListDomains', $params);
    return
      Amazon::SimpleDB::Response->new(
                                      {
                                       http_response => $res,
                                       account       => $self
                                      }
      );
}

sub domain {
    return Amazon::SimpleDB::Domain->new({name => $_[1], account => $_[0]});
}

sub create_domain {    # note no more than 100 per account.
    my ($self, $name) = @_;
    my $res = $self->request('CreateDomain', {DomainName => $name});
    return
      Amazon::SimpleDB::Response->new(
                                      {
                                       http_response => $res,
                                       account       => $self
                                      }
      );
}

sub delete_domain {
    my ($self, $name) = @_;
    my $res = $self->request('DeleteDomain', {DomainName => $name});
    return
      Amazon::SimpleDB::Response->new(
                                      {
                                       http_response => $res,
                                       account       => $self
                                      }
      );
}

#--- utility methods

sub request {    # returns "raw" HTTP Response from SimpleDB
    my ($self, $action, $params) = @_;
    croak "No Action parameter" unless $action;
    $params ||= {};
    $params->{Action}           = $action;
    $params->{AWSAccessKeyId}   = $self->{aws_access_key_id};
    $params->{Version}          = '2007-11-07';
    $params->{SignatureVersion} = 1 unless defined $params->{SignatureVersion};
    $params->{Timestamp}        = timestamp() unless $params->{Expires};
    my $time = $params->{Expires} || $params->{Timestamp};
    my $sig = '';
    if ($params->{SignatureVersion} == 1) {
        $sig .= $_ . $params->{$_}
          for (sort { lc($a) cmp lc($b) } keys %$params)
          ;    # Must be alphabetical in a case-insensitive manner.
    } else {
        $sig = $params->{Action} . $time;
    }
    my $hash = Digest::HMAC_SHA1->new($self->{aws_secret_access_key});
    $hash->add($sig);
    $params->{Signature} = encode_base64($hash->digest, '');
    my $uri = URI->new(SERVICE_URI);
    $uri->query_form($params);
    return $self->{agent}->get($uri->as_string);
}

sub timestamp {
    my $t = shift;
    $t = time unless defined $t;
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
      gmtime($t);
    return
      sprintf("%4i-%02i-%02iT%02i:%02i:%02iZ",
              ($year + 1900),
              ($mon + 1),
              $mday, $hour, $min, $sec);
}

1;

__END__