package Net::Amazon::SimpleDB::Simple;

=head1 NAME

Net::Amazon::SimpleDB::Simple - A simple wrapper to Amazon's Perl libary, inspired
by and adapted from Eric Hammond's simpledb CLI: http://code.google.com/p/amazon-simpledb-cli/

Requires the official Amazon::SimpleDB library from AMAZON, not CPAN.

It is not currently available on CPAN (working on it) and can be found here:

    http://developer.amazonwebservices.com/connect/entry.jspa?externalID=1136
    
Information on the Amazon API can be found here:

    http://docs.amazonwebservices.com/AmazonSimpleDB/latest/DeveloperGuide/

=head1 SYNOPSIS

use Net::Amazon::SimpleDB::Simple;

my $attributes = {name => 'Jim', hobby => ['jogging', 'climbing'], job => 'cop'};

my $sdb = Net::Amazon::SimpleDB::Simple->new(
       {
        AWS_ACCESS_KEY_ID     => $ENV{AWS_ACCESS_KEY_ID},
        AWS_SECRET_ACCESS_KEY => $ENV{AWS_SECRET_ACCESS_KEY},
        domain                => 'MyDomainName'
       }
);

$sdb->put_attributes('555ABC', $attributes);

my $output = $sdb->get_attributes('555ABC');

my $select_output = $sdb->select('SELECT * from MyDomain');

$sdb->delete_attributes('555ABC', $attributes);

=head1 DESCRIPTION

A simple wrapper to Amazon's Perl libary, inspired
by Eric Hammond's simpledb CLI: http://code.google.com/p/amazon-simpledb-cli/

Pass simple args in - a list or a hashref - get a data structure matching the SimpleDB data back.

=over 2

    Always arrayrefs?

    Each key holds an arrayref that contains one or more values for that key - this is
    because Amazon SimpleDB can have many values per-key, per-row and why check if its an
    array each time?  It is.
    
=back

=cut

# If you don't understand the notation that follows, read the Moose docs
use Moose;
use Carp;
use Data::Dumper;

# Note - this is Amazon's client, not the CPAN client
use Amazon::SimpleDB::Client;
use Amazon::SimpleDB::Model::Attribute;

# Our Moosey Amazon Client object
has 'sdb' => (
    isa     => 'Amazon::SimpleDB::Client',
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        Amazon::SimpleDB::Client->new($self->AWS_ACCESS_KEY_ID,
                                      $self->AWS_SECRET_ACCESS_KEY);
    }
);

# For generating item names - UUIDs
use Data::UUID;

# Our Moosey UUID factory
has 'uuid_factory' => (
    isa     => 'Data::UUID',
    is      => 'rw',
    lazy    => 1,
    default => sub {
        my $self = shift;
        Data::UUID->new();
    }
);

=head2 max

=over 4

    defines the max items to return per query

=back

=cut

has 'max' => (isa => 'Int', is => 'rw', default => 100);

has [qw/AWS_ACCESS_KEY_ID AWS_SECRET_ACCESS_KEY domain/] =>
  (isa => 'Str', is => 'ro', required => 1);

=head2 put_attributes

=over 4

    Usage: $sdb->put_attributes($item_name, $values_hashref);

=back

=cut

sub put_attributes
{
    my ($self, $item_name, $values) = @_;
    
    my $atts = $self->_hashref_to_attributes($values, 0);

    eval {
        my $response =
          $self->sdb->putAttributes(
                            {
                             DomainName => $self->domain,
                             ItemName   => $item_name,
                             Attribute => $self->_hashref_to_attributes($values, 0),
                            }
          );
    };
    
    
    
    $self->error("ERROR Running put_attributes:", $@) if $@;
}

=head2 put_replace_attributes

=over 4

    Usage: $sdb->put_replace_attributes($item_name, $values_hashref);

    Will replace any attribute values with the ones specified in the values hashref.
    
    Note: currently replaces all dupes found, and not one at a time.  To replace
    values indvidually (i.e. not all of them), use Amazon::SimpleDB::Client which
    is accessible via the client() method.
    
=back

=cut

sub put_replace_attributes
{
    my ($self, $item_name, $values) = @_;

    my $response =
      $self->sdb->putAttributes(
                        {
                         DomainName => $self->domain,
                         ItemName   => $item_name,
                         Attribute => $self->_hashref_to_attributes($values, 1),
                        }
      );
}

=head2 put_attributes_uuid

=over 4

    Creates a new item using a UUID for its item name, and returns the item's UUID string
    
    Why?  SERIAL PRIMARY KEY makes a lot of sense, so I'm replicating that here, in SimpleDB

    Usage: my $uuid_string = $sdb->put_attributes_uuid($values_hashref);
    
    *Note: ATM this uses a 16 char Data::UUID, but will allow you to plug-in whatever later,
    or set UUID method/length
    
=back

=cut

sub put_attributes_uuid
{
    my ($self, $values) = @_;

    my $uuid      = $self->uuid_factory->create();
    my $item_name = $self->uuid_factory->to_string($uuid);

    $self->put_attributes($item_name, $values, 0);

    return $item_name;
}

=head2 delete_attributes

=over 4

    Usage: $sdb->delete_attributes($item_name, $values_hashref);

=back

=cut

sub delete_attributes
{
    my ($self, $item_name, $values) = @_;

    my $response = eval {
        $self->sdb->deleteAttributes(
                        {
                         DomainName => $self->domain,
                         ItemName   => $item_name,
                         Attribute => $self->_hashref_to_attributes($values, 0),
                        }
        );
    };
}

=head2 get_attributes

=over 4

    Usage: my $hash_ref = $sdb->get_attributes($item_name, @attribute_names);

    Attribute names are optional, without them all attributes will be returned.

    Returns a hashref containing the attribute name/value pairs

    Note: values are ALWAYS arrayrefs, even if there is only one value for that attribute

=back

=cut

sub get_attributes
{
    my ($self, $item_name, @attribute_names) = @_;

    my $response =
      $self->sdb->getAttributes(
                                {
                                 DomainName    => $self->domain,
                                 ItemName      => $item_name,
                                 AttributeName => \@attribute_names,
                                }
                               );

    my $attribute_list = $response->getGetAttributesResult->getAttribute;

    my %attributes;

    # Loop through each attribute and build our hash of arrayrefs
    foreach my $att (@$attribute_list)
    {

        # We may have more than one attribute per value, and we always return an array ref
        push @{$attributes{$att->getName}}, $att->getValue;
    }

    return \%attributes;
}

=head2 query

=over 4

    Usage: my $ary_ref = $sdb->query($query);
    
    Given a query, returns an array ref holding the items that match it

=back

=cut

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

    my $next_token;
    my $count = 0;

    my $response = $self->sdb->query(
                          {
                           DomainName      => $self->domain,
                           QueryExpression => $query_expression,
                           ($next_token ? (NextToken => $next_token) : ()),
                           ($self->max ? (MaxNumberOfItems => $self->max) : ()),
                          }
    );
    my $item_name_list = $response->getQueryResult->getItemName;

    return $item_name_list;
}

=head2 select

=over 4

    Usage: my $ary_ref = $sdb->query($query);
    
    Returns:
            
            # Item Name
            'ABCD123' =>
                    # Attribute name/value pairs
                    {
                       'hobby' => [
                                  'rowing'
                                ],
                       'name' => [
                                 'Joe'
                               ],
                       'job' => [
                                'teacher'
                              ]
                     },
            '777ABC' => {
                      'hobby' =>
                                # Multiple values per attribute possible
                                [
                                 'climbing',
                                 'jogging'
                               ],
                      'name' => [
                                'Jim'
                              ],
                      'job' => [
                               'cop'
                             ]
                    }
    
    Given a select statement, returns a hashref keyed by item name, each item name
    containing a hashref ref holding the item's attributes that match it

=back

=cut

sub select
{
    my ($self, $select_statement) = @_;

    # Get the response
    my $response = $self->sdb->select({SelectExpression => $select_statement});

    # Get the result from the response
    my $result = $response->getSelectResult;

    # Key each row by the item name
    my $rows = {};

    # Loop through the items returned...
    foreach my $item (@{$result->getItem})
    {
        my $attributes = {};

        # For each attribute of this item, add it to the attributes hash for this row
        foreach my $att (@{$item->getAttribute})
        {
            # Remember - for attributes we always return arrayrefs, even if there is only one value
            push @{$attributes->{$att->getName}}, $att->getValue;
        }

        # Key the row by the item name
        $rows->{$item->getName} = $attributes;
    }

    return $rows;
}

=head2 error 

=over 4

    Not actually used yet.
    
=back

=cut

sub error
{
    my ($message, $exception) = @_;

    if (ref $exception eq "Amazon::SimpleDB::Exception")
    {
        $message .= " " . $exception->getMessage() . "\n";
    }
    else
    {
        $message .= " $@\n";
    }
    die $message;
}

=head2 client

=over 4

    Return the Amazon::SimpleDB::Client instance, in case they want to do something more complex
    
=back

=cut

sub client
{
    my $self = shift;

    return $self->sdb;
}

=head2 _hashref_to_attributes

=over 4

    Internal method - leave they alone

    Usage: my @attributes = $self->_hashref_to_attributes($hashref_of_values, $replace)
    
    Replace is optional - default is false

=back

=cut

sub _hashref_to_attributes
{
    my ($self, $values, $with_replace) = @_;

    my @attributes;

    # Build an attribute for each element of the hashref and stuff it in an array
    foreach my $key (keys(%$values))
    {

        # Is this an array, indicating multiple values for this attribute?
        if (ref($values->{$key}) eq 'ARRAY')
        {
            my $vals_array = $values->{$key};

            foreach my $val (@$vals_array)
            {
                # Skip undef/null string attributes, otherwise SimpleDB will crash
                # or act strange.  Must deleteAttribute on these.  May add this
                # to an ObjectPersist method later.
                next if((not defined($val)) or $val eq '');
                
                my $atts = {
                            Name  => $key,
                            Value => $val,
                           };

                # Handle replacement of attributes - if requested
                $atts->{Replace} = 'true' if $with_replace;

                push @attributes, $atts;
            }
        }

        # Not an array, just push the value
        else
        {
            my $val = $values->{$key};
            
            # Skip undef/null string attributes, otherwise SimpleDB will crash
            # or act strange.  Must deleteAttribute on these.  May add this
            # to an ObjectPersist method later.
            next if((not defined($val)) or $val eq '');
                
            my $atts = {
                        Name  => $key,
                        Value => $val,
                       };
            
            # Handle replacement of attributes - if requested
            $atts->{Replace} = 'true' if $with_replace;

            push @attributes, $atts;
        }
    }

    return \@attributes;
}

sub time2iso (;$)
{
    my($sec,$min,$hour,$mday,$mon,$year) = gmtime;
    return sprintf("%04d-%02d-%02dT%02d:%02d:%02d",
    $year+1900, $mon+1, $mday, $hour, $min, $sec);
}

1;
__END__

=head1 AUTHOR

Russell Jurney C<rjurney at starcaller.com>

=head1 LICENSE

This module is available under the same licences as perl, the Artistic
license and the GPL.

=head1 SEE ALSO

=cut