
package AWS::S3;

use VSO;
use Carp 'confess';
use LWP::UserAgent;
use HTTP::Response;
use IO::Socket::INET;
use Class::Load 'load_class';

use AWS::S3::ResponseParser;
use AWS::S3::Owner;
use AWS::S3::Bucket;


our $VERSION = '0.004';

has 'access_key_id' => (
  is    => 'ro'
);

has 'secret_access_key' => (
  is    => 'ro'
);

has 'secure' => (
  is      => 'ro',
  isa     => 'Int',
  default => sub { 0 },
);

has 'ua' => (
  is      => 'ro',
  default => sub { LWP::UserAgent->new }
);


sub request
{
  my ($s, $type, %args) = @_;
  
  my $class = "AWS::S3::Request::$type";
  load_class($class);
  return $class->new( s3 => $s, %args )->http_request;
}# end request()


sub owner
{
  my ($s) = @_;
  
  my $type = 'ListAllMyBuckets';
  my $req = $s->request( $type,
    bucket  => '',
  );
  
  my $parser = AWS::S3::ResponseParser->new(
    response        => $s->ua->request( $req ),
    type            => $type,
    expect_nothing  => 0,
  );
  
  my $xpc = $parser->xpc;
  
  return AWS::S3::Owner->new(
    id            => $xpc->findvalue('//s3:Owner/s3:ID'),
    display_name  => $xpc->findvalue('//s3:Owner/s3:DisplayName'),
  );
}# end owner()


sub buckets
{
  my ($s) = @_;
  
  my $type = 'ListAllMyBuckets';
  my $req = $s->request( $type,
    bucket  => '',
  );
  
  my $parser = AWS::S3::ResponseParser->new(
    response        => $s->ua->request( $req ),
    type            => $type,
    expect_nothing  => 0,
  );
  
  my $xpc = $parser->xpc;
  my @buckets = ( );
  foreach my $node ( $xpc->findnodes('.//s3:Bucket') )
  {
    push @buckets, AWS::S3::Bucket->new(
      name          => $xpc->findvalue('.//s3:Name', $node ),
      creation_date => $xpc->findvalue('.//s3:CreationDate', $node),
      s3            => $s,
    );
  }# end foreach()
  
  return @buckets;
}# end buckets()


sub bucket
{
  my ($s, $name) = @_;
  
  my ($bucket) = grep { $_->name eq $name } $s->buckets
    or return;
  $bucket;
}# end bucket()


sub add_bucket
{
  my ($s, %args) = @_;
  
  my $type = 'CreateBucket';
  my $req = $s->request( $type, bucket => $args{name} );
  
  my $parser = AWS::S3::ResponseParser->new(
    response        => $s->_raw_response( $req ),
    type            => $type,
    expect_nothing  => 1,
  );
  
  if( my $msg = $parser->friendly_error() )
  {
    die $msg;
  }# end if()
  
  return $s->bucket( $args{name} );
}# end add_bucket()


sub _raw_response
{
  my ($s, $http_req) = @_;
  
  my ($host, $uri) = $http_req->uri =~ m{://(.+?)(/.?)$};
  my $sock = IO::Socket::INET->new(
    PeerAddr  => $host,
    PeerPort  => 80, 
    Proto     => 'tcp',
  ) or die "Could not create socket: $!";

  my $req = <<"REQ";
@{[ $http_req->method ]} $uri HTTP/1.1
Host: $host
Date: @{[ $http_req->header('Date') ]}
Authorization: @{[ $http_req->header('Authorization') ]}


REQ
  print $sock $req, $http_req->content;

  my @parts = ( );
  while( <$sock> )
  {
    $_ =~ s{^\s+}{};
    $_ =~ s{\s+$}{};
    last if $_ eq '0';
    push @parts, $_;
    last unless length($_);
  }# end while()

  close($sock);
  
  return HTTP::Response->parse( join "\n", @parts );  
}# end _raw_response()


1;# return true:

=pod

=head1 NAME

AWS::S3 - Lightweight interface to Amazon S3 (Simple Storage Service)

=head1 SYNOPSIS

  use AWS::S3;
  
  my $s3 = AWS::S3->new(
    access_key_id     => 'E654SAKIASDD64ERAF0O',
    secret_access_key => 'LgTZ25nCD+9LiCV6ujofudY1D6e2vfK0R4GLsI4H',
  );
  
  # Add a bucket:
  my $bucket = $s3->add_bucket(
    name    => 'foo-bucket',
  );
  
  # Set the acl:
  $bucket->acl( 'private' );
  
  # Add a file:
  my $new_file = $bucket->add_file(
    key       => 'foo/bar.txt',
    contents  => \'This is the contents of the file',
  );
  
  # Get the file:
  my $same_file = $bucket->file( 'foo/bar.txt' );
  
  # Get the contents:
  my $scalar_ref = $same_file->contents;
  print $$scalar_ref;
  
  # Update the contents:
  $same_file->contents( \"New file contents" );
  
  # Delete the file:
  $same_file->delete();
  
  # Iterate through lots of files:
  my $iterator = $bucket->files(
    page_size   => 100,
    page_number => 1,
  );
  while( my @files = $iterator->next_page )
  {
    warn "Page number: ", $iterator->page_number, "\n";
    foreach my $file ( @files )
    {
      warn "\tFilename (key): ", $file->key, "\n";
      warn "\tSize: ", $file->size, "\n";
      warn "\tETag: ", $file->etag, "\n";
      warn "\tContents: ", ${ $file->contents }, "\n";
    }# end foreach()
  }# end while()
  
  # You can't delete a bucket until it's empty.
  # Empty a bucket like this:
  while( my @files = $iterator->next_page )
  {
    map { $_->delete } @files;
    
    # Return to page 1:
    $iterator->page_number( 1 );
  }# end while()
  
  # Now you can delete the bucket:
  $bucket->delete();

=head1 DESCRIPTION

AWS::S3 attempts to provide an alternate interface to the Amazon S3 Simple Storage Service.

B<NOTE:> Until AWS::S3 gets to version 1.000 it will not implement the full S3 interface.

B<Disclaimer:> Several portions of AWS::S3 have been adopted from L<Net::Amazon::S3>.

B<NOTE:> AWS::S3 is NOT a drop-in replacement for L<Net::Amazon::S3>.

=head1 AUTHOR

John Drago <jdrago_999@yahoo.com>

=head1 LICENSE AND COPYRIGHT

This software is Free software and may be used and redistributed under the same
terms as any version of perl itself.

Copyright John Drago 2011 all rights reserved.

=cut

