File Coverage

blib/lib/Net/Amazon/DynamoDB/Lite.pm

Criterion	Covered	Total	%
statement	77	227	33.9
branch	4	96	4.1
condition			n/a
subroutine	19	34	55.8
pod	13	14	92.8
total	113	371	30.4

package Net::Amazon::DynamoDB::Lite;
use 5.008001;
use strict;
use warnings;

our $VERSION = "0.05";

use Carp;
use Furl;
use HTTP::Request;
use JSON;
use MIME::Base64;
use Moo;
use POSIX qw(setlocale LC_TIME strftime);
use Scalar::Util qw(reftype);
use WebService::Amazon::Signature::v4;

has signature => (
    is => 'lazy',
);

has scope => (
    is => 'lazy',
);

has ua => (
    is => 'lazy',
);

has uri => (
    is => 'lazy',
);

has access_key => (
    is => 'ro',
);

has secret_key => (
    is => 'ro',
);

has region => (
    is => 'ro',
);

has api_version => (
    is => 'ro',
    default => sub {
        '20120810',
    },
);

has ca_path => (
    is => 'rw',
    default => sub {
        '/etc/ssl/certs',
    },
);

has connection_timeout => (
    is => 'rw',
    default => sub {
        1,
    },
);

has json => (
    is => 'rw',
    default => sub {
        JSON->new,
    },
);

sub _build_signature {
    my ($self) = @_;
    my $locale = setlocale(LC_TIME);
    setlocale(LC_TIME, "C");
    my $v4 = WebService::Amazon::Signature::v4->new(
        scope => $self->scope,
        access_key => $self->access_key,
        secret_key => $self->secret_key,
    );
    setlocale(LC_TIME, $locale);
    $v4;
}

sub _build_scope {
    my ($self) = @_;
    join '/', strftime('%Y%m%d', gmtime), $self->region, qw(dynamodb aws4_request);
}

sub _build_ua {
    my ($self) = @_;

    my $ua = Furl->new(
        agent => 'Net::Amazon::DynamoDB::Lite ' . $VERSION,
        timeout => $self->connection_timeout,
        ssl_opts => {
            SSL_ca_path => $self->ca_path,
        },
    );
}

sub _build_uri {
    my ($self) = @_;
    URI->new('https://dynamodb.' . $self->region . '.amazonaws.com/');
}

sub make_request {
    my ($self, $target, $content) = @_;

    my $req = HTTP::Request->new(
        POST => $self->uri,
    );
    my $locale = setlocale(LC_TIME);
    setlocale(LC_TIME, "C");
    $req->header(host => $self->uri->host);
    my $http_date = strftime('%a, %d %b %Y %H:%M:%S %Z', localtime);
    my $amz_date = strftime('%Y%m%dT%H%M%SZ', gmtime);
    $req->header(Date => $http_date);
    $req->header('x-amz-date' => $amz_date);
    $req->header('x-amz-target' => 'DynamoDB_' . $self->api_version . ".$target" );
    $req->header('content-type' => 'application/x-amz-json-1.0');
    $content = $self->json->encode($content);
    $req->content($content);
    $req->header('Content-Length' => length($content));
    $self->signature->from_http_request($req);
    $req->header(Authorization => $self->signature->calculate_signature);
    setlocale(LC_TIME, $locale);
    return $req;
}

sub list_tables {
    my ($self, $content) = @_;

    $content = {} unless $content;
    my $req = $self->make_request('ListTables', $content);
    my $res = $self->ua->request($req);
    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    if ($res->is_success) {
        return $decoded->{TableNames};
    }
    else {
        Carp::croak $self->_error_content($res, $decoded);
    }
}

sub put_item {
    my ($self, $content) = @_;

    Carp::croak "Item required." unless $content->{Item};
    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('PutItem', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        $self->_err_res_json_decode($res);
    }
}

sub get_item {
    my ($self, $content) = @_;

    Carp::croak "Key required." unless $content->{Key};
    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('GetItem', $content);
    my $res = $self->ua->request($req);
    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    if ($res->is_success) {
        return _except_type($decoded->{Item});
    }
    else {
        Carp::croak $self->_error_content($res, $decoded);
    }

}

sub update_item {
    my ($self, $content) = @_;

    Carp::croak "Key required." unless $content->{Key};
    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('UpdateItem', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        $self->_err_res_json_decode($res);
    }
}

sub delete_item {
    my ($self, $content) = @_;

    Carp::croak "Key required." unless $content->{Key};
    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('DeleteItem', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        $self->_err_res_json_decode($res);
    }
}

sub create_table {
    my ($self, $content) = @_;

    Carp::croak "AttributeDefinitions required." unless $content->{AttributeDefinitions};
    Carp::croak "KeySchema required." unless $content->{KeySchema};
    Carp::croak "ProvisionedThroughput required." unless $content->{ProvisionedThroughput};
    Carp::croak "TableName required." unless $content->{TableName};

    my $req = $self->make_request('CreateTable', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        $self->_err_res_json_decode($res);
    }
}

sub delete_table {
    my ($self, $content) = @_;

    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('DeleteTable', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        $self->_err_res_json_decode($res);
    }
}

sub describe_table {
    my ($self, $content) = @_;

    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('DescribeTable', $content);
    my $res = $self->ua->request($req);
    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    if ($res->is_success) {
        return $decoded->{Table};
    } else {
        Carp::croak $self->_error_content($res, $decoded);
    }

}

sub update_table {
    my ($self, $content) = @_;

    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('UpdateTable', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    } else {
        $self->_err_res_json_decode($res);
    }
}

sub query {
    my ($self, $content) = @_;

    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('Query', $content);
    my $res = $self->ua->request($req);

    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    if ($res->is_success) {
        return _except_type($decoded->{Items});
    } else {
        Carp::croak $self->_error_content($res, $decoded);
    }
}

sub scan {
    my ($self, $content) = @_;

    Carp::croak "TableName required." unless $content->{TableName};
    my $req = $self->make_request('Scan', $content);
    my $res = $self->ua->request($req);
    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    if ($res->is_success) {
        return _except_type($decoded->{Items});
    } else {
        Carp::croak $self->_error_content($res, $decoded);
    }
}

sub batch_get_item {
    my ($self, $content) = @_;

    Carp::croak "RequestItems required." unless $content->{RequestItems};
    my $req = $self->make_request('BatchGetItem', $content);
    my $res = $self->ua->request($req);
    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    if ($res->is_success) {
        my $res;
        for my $k (keys %{$decoded->{Responses}}) {
            push @{$res}, {$k => _except_type($decoded->{Responses}->{$k})};
        }
        return $res;
    } else {
        Carp::croak $self->_error_content($res, $decoded);
    }
}

sub batch_write_item {
    my ($self, $content) = @_;

    Carp::croak "RequestItems required." unless $content->{RequestItems};
    my $req = $self->make_request('BatchWriteItem', $content);
    my $res = $self->ua->request($req);
    if ($res->is_success) {
        return 1;
    }
    else {
        $self->_err_res_json_decode($res);
    }
}

sub _except_type {
    my $v = shift;
    my $res;
    if (ref $v eq 'HASH') {
        for my $key (keys %{$v}) {
            my $value = $v->{$key};
            $res->{$key} = _rm_type($value);
        }
    } elsif (ref $v eq 'ARRAY') {
        for my $w (@{$v}) {
            push @{$res}, _except_type($w);
        }
    }
    return $res;
}

sub _rm_type {
    my $v = shift;
    my ($type, $value) = %$v;
    my $res;
    if ($type eq 'L') {
        for my $i (@$value) {
            push @$res, _rm_type($i);
        }
        return $res;
    }
    elsif ($type eq 'M') {
        for my $i (keys %$value) {
            $res->{$i} = _rm_type($value->{$i});
        }
        return $res;
    }
    elsif ($type eq 'B') {
        return MIME::Base64::decode_base64($value);
    }
    else {
        return $value;
    }
}

sub _err_res_json_decode {
    my ($self, $res) = @_;
    my $decoded;
    eval {
        $decoded = $self->json->decode($res->content);
    };
    if ($@) {
        Carp::croak $self->_error_content($res, {Message => $res->content}) if $@;
    } else {
        Carp::croak $self->_error_content($res, $decoded);
    }
}

sub _error_content {
    my ($self, $res, $decoded) = @_;

    my $message = $decoded->{Message} ? $decoded->{Message} : $decoded->{message};
    my $type = $decoded->{__type} ? $decoded->{__type} : "";
    return  "status_code : " . $res->status_line
      . " __type : " . $type
      . " message : " . $message;
}


1;
__END__