view release on metacpan or  search on metacpan

lib/Amazon/S3Curl/PurePerl.pm  view on Meta::CPAN

package Amazon::S3Curl::PurePerl;

#ABSTRACT: Amazon::S3Curl::PurePerl - Pure Perl s3 helper/downloader.
use strict;
use warnings;

use Module::Runtime qw[ require_module ];

our $VERSION = "0.054";
$VERSION = eval $VERSION;

#For instances when you want to use s3, but don't want to install anything. ( and you have curl )
#Amazon S3 Authentication Tool for Curl
#Copyright 2006-2010 Amazon.com, Inc. or its affiliates. All Rights Reserved.
use Moo;
use POSIX;
use File::Spec;
use Log::Contextual qw[ :log :dlog set_logger ];
use Log::Contextual::SimpleLogger;
use Digest::SHA::PurePerl;
use MIME::Base64 qw(encode_base64);
use IPC::System::Simple qw[ capture ];
my $DIGEST_HMAC;
BEGIN {
    eval {
        require_module("Digest::HMAC");
        $DIGEST_HMAC = "Digest::HMAC";
    };
    if ($@) {    #They dont have Digest::HMAC, use our packaged alternative
        $DIGEST_HMAC = "Amazon::S3Curl::PurePerl::Digest::HMAC";
        require_module($DIGEST_HMAC);
    }
};


set_logger(
    Log::Contextual::SimpleLogger->new(
        {
            levels_upto => 'debug'
        } ) );


has curl => (
    is      => 'ro',
    default => sub { 'curl' }    #maybe your curl isnt in PATH?
);

for (
    qw[
    aws_access_key
    aws_secret_key
    ] )
{
    has $_ => (
        is       => 'ro',
        required => 1,
    );

}

has url => (
    is => 'ro',
    required => 1,
    isa => sub {
        $_[0] =~ m|^/| or die "$_[0] is not a relative url. Should be /bucketname/file"
      },
);

has local_file => (
    is => 'ro',
    required => 0,
    predicate => 1,
);

has static_http_date => (
    is => 'ro',
    required => 0,
);

has s3_scheme_host_url => (
    is => 'ro',
    lazy => 1,
    default => sub {
        my $env_var = $ENV{AMAZON_S3CURL_PUREPERL_SCHEME_HOST};
        return $env_var if defined $env_var;
        return 'https://s3.amazonaws.com'
    }
);

sub http_date {
    POSIX::strftime( "%a, %d %b %Y %H:%M:%S +0000", gmtime );
}

sub _req {
    my ( $self, $method, $url ) = @_;
    die "method required" unless $method;
    $url ||= $self->url;
    my $to_sign  = $url;
    my $resource = sprintf( "%s%s" , $self->s3_scheme_host_url, $url );