Amazon-S3

 view release on metacpan or  search on metacpan

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

package Amazon::S3::Bucket;

use strict;
use warnings;

use Amazon::S3::Constants qw(:all);
use Amazon::S3::Util      qw(:all);

use Carp;
use Data::Dumper;
use Digest::MD5       qw(md5 md5_hex);
use Digest::MD5::File qw(file_md5 file_md5_hex);
use English           qw(-no_match_vars);
use File::stat;
use IO::File;
use IO::Scalar;
use MIME::Base64;
use List::Util   qw(none pairs);
use Scalar::Util qw(reftype);
use URI;
use XML::Simple; ## no critic (DiscouragedModules)

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

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

__PACKAGE__->mk_accessors(
  qw(
    bucket
    creation_date
    account
    buffer_size
    region
    logger
    verify_region
  ),
);

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

  my $options = get_parameters(@args);

  $options->{buffer_size} ||= $DEFAULT_BUFFER_SIZE;

  my $self = $class->SUPER::new($options);

  croak 'no bucket'
    if !$self->bucket;

  croak 'no account'
    if !$self->account;

  if ( !$self->logger ) {
    $self->logger( $self->account->get_logger );
  }

  # now each bucket maintains its own region
  if ( !$self->region && $self->verify_region ) {
    my $region;

    if ( !$self->account->err ) {
      $region = $self->get_location_constraint() // 'us-east-1';
    }

    $self->logger->debug( sprintf "bucket: %s region: %s\n",
      $self->bucket, ( $region // $EMPTY ) );

    $self->region($region);
  }
  elsif ( !$self->region ) {
    $self->region( $self->account->region );
  }

  return $self;
}

########################################################################
sub _uri {
########################################################################
  my ( $self, $key ) = @_;

  if ($key) {
    $key =~ s/^\///xsm;
  }

  my $account = $self->account;

  my $uri = $self->bucket . $SLASH;

  if ($key) {
    $uri .= urlencode($key);
  }

  if ( $account->dns_bucket_names ) {
    $uri =~ s/^\///xsm;
  }

  return $uri;
}

########################################################################
sub add_key {
########################################################################
  my ( $self, $key, $value, $conf ) = @_;

  croak 'must specify key'
    if !$key || !length $key;

  $conf //= {};

  my $account = $self->account;

  my $headers = delete $conf->{headers};
  $headers //= {};

  if ( $conf->{acl_short} ) {
    $account->_validate_acl_short( $conf->{acl_short} );

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

    headers    => $headers,
    uri_params => $uri_params,
  );
}

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

  my $parameters = get_parameters(@args);

  my ( $key, $method, $filename, $headers, $uri_params )
    = @{$parameters}{qw(key method filename headers uri_params)};

  $method //= 'GET';

  my $uri = $self->_uri($key);

  if ( $uri_params && keys %{$uri_params} ) {
    $uri = $QUESTION_MARK . create_query_string($uri_params);
  }

  if ( ref $filename ) {
    $filename = ${$filename};
  }

  my $acct = $self->account;

  my $request = $acct->_make_request(
    { region  => $self->region,
      method  => $method,
      path    => $uri,
      headers => $headers,
    },
  );

  my $response = $acct->_do_http( $request, $filename );

  return
    if $response->code eq $HTTP_NOT_FOUND;

  $acct->_croak_if_response_error($response);

  my $etag = $response->header('ETag');

  if ($etag) {
    $etag =~ s/^"//xsm;
    $etag =~ s/"$//xsm;
  }

  my $retval = {
    content_length => ( $response->content_length || 0 ),
    content_type   => scalar $response->content_type,
    etag           => $etag,
    value          => ( $response->content // $EMPTY ),
    content_range  => ( $response->header('Content-Range') || $EMPTY ),
    last_modified  => ( $response->header('Last-Modified') || $EMPTY ),
  };

  # Validate against data corruption by verifying the MD5 (only if not partial)
  if ( $method eq 'GET' && $response->code ne $HTTP_PARTIAL_CONTENT ) {
    my $md5
      = ( $filename and -f $filename )
      ? file_md5_hex($filename)
      : md5_hex( $retval->{value} );

    # Some S3-compatible providers return an all-caps MD5 value in the
    # etag so it should be lc'd for comparison.
    croak "Computed and Response MD5's do not match:  $md5 : $etag"
      if $md5 ne lc $etag;
  }

  foreach my $header ( $response->headers->header_field_names ) {
    next if $header !~ /x-amz-meta-/ixsm;
    $retval->{ lc $header } = $response->header($header);
  }

  return $retval;
}

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

  my ( $key, $method, $filename, $headers, $uri_params );

  if ( ref $args[0] ) {
    ( $key, $method, $filename, $headers, $uri_params )
      = @{ $args[0] }{qw(key method filename headers uri_params)};
  }
  else {
    ( $key, $method, $filename, $headers, $uri_params ) = @args;
  }

  if ( !defined $filename ) {
    $filename = $key;
  }

  return $self->_get_key(
    key        => $key,
    method     => $method,
    filename   => \$filename,
    headers    => $headers,
    uri_params => $uri_params,
  );
}

########################################################################
# See: https://docs.aws.amazon.com/AmazonS3/latest/API/API_CopyObject.html
#
# Note that in this request the bucket object is the destination you
# specify the source bucket in the key (bucket-name/source-key) or the
# header x-amz-copy-source
########################################################################
sub copy_object {
########################################################################
  my ( $self, @args ) = @_;

  my $parameters = get_parameters(@args);

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

  use Amazon::S3;
  
  # creates bucket object (no "bucket exists" check)
  my $bucket = $s3->bucket("foo"); 
  
  # create resource with meta data (attributes)
  my $keyname = 'testing.txt';
  my $value   = 'T';
  $bucket->add_key(
      $keyname, $value,
      {   content_type        => 'text/plain',
          'x-amz-meta-colour' => 'orange',
      }
  );
  
  # list keys in the bucket
  $response = $bucket->list
      or die $s3->err . ": " . $s3->errstr;
  print $response->{bucket}."\n";
  for my $key (@{ $response->{keys} }) {
        print "\t".$key->{key}."\n";  
  }

  # check if resource exists.
  print "$keyname exists\n" if $bucket->head_key($keyname);

  # delete key from bucket
  $bucket->delete_key($keyname);

=head1 DESCRIPTION

Class for interacting with AWS S3 buckets.

=head1 METHODS AND SUBROUTINES

=head2 new

Instaniates a new bucket object. 

Pass a hash or hash reference containing various options:

=over

=item bucket (required)

The name (identifier) of the bucket.

=item account (required)

The L<S3::Amazon> object (representing the S3 account) this
bucket is associated with.

=item buffer_size

The buffer size used for reading and writing objects to S3.

default: 4K

=item region

If no region is set and C<verify_region> is set to true, the region of
the bucket will be determined by calling the
C<get_location_constraint> method.  Note that this will decrease
performance of the constructor. If you know the region or are
operating in only 1 region, set the region in the C<account> object
(C<Amazon::S3>).

=item logger

Sets the logger.  The logger should be a blessed reference capable of
providing at least a C<debug> and C<trace> method for recording log
messages. If no logger object is passed the C<account> object's logger
object will be used.

=item verify_region

Indicates that the bucket's region should be determined by calling the
C<get_location_constraint> method.

default: false

=back

I<NOTE:> This method does not check if a bucket actually exists unless
you set C<verify_region> to true. If the bucket does not exist,
the constructor will set the region to the default region specified by
the L<Amazon::S3> object (C<account>) that you passed.

Typically a developer will not call this method directly,
but work through the interface in L<S3::Amazon> that will
handle their creation.

=head2 add_key

 add_key( key, value, configuration)

Write a new or existing object to S3.

=over

=item key

A string identifier for the object being written to the bucket.

=item value

A SCALAR string representing the contents of the object.

=item configuration

A HASHREF of configuration data for this key. The configuration
is generally the HTTP headers you want to pass to the S3
service. The client library will add all necessary headers.
Adding them to the configuration hash will override what the
library would send and add headers that are not typically
required for S3 interactions.

=item acl_short (optional)

In addition to additional and overriden HTTP headers, this
HASHREF can have a C<acl_short> key to set the permissions
(access) of the resource without a seperate call via
C<add_acl> or in the form of an XML document.  See the
documentation in C<add_acl> for the values and usage. 

=back

Returns a boolean indicating the sucess or failure of the call. Check
C<err> and C<errstr> for error messages if this operation fails. To
examine the raw output of the response from the API call, use the
C<last_response()> method.

  my $retval = $bucket->add_key('foo', $content, {});

  if ( !$retval ) {
    print STDERR Dumper([$bucket->err, $bucket->errstr, $bucket->last_response]);
  }

=head2 add_key_filename

The method works like C<add_key> except the value is assumed
to be a filename on the local file system. The file will 
be streamed rather then loaded into memory in one big chunk.

=head2 copy_object %parameters