Amazon-S3-Lite

 view release on metacpan or  search on metacpan

lib/Amazon/S3/Lite.pm  view on Meta::CPAN

use Amazon::Signature4::Lite;
use Amazon::S3::Lite::Credentials;
use Amazon::S3::Lite::Logger;
use Carp qw(croak);
use Data::Dumper;
use Digest::MD5 qw(md5_base64 md5);
use English qw(-no_match_vars);
use HTTP::Tiny;
use List::Util qw(pairs);
use MIME::Base64 qw(encode_base64);
use Scalar::Util qw(blessed openhandle);
use URI::Escape qw(uri_escape_utf8);
use XML::Twig;

use Readonly;
Readonly our $TRUE  => 1;
Readonly our $FALSE => 0;

our $VERSION = '1.2.2';

########################################################################
sub new {
########################################################################
  my ( $class, @args ) = @_;

  my $options = ref $args[0] ? $args[0] : {@args};

  my $self = bless $options, $class;

  $self->{host}    //= 's3.amazonaws.com';
  $self->{secure}  //= $TRUE;
  $self->{timeout} //= 30;
  $self->{region}  //= 'us-east-1';

  $self->_init_logger;
  $self->_init_credentials;
  $self->_init_ua;

lib/Amazon/S3/Lite.pm  view on Meta::CPAN

# Logger setup
# Priority: caller-supplied object -> Log::Log4perl (if available) ->
#           minimal STDERR logger
########################################################################
sub _init_logger {
########################################################################
  my ($self) = @_;

  my $logger = $self->{logger};

  if ( $logger && blessed $logger ) {
    # Validate it quacks like a logger
    for my $method (qw(trace debug info warn error)) {
      croak "logger object must implement '$method'"
        if !$logger->can($method);
    }

    return;
  }

  my $log4perl = eval {

lib/Amazon/S3/Lite.pm  view on Meta::CPAN

# Credential resolution
# Priority: explicit credentials object -> constructor args ->
#           environment variables -> Amazon::Credentials (if available)
########################################################################
sub _init_credentials {
########################################################################
  my ($self) = @_;

  # 1. Caller-supplied credentials object (duck-typed)
  if ( my $creds = $self->{credentials} ) {
    croak "credential object is not blessed.\n"
      if !blessed $creds;

    foreach (qw(aws_access_key_id aws_secret_access_key token)) {
      my $sub = $creds->can($_) // $creds->can("get_$_");

      croak "credentials object must implement $_ or get_$_\n"
        if !$sub;
    }

    $self->{credentials} = $creds;

lib/Amazon/S3/Lite.pm  view on Meta::CPAN

  # User metadata — prefix bare keys with x-amz-meta-
  if ( my $meta = $options{metadata} ) {
    for my $k ( keys %{$meta} ) {
      my $header = $k =~ /^x-amz-meta-/xsm ? $k : "x-amz-meta-$k";
      $headers{$header} = $meta->{$k};
    }
  }

  my $body;

  if ( openhandle($data) || ( blessed($data) && $data->can('read') ) ) {
    # --- Filehandle path ---
    my $content_length = $options{content_length};

    # Try to stat the handle for real files; suppress warning on
    # in-memory handles (IO::Scalar etc.) that have no underlying fd
    if ( !defined $content_length ) {
      my $fd = eval { fileno($data) };
      if ( defined $fd && $fd >= 0 ) {
        my @st = stat $data;
        $content_length = $st[7] if @st && defined $st[7];

lib/Amazon/S3/Lite/Credentials.pm  view on Meta::CPAN

sub new {
  my ( $class, %args ) = @_;

  croak 'aws_access_key_id is required'
    if !$args{aws_access_key_id};

  croak 'aws_secret_access_key is required'
    if !$args{aws_secret_access_key};

  return bless {
    aws_access_key_id     => $args{aws_access_key_id},
    aws_secret_access_key => $args{aws_secret_access_key},
    token                 => $args{token},
  }, $class;
}

sub aws_access_key_id     { return $_[0]->{aws_access_key_id} }
sub aws_secret_access_key { return $_[0]->{aws_secret_access_key} }
sub token                 { return $_[0]->{token} }
sub session_token         { return $_[0]->{token} }

lib/Amazon/S3/Lite/Logger.pm  view on Meta::CPAN

  FATAL => 50_000,
};

########################################################################
sub new {
########################################################################
  my ( $class, @args ) = @_;

  my $options = ref $args[0] ? $args[0] : {@args};

  my $self = bless $options, $class;
  $self->{log_level} //= 'warn';

  return $self;
}

########################################################################
sub _log_level {
########################################################################
  my ($self) = @_;

t/01-s3-lite.t  view on Meta::CPAN

    local $ENV{AWS_SESSION_TOKEN}     = 'envtoken';
    my $s3e = Amazon::S3::Lite->new( { region => 'us-east-1' } );
    is $s3e->credentials->aws_access_key_id, 'envkey',   'env key';
    is $s3e->credentials->token,             'envtoken', 'env token';
  }

  # duck-typed credentials object
  {

    package MyCreds;
    sub new                   { bless {}, shift }
    sub aws_access_key_id     {'duckkey'}
    sub aws_secret_access_key {'ducksecret'}
    sub token                 {undef}

    package main;
    my $s3d = Amazon::S3::Lite->new(
      { region      => 'us-east-1',
        credentials => MyCreds->new,
      }
    );
    is $s3d->credentials->aws_access_key_id, 'duckkey', 'duck-type creds';
  }

  # bad credentials object
  {

    package BadCreds;
    sub new               { bless {}, shift }
    sub aws_access_key_id {'key'}

    package main;
    eval { Amazon::S3::Lite->new( { region => 'us-east-1', credentials => BadCreds->new } ) };
    like $@, qr/must implement aws_secret_access_key/, 'bad creds object croaks';
  }

  # custom logger
  {
    my $warned = 0;
    my $logger = bless {}, 'MyLogger';
    {
      no strict 'refs';
      for my $m (qw(trace debug info error)) {
        *{"MyLogger::$m"} = sub { };
      }
      *{"MyLogger::warn"} = sub { $warned++ };
    }
    my $s3l = new_s3( logger => $logger );
    isa_ok $s3l->logger, 'MyLogger', 'custom logger accepted';
  }