view release on metacpan or  search on metacpan

t/01-api.t  view on Meta::CPAN

    shift @key_list;
    shift @key_list;

    ######################################################################
    # delete array of keys - next two keys
    #####################################################################
    $delete_rsp
      = $bucket_obj->delete_keys( map { $_->{key} } @key_list[ ( 0, 1 ) ] );

    ok( $delete_rsp, 'delete_keys() response' );

    $response = $bucket_obj->list
      or die $s3->err . ': ' . $s3->errstr;

    is( scalar @{ $response->{keys} }, -2 + scalar(@key_list), 'delete array of keys' );

    shift @key_list;
    shift @key_list;

    ######################################################################
    # callback - last two keys
    ######################################################################
    $delete_rsp = $bucket_obj->delete_keys(
      sub {
        my $key = shift @key_list;
        return ( $key->{key} );
      }
    );

    ok( $delete_rsp, 'delete_keys() response' );

    $response = $bucket_obj->list
      or die $s3->err . ': ' . $s3->errstr;

    is( scalar @{ $response->{keys} }, 0, 'delete keys from callback' )
      or diag( Dumper( [ response => $response, key_list => \@key_list ] ) );

    #
    # delete multiple keys from bucket
    ######################################################################
  }

  SKIP: {
    if ( $ENV{AMAZON_S3_KEEP_BUCKET} ) {
      skip 'keeping bucket', 1;
    }

    ok( $bucket_obj->delete_bucket(), 'delete bucket' );
  }
}

# see more docs in Amazon::S3::Bucket

# local test methods
########################################################################
sub is_request_response_code {
########################################################################
  my ( $url, $code, $message ) = @_;

  my $request = HTTP::Request->new( 'GET', $url );

  my $response = $s3->ua->request($request);

  is( $response->code, $code, $message )
    or diag( Dumper( [ response_code => $response ] ) );

  return;
}

########################################################################
sub like_acl_allusers_read {
########################################################################
  my ( $bucket_obj, $keyname, $dump ) = @_;

  my $message = acl_allusers_read_message( 'like', $bucket_obj, $keyname );

  my $acl = $bucket_obj->get_acl($keyname);

  diag( Dumper( [ acl => $acl ] ) )
    if $dump;

  like( $acl, qr/AllUsers.+READ/xsm, $message )
    or diag( Dumper( [ acl => $acl ] ) );

  return;
}

########################################################################
sub unlike_acl_allusers_read {
########################################################################
  my ( $bucket_obj, $keyname ) = @_;

  my $message = acl_allusers_read_message( 'unlike', $bucket_obj, $keyname );

  my $acl = $bucket_obj->get_acl($keyname);

  unlike( $bucket_obj->get_acl($keyname), qr/AllUsers.+READ/xsm, $message )
    or diag( Dumper( [ acl => $acl ] ) );

  return;
}

########################################################################
sub acl_allusers_read_message {
########################################################################
  my ( $like_or_unlike, $bucket_obj, $keyname ) = @_;

  my $message = sprintf '%s_acl_allusers_read: %s', $like_or_unlike, $bucket_obj->bucket;

  if ($keyname) {
    $message .= " - $keyname";
  }

  return $message;
}

########################################################################
sub acl_xml_from_acl_short {
########################################################################
  my ($acl_short) = @_;