Coro-Amazon-SimpleDB

 view release on metacpan or  search on metacpan

lib/Coro/Amazon/SimpleDB.pm  view on Meta::CPAN

package Coro::Amazon::SimpleDB;
use common::sense;

$Coro::Amazon::SimpleDB::VERSION = 0.04;

use EV;
use AnyEvent;
use Coro;
use Coro::AnyEvent;

use Carp qw(croak carp);
use Scalar::Util qw(blessed);
use List::Util qw(first);

use Amazon::SimpleDB::Client;
use Amazon::SimpleDB::Model::BatchPutAttributesRequest;
use Amazon::SimpleDB::Model::CreateDomainRequest;
use Amazon::SimpleDB::Model::DeleteAttributesRequest;
use Amazon::SimpleDB::Model::DeleteDomainRequest;
use Amazon::SimpleDB::Model::DomainMetadataRequest;
use Amazon::SimpleDB::Model::GetAttributesRequest;
use Amazon::SimpleDB::Model::ListDomainsRequest;
use Amazon::SimpleDB::Model::PutAttributesRequest;
use Amazon::SimpleDB::Model::SelectRequest;



use Moose;

has 'aws_access_key' => (is => 'rw');
has 'aws_secret_access_key' => (is => 'rw');
has 'domain_name' => (is => 'rw');
has 'sdb' => (is => 'ro', lazy_build => 1);
has 'pending' => (is => 'ro', default => sub { {} });

has 'DEBUG' => (is => 'rw', default => !1);

no Moose;



REPLACE_AMAZON_SIMPLEDB_CLIENT_HTTPPOST: {
    package Amazon::SimpleDB::Client;
    use common::sense;
    use AnyEvent::HTTP;
    use HTTP::Request;
    use HTTP::Response;

    # The only mention of a time-out in Amazon::SimpleDB::Client is in
    # reference to a select operation.  I'm using the value from there
    # (5 seconds) as the default time-out for HTTP requests, as it
    # seems reasonable.  The setting is dynamic, but is used prior to
    # putting HTTP request coros into wait state so it should do the
    # expected thing if it's changed.  Caveat emptor.

    our $HTTP_REQUEST_TIMEOUT = 5;

    # Replace the _httpPost method in Amazon::SimpleDB::Client to use
    # an HTTP lib which does non-blocking requests better than
    # Coro::LWP.  This dangerously violates Amazon::SimpleDB::Client's
    # encapsulation and has some code copied from the original
    # _httpPost.  There is a chance that changes to Amazon's module
    # could break this.

    no warnings 'redefine';

    sub _httpPost {
	my ($self, $parameters) = @_;
        my $response = undef;
        http_request
            POST    => $self->{_config}{ServiceURL},
            body    => join('&', map { $_ . '=' . $self->_urlencode($parameters->{$_}, 0) } keys %{$parameters}),
            timeout => $HTTP_REQUEST_TIMEOUT,
            headers => { 'Content-Type' => 'application/x-www-form-urlencoded; charset=utf-8' },
            sub {
                my ($body, $headers) = @_;
                $response = HTTP::Response->new(@{$headers}{qw( Status Reason )});
                $response->content($body);
                $response->header($_, $headers->{$_})
                    for grep { !/[[:upper:]]/ } keys %{$headers};
            };
        # We need to put this coro to sleep until the response is returned.
        while (not defined $response) { Coro::AnyEvent::sleep 0.1 }
        return $response;
    }
}


ADD_DISPATCH_HELPER_METHODS: {
    # These methods are helpers so we can do method mapping via real
    # dispatch.  It would be nice if Amazon's library could do this
    # dispatching for us.
    sub Amazon::SimpleDB::Model::BatchPutAttributesRequest::client_request_method { 'batchPutAttributes' }
    sub Amazon::SimpleDB::Model::CreateDomainRequest::client_request_method { 'createDomain' }
    sub Amazon::SimpleDB::Model::DeleteAttributesRequest::client_request_method { 'deleteAttributes' }
    sub Amazon::SimpleDB::Model::DeleteDomainRequest::client_request_method { 'deleteDomain' }
    sub Amazon::SimpleDB::Model::DomainMetadataRequest::client_request_method { 'domainMetadata' }
    sub Amazon::SimpleDB::Model::GetAttributesRequest::client_request_method { 'getAttributes' }
    sub Amazon::SimpleDB::Model::ListDomainsRequest::client_request_method { 'listDomains' }
    sub Amazon::SimpleDB::Model::PutAttributesRequest::client_request_method { 'putAttributes' }
    sub Amazon::SimpleDB::Model::SelectRequest::client_request_method { 'select' }
}



# Debugging methods.


sub _bug_process_message {
    require Data::Dumper;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Terse = 1;
    my $message = shift;
    my $result
        = (not defined $message)                             ? '<undef>'
        : (ref $message eq q())                              ? $message
        : (blessed($message) and $message->can('as_string')) ? scalar $message->as_string
        : blessed($message)                                  ? "$message"
        :                                                      Dumper($message)
        ;
    return $result;
}


sub _bug_message {
    my $message_array_ref = shift || [];
    my $caller_level = shift || 0;
    if (ref $message_array_ref ne 'ARRAY') {
        warn "message_array_ref is not an array ref";
        $message_array_ref = [];
    }
    $message_array_ref = [ "something is interesting" ]
        unless @{$message_array_ref};
    my $message = join((defined $, ? $, : q()), map { _bug_process_message($_) } @{$message_array_ref});
    my @caller = caller($caller_level);
    $message .= " at $caller[1] line $caller[2]\n" unless $message =~ /\n/xms;
    return $message;
}


sub bug {
    my $self = shift;

lib/Coro/Amazon/SimpleDB.pm  view on Meta::CPAN

    }

    croak "can't normalize '".(ref $request)."' request to an Amazon::SimpleDB::Model";
}


sub _process_request {
    my $self = shift;
    my $request = $self->_normalize_sdb_request(shift);
    my $method = $request->client_request_method
        or croak "no processing for request of type '".(ref $request)."'";
    return $self->sdb->$method($request);
}


sub add_pending {
    my $self = shift;
    $self->pending->{$_} = $_ for @_;
    return $self;
}

sub remove_pending {
    my $self = shift;
    delete $self->pending->{$_} for @_;
    return $self;
}

sub has_pending { !!%{ shift->pending } }


sub poll {
    my $self = shift;
    async {
        CHECK_LOOP: {
            # Keep polling as long as there are pending requests.
            if ($self->has_pending) {
                Coro::AnyEvent::sleep 0.1;
                redo CHECK_LOOP;
            }
            EV::unloop;
        }
    };
    EV::loop;
    return $self;
}


sub async_requests {
    my ($self, @requests) = @_;

    my $debug = $self->DEBUG;
    require Time::HiRes and Time::HiRes->import('time') if $debug;
    my ($start, $duration) = (0, 0);
    my @responses = ();
    $self->bug("starting async enqueues");
    $start = time() if $debug;
    for ($[ .. $#requests) {
        my $idx = $_;
        my $request = $requests[$idx];
        $self->bug("adding request $request");
        my $coro = async {
            my ($start, $duration) = (0, 0);
            $self->bug("starting request for $request");
            $start = time() if $debug;
            $responses[$idx] = eval { $self->_process_request($request) };
            # Store the exception instead of the response (which
            # should be undef) if there was a problem.
            $responses[$idx] = $@ if $@;
            $duration = time() - $start if $debug;
            $self->bug("completed request for $request in $duration secs");
        };
        $self->add_pending($coro);
        $coro->on_destroy(sub { $self->remove_pending($coro) });
    }
    $duration = time() - $start if $debug;
    $self->bug("completed async enqueues in $duration secs, starting coro polling");
    $self->poll;

    return \@responses;
}


sub async_get_items {
    my ($self, @items) = @_;
    my $responses = $self->async_requests(@items);
    my %items = map {
        my $item_name = $items[$_];
        my $response = $responses->[$_];
        my $attributes
            = (ref $response eq 'Amazon::SimpleDB::Model::GetAttributesResponse') ?
                  {
                      map {
                          defined $_->getName ? ($_->getName, $_->getValue) : ()
                      } @{ $response->getGetAttributesResult->getAttribute }
                  }
            :     $response
            ;
        ($item_name => $attributes);
    } $[ .. $#items;
    return \%items;
}



1;

__END__

=head1 NAME

Coro::Amazon::SimpleDB - Use C<Amazon::SimpleDB::Client> to do asynchronous requests


=head1 VERSION

Version 0.01


=head1 SYNOPSIS

An asynchronous layer on top of Amazon's SimpleDB library.

  use Coro::Amazon::SimpleDB;

  my $sdb = Coro::Amazon::SimpleDB->new;
  $sdb->aws_access_key($aws_access_key_id);
  $sdb->aws_secret_access_key($aws_secret_access_key);
  $sdb->domain_name($aws_simpledb_domain);

  my $attributes = $sdb->async_get_items('name', 'rank', 'serial-number');
  my $full_name = join(' ', @{ $attributes->{name} }{'first', 'last'};


=head1 METHODS

=head2 new

lib/Coro/Amazon/SimpleDB.pm  view on Meta::CPAN


=head2 async_get_items

This is a convenience method for requesting items.  It takes a list of
item names and will return the corresponding attributes in a hash ref.

If an item with an identical name (either in the same domain or not)
is requested multiple times it is undefined what the final result will
be.

  my @keys = qw( ford arthur zaphod );
  my $results = $sdb->async_get_items(@keys);
  my $total_heads = sum map { $results->{$_}{head_count} } @keys;

=head2 poll

This method will poll the EV event loop until the pending attribute is
empty.  It is usually used internally but is available if users want
to build their own asynchronous calls.

=head2 add_pending

A convenience method to add an item to the pending hash.

=head2 remove_pending

A convenience method to remove an item from the pending hash.

=head2 has_pending

Returns true if there are items in the pending hash.

=head2 bug

A debugging method which will print a message similar to a warn if the
object has its DEBUG attribute set to a true value.  If DEBUG is false
it does nothing and immediately returns undef.


=head1 ATTRIBUTES

=head2 aws_access_key
=head2 aws_secret_access_key

These are the AWS credentials providing access to your account.  These
should be available on security credentials page of the AWS portal.

=head2 domain_name

A default domain to use for requests.  This may be over-ridden in
requests passed as hash refs or objects.

=head2 sdb

The C<Amazon::SimpleDB::Client> object to forward requests through.
This is automatically created when first requested, but may also be
passed in manually.

=head2 pending

A hash ref of pending coros.  This is used internally to poll for
completion of all asynchronous requests.

=head2 DEBUG

If set to a true value, the library will output some debugging and
timing information.


=head1 CAVEATS

The Amazon SimpleDB client is required, but is not currently available
via CPAN.  It is available here as of 2010-10-20:

http://developer.amazonwebservices.com/connect/entry.jspa?externalID=1136


=head1 AUTHOR

Dave Trischuk, C<< <dtrischuk at cpan.org> >>


=head1 BUGS

Please report any bugs or feature requests to C<bug-coro-amazon-simpledb at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Coro-Amazon-SimpleDB>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Coro::Amazon::SimpleDB

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Coro-Amazon-SimpleDB>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Coro-Amazon-SimpleDB>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Coro-Amazon-SimpleDB>

=item * Search CPAN

L<http://search.cpan.org/dist/Coro-Amazon-SimpleDB/>

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2010 Campus Explorer http://www.campusexplorer.com/

This program is free software; you can redistribute it and/or modify
it under the terms of either: the GNU General Public License Version
3.0 as published by the Free Software Foundation (see
http://www.gnu.org/licenses/gpl.html); or the Artistic License 2.0
(see http://www.opensource.org/licenses/artistic-license-2.0.php).



( run in 2.050 seconds using v1.01-cache-2.11-cpan-df04353d9ac )