File: 02client.t

package info (click to toggle)
libnet-amazon-s3-perl 0.56-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 288 kB
  • sloc: perl: 2,264; makefile: 7
file content (262 lines) | stat: -rw-r--r-- 7,568 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
#!perl
use warnings;
use strict;
use lib 'lib';
use Digest::MD5::File qw(file_md5_hex);
use LWP::Simple;
use File::stat;
use Test::More;
use Test::Exception;

unless ( $ENV{'AMAZON_S3_EXPENSIVE_TESTS'} ) {
    plan skip_all => 'Testing this module for real costs money.';
} else {
    plan tests => 38;
}

use_ok('Net::Amazon::S3');

my $aws_access_key_id     = $ENV{'AWS_ACCESS_KEY_ID'};
my $aws_secret_access_key = $ENV{'AWS_ACCESS_KEY_SECRET'};

my $s3 = Net::Amazon::S3->new(
    aws_access_key_id     => $aws_access_key_id,
    aws_secret_access_key => $aws_secret_access_key,
    retry                 => 1,
);

my $readme_size   = stat('README')->size;
my $readme_md5hex = file_md5_hex('README');

my $client = Net::Amazon::S3::Client->new( s3 => $s3 );

my @buckets = $client->buckets;

TODO: {
    local $TODO = "These tests only work if you're leon";
    my $first_bucket = $buckets[0];
    like( $first_bucket->owner_id, qr/^46a801915a1711f/, 'have owner id' );
    is( $first_bucket->owner_display_name, '_acme_', 'have display name' );
    is( scalar @buckets, 10, 'have a bunch of buckets' );
}

my $bucket_name = 'net-amazon-s3-test-' . lc $aws_access_key_id;

my $bucket = $client->create_bucket(
    name                => $bucket_name,
    acl_short           => 'public-read',
    location_constraint => 'US',
);

is( $bucket->name, $bucket_name, 'newly created bucket has correct name' );

like(
    $bucket->acl,
    qr{<AccessControlPolicy xmlns="http://s3.amazonaws.com/doc/2006-03-01/"><Owner><ID>[a-z0-9]{64}</ID><DisplayName>.+?</DisplayName></Owner><AccessControlList><Grant><Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="CanonicalUser"><ID>[a-z0-9]{64}</ID><DisplayName>.+?</DisplayName></Grantee><Permission>FULL_CONTROL</Permission></Grant><Grant><Grantee xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:type="Group"><URI>http://acs.amazonaws.com/groups/global/AllUsers</URI></Grantee><Permission>READ</Permission></Grant></AccessControlList></AccessControlPolicy>},
    'newly created bucket is public-readable'
);

is( $bucket->location_constraint, 'US', 'newly created bucket is in the US' );

my $stream = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        $object->delete;
    }
}

my $count = 0;
$stream = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        $count++;
    }
}

is( $count, 0, 'newly created bucket has no objects' );

my $object = $bucket->object( key => 'this is the key' );

ok( !$object->exists, 'object does not exist yet' );

$object->put('this is the value');

ok( $object->exists, 'object now exists yet' );

my @objects;

@objects = ();
$stream = $bucket->list( { prefix => 'this is the key' } );
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}
is( @objects, 1, 'bucket list with prefix finds key' );

@objects = ();
$stream = $bucket->list( { prefix => 'this is not the key' } );
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}
is( @objects, 0, 'bucket list with different prefix does not find key' );

@objects = ();
$stream  = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}
is( @objects, 1, 'bucket list finds newly created key' );

is( $objects[0]->key,
    'this is the key',
    'newly created object has the right key'
);
is( $objects[0]->etag,
    '94325a12f8db22ffb6934cc5f22f6698',
    'newly created object has the right etag'
);
is( $objects[0]->size, '17', 'newly created object has the right size' );

is( $object->get,
    'this is the value',
    'newly created object has the right value'
);

is( $bucket->object( key => 'this is the key' )->get,
    'this is the value',
    'newly created object fetched by name has the right value'
);

is( get( $object->uri ),
    undef, 'newly created object cannot be fetched by uri' );

$object->expires('2037-01-01');

is( get( $object->query_string_authentication_uri() ),
    'this is the value',
    'newly created object can be fetch by authentication uri'
);

$object->delete;

# upload a public object
$object = $bucket->object(
    key              => 'this is the public key',
    acl_short        => 'public-read',
    content_type     => 'text/plain',
    content_encoding => 'identity',
    expires          => '2001-02-03',
);
$object->put('this is the public value');
is( get( $object->uri ),
    'this is the public value',
    'newly created public object is publically accessible'
);
is( ( head( $object->uri ) )[0],
    'text/plain', 'newly created public object has the right content type' );
is( ( head( $object->uri ) )[3],
    $object->expires->epoch,
    'newly created public object has the right expires' );
$object->delete;

# delete a non-existant object

$object = $bucket->object( key => 'not here' );
throws_ok { $object->get } qr/NoSuchKey/,
    'getting non-existant object throws exception';

# upload a file with put_filename

$object = $bucket->object( key => 'the readme' );
$object->put_filename('README');

@objects = ();
$stream  = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}

is( @objects, 1, 'have newly uploaded object' );
is( $objects[0]->key, 'the readme',
    'newly uploaded object has the right key' );
is( $objects[0]->etag, $readme_md5hex,
    'newly uploaded object has the right etag' );
is( $objects[0]->size, $readme_size,
    'newly created object has the right size' );

ok( $objects[0]->last_modified, 'newly created object has a last modified' );

$object->delete;

# upload a public object with put_filename

$object = $bucket->object(
    key       => 'the public readme',
    acl_short => 'public-read'
);
$object->put_filename('README');
is( length( get( $object->uri ) ),
    $readme_size, 'newly uploaded public object has the right size' );
$object->delete;

# upload a file with put_filename with known md5hex and size

$object = $bucket->object(
    key  => 'the new readme',
    etag => $readme_md5hex,
    size => $readme_size
);
$object->put_filename('README');

@objects = ();
$stream  = $bucket->list;
until ( $stream->is_done ) {
    foreach my $object ( $stream->items ) {
        push @objects, $object;
    }
}

is( @objects, 1, 'have newly uploaded object' );
is( $objects[0]->key,
    'the new readme',
    'newly uploaded object has the right key'
);
is( $objects[0]->etag, $readme_md5hex,
    'newly uploaded object has the right etag' );
is( $objects[0]->size, $readme_size,
    'newly created object has the right size' );
ok( $objects[0]->last_modified, 'newly created object has a last modified' );

# download an object with get_filename

if ( -f 't/README' ) {
    unlink('t/README') || die $!;
}

$object->get_filename('t/README');
is( stat('t/README')->size,   $readme_size,   'download has right size' );
is( file_md5_hex('t/README'), $readme_md5hex, 'download has right etag' );

$object->delete;

# upload a public object with put_filename with known md5hex and size
$object = $bucket->object(
    key       => 'the new public readme',
    etag      => $readme_md5hex,
    size      => $readme_size,
    acl_short => 'public-read'
);
$object->put_filename( 'README', $readme_md5hex, $readme_size );
is( length( get( $object->uri ) ),
    $readme_size, 'newly uploaded public object has the right size' );
$object->delete;

$bucket->delete;