view release on metacpan or  search on metacpan

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

package Amazon::S3;

use strict;
use warnings;

use Amazon::S3::Bucket;
use Amazon::S3::BucketV2;
use Amazon::S3::Constants qw(:all);

use Amazon::S3::Util qw(
  set_md5_header
  urlencode
  get_parameters
  create_xml_request
  create_api_uri
  create_query_string
);

use Amazon::S3::Logger;
use Amazon::S3::Signature::V4;

use Carp;
use Data::Dumper;
use Digest::HMAC_SHA1;
use Digest::MD5 qw(md5_hex);
use English     qw(-no_match_vars);
use HTTP::Date;
use LWP::UserAgent::Determined;
use List::Util   qw( any pairs none );
use MIME::Base64 qw(encode_base64 decode_base64);
use Scalar::Util qw( reftype blessed );
use URI;
use XML::Simple;

use parent qw(Class::Accessor::Fast Exporter);

__PACKAGE__->mk_accessors(
  qw(
    aws_access_key_id
    aws_secret_access_key
    token
    buffer_size
    cache_signer
    credentials
    dns_bucket_names
    digest
    err
    errstr
    error
    express
    host
    last_request
    last_response
    logger
    log_level
    retry
    _region
    secure
    _signer
    timeout
    ua
  ),
);

our $VERSION = '2.0.2'; ## no critic (RequireInterpolation)

our @EXPORT_OK = qw(is_domain_bucket);

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

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

  $options{timeout}          //= $DEFAULT_TIMEOUT;
  $options{secure}           //= $TRUE;
  $options{host}             //= $DEFAULT_HOST;
  $options{dns_bucket_names} //= $TRUE;
  $options{cache_signer}     //= $FALSE;
  $options{retry}            //= $FALSE;
  $options{express}          //= $FALSE;

  $options{_region} = delete $options{region};
  $options{_signer} = delete $options{signer};

  # convenience for level => 'debug' & for consistency with
  # Amazon::Credentials only do this if we are using internal logger,
  # call should NOT use debug flag but rather use their own logger's
  # level to turn on higher levels of logging...

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

  return $buf;
}

########################################################################
sub _trim {
########################################################################
  my ( $self, $value ) = @_;

  $value =~ s/^\s+//xsm;
  $value =~ s/\s+$//xsm;

  return $value;
}

# finds the hmac-sha1 hash of the canonical string and the aws secret access key and then
# base64 encodes the result (optionally urlencoding after that).
########################################################################
sub _encode {
########################################################################
  my ( $self, $aws_secret_access_key, $str, $urlencode ) = @_;

  my $hmac = Digest::HMAC_SHA1->new($aws_secret_access_key);
  $hmac->add($str);

  my $b64 = encode_base64( $hmac->digest, $EMPTY );

  return $urlencode ? urlencode($b64) : return $b64;
}

########################################################################
sub bucketv2 {
########################################################################
  my ( $self, @args ) = @_;

  my $parameters = get_parameters(@args);

  my ( $bucketname, $region, $verify_region )
    = @{$parameters}{qw(bucket region verify_region)};

  # only set to default region if a region wasn't passed or region
  # verification not requested
  if ( !$region && !$verify_region ) {
    $region = $self->region;
  }

  return Amazon::S3::BucketV2->new(
    { bucket        => $bucketname,
      account       => $self,
      region        => $region,
      verify_region => $verify_region,
    },
  );
}

########################################################################
sub delete_public_access_block {
########################################################################
  my ( $self, $bucket ) = @_;

  my $bucketv2 = bless $bucket, 'Amazon::S3::BucketV2';

  return $bucketv2->DeletePublicAccessBlock;
}

1;

__END__

=pod

=head1 NAME

Amazon::S3 - A portable client library for working with and
managing Amazon S3 buckets and keys.

=begin markdown

![Amazon::S3](https://github.com/rlauer6/perl-amazon-s3/actions/workflows/build.yml/badge.svg?event=push)

=end markdown

=head1 SYNOPSIS

  use Amazon::S3;
  
  my $aws_access_key_id     = "Fill me in!";
  my $aws_secret_access_key = "Fill me in too!";
  
  my $s3 = Amazon::S3->new(
      {   aws_access_key_id     => $aws_access_key_id,
          aws_secret_access_key => $aws_secret_access_key,
          retry                 => 1
      }
  );
  
  my $response = $s3->buckets;
  
  # create a bucket
  my $bucket_name = $aws_access_key_id . '-net-amazon-s3-test';

  my $bucket = $s3->add_bucket( { bucket => $bucket_name } )
      or die $s3->err . ": " . $s3->errstr;
  
  # store a key with a content-type and some optional metadata
  my $keyname = 'testing.txt';

  my $value   = 'T';

  $bucket->add_key(
      $keyname, $value,
      {   content_type        => 'text/plain',
          'x-amz-meta-colour' => 'orange',
      }
  );

  # copy an object
  $bucket->copy_object(
    source => $source,
    key    => $new_keyname
  );