Amazon-S3

 view release on metacpan or  search on metacpan

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

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} );

    $conf->{'x-amz-acl'} = $conf->{acl_short};

    delete $conf->{acl_short};
  }

  $headers = { %{$conf}, %{$headers} };

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

# Upload a part of a file as part of a multipart upload operation
# Each part must be at least 5mb (except for the last piece).
# This returns the Amazon-generated eTag for the uploaded file segment.
# It is necessary to keep track of the eTag for each part number
# The complete operation will want a sequential list of all the part
# numbers along with their eTags.
#
########################################################################
sub upload_part_of_multipart_upload {
########################################################################
  my ( $self, @args ) = @_;

  my ( $key, $upload_id, $part_number, $data, $length );

  if ( @args == 1 ) {
    if ( reftype( $args[0] ) eq 'HASH' ) {
      ( $key, $upload_id, $part_number, $data, $length )
        = @{ $args[0] }{qw{ key id part data length}};
    }
    elsif ( reftype( $args[0] ) eq 'ARRAY' ) {
      ( $key, $upload_id, $part_number, $data, $length ) = @{ $args[0] };
    }
  }
  else {
    ( $key, $upload_id, $part_number, $data, $length ) = @args;
  }

  # argh...wish we didn't have to do this!
  if ( ref $data ) {
    $data = ${$data};
  }

  $length = $length || length $data;

  croak 'Object key is required'
    if !$key;

  croak 'Upload id is required'
    if !$upload_id;

  croak 'Part Number is required'
    if !$part_number;

  my $headers = {};
  my $acct    = $self->account;

  set_md5_header( data => $data, headers => $headers );

  my $path = create_api_uri(
    path       => $self->_uri($key),
    partNumber => ${part_number},
    uploadId   => ${upload_id}
  );

  my $params = $QUESTION_MARK
    . create_query_string(
    partNumber => ${part_number},
    uploadId   => ${upload_id}
    );

  $self->logger->debug(
    sub {
      return Dumper(
        [ part   => $part_number,
          length => length $data,
          path   => $path,
        ]
      );
    }
  );

  my $request = $acct->_make_request(
    { region => $self->region,
      method => 'PUT',
      path   => $self->_uri($key) . $params,
      #path    => $path,
      headers => $headers,
      data    => $data,
    },
  );

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

  $acct->_croak_if_response_error($response);

  # We'll need to save the etag for later when completing the transaction
  my $etag = $response->header('ETag');

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

  return $etag;
}

#
# Inform Amazon that the multipart upload has been completed
# You must supply a hash of part Numbers => eTags
# For amazon to use to put the file together on their servers.
#
########################################################################
sub complete_multipart_upload {
########################################################################
  my ( $self, $key, $upload_id, $parts_hr ) = @_;

  $self->logger->debug( Dumper( [ $key, $upload_id, $parts_hr ] ) );

  croak 'Object key is required'
    if !$key;

  croak 'Upload id is required'
    if !$upload_id;

  croak 'Part number => etag hashref is required'
    if ref $parts_hr ne 'HASH';

  # The complete command requires sending a block of xml containing all
  # the part numbers and their associated etags (returned from the upload)
  my $content = _create_multipart_upload_request($parts_hr);

  $self->logger->debug("content: \n$content");

  my $md5        = md5($content);
  my $md5_base64 = encode_base64($md5);
  chomp $md5_base64;

  my $headers = {
    'Content-MD5'    => $md5_base64,
    'Content-Length' => length $content,
    'Content-Type'   => 'application/xml',
  };

  my $acct   = $self->account;
  my $params = "?uploadId=${upload_id}";

  my $request = $acct->_make_request(
    { region  => $self->region,
      method  => 'POST',
      path    => $self->_uri($key) . $params,
      headers => $headers,
      data    => $content,
    },
  );

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

  if ( $response->code !~ /\A2\d\d\z/xsm ) {
    $acct->_remember_errors( $response->content, 1 );
    croak $response->status_line;
  }

  return $TRUE;
}

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

  croak 'Object key is required'
    if !$key;

  croak 'Upload id is required'
    if !$upload_id;

  my $acct   = $self->account;
  my $params = "?uploadId=${upload_id}";

  my $request = $acct->_make_request(
    { region => $self->region,
      method => 'DELETE',
      path   => $self->_uri($key) . $params,
    },
  );

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

  $acct->_croak_if_response_error($response);

  return $TRUE;
}

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

      {   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.