AWS-S3

 view release on metacpan or  search on metacpan

README.markdown  view on Meta::CPAN

        warn "\tSize: ", $file->size, "\n";
        warn "\tETag: ", $file->etag, "\n";
        warn "\tContents: ", ${ $file->contents }, "\n";
      }# end foreach()
    }# end while()

    # You can't delete a bucket until it's empty.
    # Empty a bucket like this:
    while( my @files = $iterator->next_page )
    {
      map { $_->delete } @files;

      # Return to page 1:
      $iterator->page_number( 1 );
    }# end while()

    # Now you can delete the bucket:
    $bucket->delete();

# DESCRIPTION

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

    my @buckets = ();
    foreach my $node ( $xml->getElementsByLocalName( 'Bucket' ) ) {
        push @buckets,
          AWS::S3::Bucket->new(
            name          => $node->getElementsByLocalName('Name')->string_value,
            creation_date => $node->getElementsByLocalName('CreationDate')->string_value,
            s3            => $s,
          );
    }    # end foreach()

    $LOG->debug('Listed AWS buckets', { buckets => [map $_->name, @buckets] });
    return @buckets;
}    # end buckets()

sub bucket {
    my ( $s, $name ) = @_;

    my ( $bucket ) = grep { $_->name eq $name } $s->buckets
      or return;
    $bucket;
}    # end bucket()

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

      warn "\tSize: ", $file->size, "\n";
      warn "\tETag: ", $file->etag, "\n";
      warn "\tContents: ", ${ $file->contents }, "\n";
    }# end foreach()
  }# end while()

  # You can't delete a bucket until it's empty.
  # Empty a bucket like this:
  while( my @files = $iterator->next_page )
  {
    map { $_->delete } @files;

    # Return to page 1:
    $iterator->page_number( 1 );
  }# end while()

  # Now you can delete the bucket:
  $bucket->delete();

=head1 DESCRIPTION

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

    lazy     => 1,
    clearer  => '_clear_acl',
    default  => sub {
        my $self = shift;
        my $type = 'GetBucketAccessControl';
        return $self->_get_property( $type )->response->decoded_content();
    },
    trigger  => sub {
        my ( $self, $new_val, $old_val ) = @_;

        my %shorts = map { $_ => undef } qw(
          private public-read public-read-write authenticated-read
        );

        my %acl = ();
        if ( $new_val =~ m{<} ) {
            $acl{acl_xml} = $new_val;
        }
        elsif ( exists $shorts{$new_val} ) {
            $acl{acl_short} = $new_val;
        }

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

=head2 delete_multi( \@keys )

Given an ArrayRef of the keys you want to delete, C<delete_multi> can only delete
up to 1000 keys at once.  Empty your buckets for deletion quickly like this:

  my $deleted = 0;
  my $bucket = $s->bucket( 'foobar' );
  my $iter = $bucket->files( page_size => 1000, page_number => 1 );
  while( my @files = $iter->next_page )
  {
    $bucket->delete_multi( map { $_->key } @files );
    $deleted += @files;
    # Reset to page 1:
    $iter->page_number( 1 );
    warn "Deleted $deleted files so far\n";
  }# end while()
  
  # NOW you can delete your bucket (if you want) because it's empty:
  $bucket->delete;

=head1 SEE ALSO

lib/AWS/S3/FileIterator.pm  view on Meta::CPAN

        }    # end while()
    }    # end if()

    my @chunk = ();
    while ( my $item = $s->_next() ) {
        next unless $item->{key} =~ $s->pattern;
        push @chunk, $item;
        last if @chunk == $s->page_size;
    }    # end while()

    my @out = map {
        my $owner = AWS::S3::Owner->new( %{ $_->{owner} } );
        delete $_->{owner};
        AWS::S3::File->new( %$_, owner => $owner );
    } @chunk;

    $s->{page_number}++;

    return unless @out;
    wantarray ? @out : \@out;
}    # end next_page()

lib/AWS/S3/Request/DeleteMulti.pm  view on Meta::CPAN

    default  => 'delete'
);



has '+_expect_nothing' => ( default => 0 );

sub request {
    my $s = shift;

    my $objects = join "\n", map { "<Object><Key>@{[ $_ ]}</Key></Object>" } @{ $s->keys };

    my $xml = <<"XML";
<?xml version="1.0" encoding="UTF-8"?>
<Delete>
$objects
</Delete>
XML

    my $signer = AWS::S3::Signer->new(
        s3           => $s->s3,

lib/AWS/S3/Roles/Request.pm  view on Meta::CPAN

);

sub _send_request {
    my ( $s, $method, $uri, $headers, $content ) = @_;
    $LOG->debug('Making AWS request', {method => $method, uri => "$uri"});

    my $req = HTTP::Request->new( $method => $uri );
    $req->content( $content ) if $content;

    delete($headers->{Authorization}); # we will use a v4 signature
    map { $req->header( $_ => $headers->{$_} ) } keys %$headers;

    $s->_sign($req);
    my $res = $s->s3->ua->request( $req );

    # After creating a bucket and setting its location constraint, we get this
    # strange 'TemporaryRedirect' response.  Deal with it.
    if ( $res->header( 'location' ) && $res->content =~ m{>TemporaryRedirect<}s ) {
        $req->uri( $res->header( 'location' ) );
        $res = $s->s3->ua->request( $req );
    }

lib/AWS/S3/Signer.pm  view on Meta::CPAN

                $out{$k} = [ $out{$k} ] unless ref( $out{$k} );
                push @{ $out{$k} }, $v;
            } else {
                $out{$k} = $v;
            }    # end if()
        }    # end while()

        my @parts = ();
        while ( my ( $k, $v ) = each %out ) {
            if ( ref( $out{$k} ) ) {
                push @parts, _trim( $k ) . ':' . join( ',', map { _trim( $_ ) } @{ $out{$k} } );
            } else {
                push @parts, _trim( $k ) . ':' . _trim( $out{$k} );
            }    # end if()
        }    # end while()

        return join "\n", @parts;
    }
);

has 'canonicalized_resource' => (

lib/AWS/S3/Signer/V4.pm  view on Meta::CPAN

    if (scalar(@params) == 0 && defined($uri->query) && $uri->query ne '') {
        push @params, ($uri->query, '');
    }

    my %canonical;
    while ( my ( $key, $value ) = splice( @params, 0, 2 ) ) {
        $key   = uri_escape($key);
        $value = uri_escape($value);
        push @{ $canonical{$key} }, $value;
    }
    my $canonical_query_string = join '&', map {
        my $key = $_;
        map { "$key=$_" } sort @{ $canonical{$key} }
    } sort keys %canonical;

    # canonicalize the request headers
    my ( @canonical, %signed_fields );
    for my $header ( sort map { lc } $headers->header_field_names ) {
        next if $header =~ /^date$/i;
        my @values = $headers->header($header);

        # remove redundant whitespace
        foreach (@values) {
            next if /^".+"$/;
            s/^\s+//;
            s/\s+$//;
            s/(\s)\s+/$1/g;
        }
        push @canonical, "$header:" . join( ',', @values );
        $signed_fields{$header}++;
    }
    my $canonical_headers = join "\n", @canonical;
    $canonical_headers .= "\n";
    my $signed_headers = join ';', sort map { lc } keys %signed_fields;

    my $canonical_request = join( "\n",
        $method,            $path,           $canonical_query_string,
        $canonical_headers, $signed_headers, $hashed_payload );
    my $request_digest = sha256_hex($canonical_request);

    return ( $request_digest, $signed_headers );
}

sub _string_to_sign {

t/010_basic.t  view on Meta::CPAN

#    BIG_ITER: {
#      my @files = $iter->next_page;
#      for( 106..116 )
#      {
#        my $file = shift(@files);
#        is $file->key, "bar/baz/foo.$_.txt", "file $_ is what we expected";
#      }# end for()
#    };
    
    # Delete the files:
    ok($bucket->delete_multi( map { $_ } sort keys %info ), 'bucket.delete_multi(@keys)' );
    
    # Now make sure that not a single one still exists:
    foreach( sort keys %info )
    {
      ok ! eval {$bucket->file($_)}, "bucket(@{[ $bucket->name ]}).file($_) doesn't exist";
    }# end foreach()
#    map {
#      ok $bucket->file($_)->delete && ! $bucket->file($_), "bucket.file($_).delete worked"
#    } sort keys %info;
  };
  
  
  # proof content type reading and writing
  CONTENT_TYPE: {
    
    foreach my $ct( qw( text/plain image/jpeg application/zip ) ) {
      

t/010_basic.t  view on Meta::CPAN

sub cleanup
{
  warn "\nCleaning Up...\n";
  foreach my $bucket ( grep { $_->name =~ m{^(aws-s3-test\-\d+).+?foo$} } $s3->buckets )
  {
    warn "Bucket: ", $bucket->name, "\n";
    my $iter = $bucket->files( page_size => 100, page_number => 1 );
    while( my @files = $iter->next_page )
    {
$bucket->delete_multi( map { $_->key } @files );
#      foreach my $file ( @files )
#      {
#        warn "\tdelete: ", $file->key, "\n";
#        eval { $file->delete };
#      }# end foreach()
      $iter->page_number( 1 );
    }# end while()
    eval { $bucket->delete };
    $@ && do { warn $@ };
    warn "\n";

t/aws/s3/file_iterator.t  view on Meta::CPAN

    'AWS::S3::Bucket'
);

foreach my $args (
    [qw( page_size page_number )],
    [qw( bucket page_number )],
    [qw( bucket page_size )],
)
{
    throws_ok {
        AWS::S3::FileIterator->new( map { $_ => 1 } @$args );
    }
    qr/Required argument/, 'dies when arg is missing';
}

{
    isa_ok(
        my $iterator = AWS::S3::FileIterator->new(
            page_number => 2,
            page_size   => 1,
            bucket      => $bucket,