view release on metacpan or  search on metacpan

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

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

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

  if ( ref $value ) {
    $value = _content_sub( ${$value}, $self->buffer_size );

    $headers->{'x-amz-content-sha256'} = 'UNSIGNED-PAYLOAD';
  }

  # If we're pushing to a bucket that's under
  # DNS flux, we might get a 307 Since LWP doesn't support actually
  # waiting for a 100 Continue response, we'll just send a HEAD first
  # to see what's going on
  my $retval = eval {
    return $self->_add_key(
      { headers => $headers,
        data    => $value,
        key     => $key,
      },
    );
  };

  # one more try? if someone specified the wrong region, we'll get a
  # 301 and you'll only know the region of redirection - no location
  # header provided...
  if ($EVAL_ERROR) {
    my $rsp = $account->last_response;

    if ( $rsp->code eq $HTTP_MOVED_PERMANENTLY ) {
      $self->region( $rsp->headers->{'x-amz-bucket-region'} );
    }

    $retval = $self->_add_key(
      { headers => $headers,
        data    => $value,
        key     => $key,
      },
    );
  }

  return $retval;
}

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

  my ( $data, $headers, $key ) = @{ $args[0] }{qw{data headers key}};

  my $account = $self->account;

  if ( ref $data ) {