line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package AWS::S3; |
3
|
|
|
|
|
|
|
|
4
|
6
|
|
|
6
|
|
83330
|
use Moose; |
|
6
|
|
|
|
|
616700
|
|
|
6
|
|
|
|
|
39
|
|
5
|
6
|
|
|
6
|
|
29205
|
use Carp 'confess'; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
315
|
|
6
|
6
|
|
|
6
|
|
3127
|
use LWP::UserAgent::Determined; |
|
6
|
|
|
|
|
109671
|
|
|
6
|
|
|
|
|
144
|
|
7
|
6
|
|
|
6
|
|
39
|
use HTTP::Response; |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
88
|
|
8
|
6
|
|
|
6
|
|
2838
|
use HTTP::Request::Common; |
|
6
|
|
|
|
|
9438
|
|
|
6
|
|
|
|
|
344
|
|
9
|
6
|
|
|
6
|
|
2668
|
use IO::Socket::INET; |
|
6
|
|
|
|
|
84400
|
|
|
6
|
|
|
|
|
34
|
|
10
|
6
|
|
|
6
|
|
2354
|
use Class::Load 'load_class'; |
|
6
|
|
|
|
|
8
|
|
|
6
|
|
|
|
|
289
|
|
11
|
|
|
|
|
|
|
|
12
|
6
|
|
|
6
|
|
2470
|
use AWS::S3::ResponseParser; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use AWS::S3::Owner; |
14
|
|
|
|
|
|
|
use AWS::S3::Bucket; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.12'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
has [qw/access_key_id secret_access_key/] => ( is => 'ro', isa => 'Str' ); |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
has 'secure' => ( |
21
|
|
|
|
|
|
|
is => 'ro', |
22
|
|
|
|
|
|
|
isa => 'Bool', |
23
|
|
|
|
|
|
|
lazy => 1, |
24
|
|
|
|
|
|
|
default => 0 |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
has 'endpoint' => ( |
28
|
|
|
|
|
|
|
is => 'ro', |
29
|
|
|
|
|
|
|
isa => 'Str', |
30
|
|
|
|
|
|
|
lazy => 1, |
31
|
|
|
|
|
|
|
default => sub { 's3.amazonaws.com' }, |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
has 'ua' => ( |
35
|
|
|
|
|
|
|
is => 'ro', |
36
|
|
|
|
|
|
|
isa => 'LWP::UserAgent', |
37
|
|
|
|
|
|
|
default => sub { LWP::UserAgent::Determined->new } |
38
|
|
|
|
|
|
|
); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
sub request { |
41
|
|
|
|
|
|
|
my ( $s, $type, %args ) = @_; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $class = "AWS::S3::Request::$type"; |
44
|
|
|
|
|
|
|
load_class( $class ); |
45
|
|
|
|
|
|
|
return $class->new( %args, s3 => $s, type => $type ); |
46
|
|
|
|
|
|
|
} # end request() |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub owner { |
49
|
|
|
|
|
|
|
my $s = shift; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
my $type = 'ListAllMyBuckets'; |
52
|
|
|
|
|
|
|
my $request = $s->request( $type ); |
53
|
|
|
|
|
|
|
my $response = $request->request(); |
54
|
|
|
|
|
|
|
my $xpc = $response->xpc; |
55
|
|
|
|
|
|
|
return AWS::S3::Owner->new( |
56
|
|
|
|
|
|
|
id => $xpc->findvalue( '//s3:Owner/s3:ID' ), |
57
|
|
|
|
|
|
|
display_name => $xpc->findvalue( '//s3:Owner/s3:DisplayName' ), |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
} # end owner() |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub buckets { |
62
|
|
|
|
|
|
|
my ( $s ) = @_; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
my $type = 'ListAllMyBuckets'; |
65
|
|
|
|
|
|
|
my $request = $s->request( $type ); |
66
|
|
|
|
|
|
|
my $response = $request->request(); |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $xpc = $response->xpc; |
69
|
|
|
|
|
|
|
my @buckets = (); |
70
|
|
|
|
|
|
|
foreach my $node ( $xpc->findnodes( './/s3:Bucket' ) ) { |
71
|
|
|
|
|
|
|
push @buckets, |
72
|
|
|
|
|
|
|
AWS::S3::Bucket->new( |
73
|
|
|
|
|
|
|
name => $xpc->findvalue( './/s3:Name', $node ), |
74
|
|
|
|
|
|
|
creation_date => $xpc->findvalue( './/s3:CreationDate', $node ), |
75
|
|
|
|
|
|
|
s3 => $s, |
76
|
|
|
|
|
|
|
); |
77
|
|
|
|
|
|
|
} # end foreach() |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
return @buckets; |
80
|
|
|
|
|
|
|
} # end buckets() |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub bucket { |
83
|
|
|
|
|
|
|
my ( $s, $name ) = @_; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
my ( $bucket ) = grep { $_->name eq $name } $s->buckets |
86
|
|
|
|
|
|
|
or return; |
87
|
|
|
|
|
|
|
$bucket; |
88
|
|
|
|
|
|
|
} # end bucket() |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub add_bucket { |
91
|
|
|
|
|
|
|
my ( $s, %args ) = @_; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
my $type = 'CreateBucket'; |
94
|
|
|
|
|
|
|
my $request = $s->request( $type, bucket => $args{name}, location => $args{location} ); |
95
|
|
|
|
|
|
|
my $response = $request->request(); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
if ( my $msg = $response->friendly_error() ) { |
98
|
|
|
|
|
|
|
die $msg; |
99
|
|
|
|
|
|
|
} # end if() |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
return $s->bucket( $args{name} ); |
102
|
|
|
|
|
|
|
} # end add_bucket() |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
__END__ |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=pod |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 NAME |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
AWS::S3 - Lightweight interface to Amazon S3 (Simple Storage Service) |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=for html |
115
|
|
|
|
|
|
|
<a href='https://travis-ci.org/leejo/AWS-S3?branch=master'><img src='https://travis-ci.org/leejo/AWS-S3.svg?branch=master' /></a> |
116
|
|
|
|
|
|
|
<a href='https://coveralls.io/r/leejo/AWS-S3?branch=master'><img src='https://coveralls.io/repos/leejo/AWS-S3/badge.png?branch=master' alt='Coverage Status' /></a> |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 SYNOPSIS |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
use AWS::S3; |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
my $s3 = AWS::S3->new( |
123
|
|
|
|
|
|
|
access_key_id => 'E654SAKIASDD64ERAF0O', |
124
|
|
|
|
|
|
|
secret_access_key => 'LgTZ25nCD+9LiCV6ujofudY1D6e2vfK0R4GLsI4H', |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# Add a bucket: |
128
|
|
|
|
|
|
|
my $bucket = $s3->add_bucket( |
129
|
|
|
|
|
|
|
name => 'foo-bucket', |
130
|
|
|
|
|
|
|
); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# Set the acl: |
133
|
|
|
|
|
|
|
$bucket->acl( 'private' ); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
# Add a file: |
136
|
|
|
|
|
|
|
my $new_file = $bucket->add_file( |
137
|
|
|
|
|
|
|
key => 'foo/bar.txt', |
138
|
|
|
|
|
|
|
contents => \'This is the contents of the file', |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# You can also set the contents with a coderef: |
142
|
|
|
|
|
|
|
# Coderef should eturn a reference, not the actual string of content: |
143
|
|
|
|
|
|
|
$new_file = $bucket->add_file( |
144
|
|
|
|
|
|
|
key => 'foo/bar.txt', |
145
|
|
|
|
|
|
|
contents => sub { return \"This is the contents" } |
146
|
|
|
|
|
|
|
); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# Get the file: |
149
|
|
|
|
|
|
|
my $same_file = $bucket->file( 'foo/bar.txt' ); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# Get the contents: |
152
|
|
|
|
|
|
|
my $scalar_ref = $same_file->contents; |
153
|
|
|
|
|
|
|
print $$scalar_ref; |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# Update the contents with a scalar ref: |
156
|
|
|
|
|
|
|
$same_file->contents( \"New file contents" ); |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# Update the contents with a code ref: |
159
|
|
|
|
|
|
|
$same_file->contents( sub { return \"New file contents" } ); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Delete the file: |
162
|
|
|
|
|
|
|
$same_file->delete(); |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# Iterate through lots of files: |
165
|
|
|
|
|
|
|
my $iterator = $bucket->files( |
166
|
|
|
|
|
|
|
page_size => 100, |
167
|
|
|
|
|
|
|
page_number => 1, |
168
|
|
|
|
|
|
|
); |
169
|
|
|
|
|
|
|
while( my @files = $iterator->next_page ) |
170
|
|
|
|
|
|
|
{ |
171
|
|
|
|
|
|
|
warn "Page number: ", $iterator->page_number, "\n"; |
172
|
|
|
|
|
|
|
foreach my $file ( @files ) |
173
|
|
|
|
|
|
|
{ |
174
|
|
|
|
|
|
|
warn "\tFilename (key): ", $file->key, "\n"; |
175
|
|
|
|
|
|
|
warn "\tSize: ", $file->size, "\n"; |
176
|
|
|
|
|
|
|
warn "\tETag: ", $file->etag, "\n"; |
177
|
|
|
|
|
|
|
warn "\tContents: ", ${ $file->contents }, "\n"; |
178
|
|
|
|
|
|
|
}# end foreach() |
179
|
|
|
|
|
|
|
}# end while() |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
# You can't delete a bucket until it's empty. |
182
|
|
|
|
|
|
|
# Empty a bucket like this: |
183
|
|
|
|
|
|
|
while( my @files = $iterator->next_page ) |
184
|
|
|
|
|
|
|
{ |
185
|
|
|
|
|
|
|
map { $_->delete } @files; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# Return to page 1: |
188
|
|
|
|
|
|
|
$iterator->page_number( 1 ); |
189
|
|
|
|
|
|
|
}# end while() |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# Now you can delete the bucket: |
192
|
|
|
|
|
|
|
$bucket->delete(); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head1 DESCRIPTION |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
AWS::S3 attempts to provide an alternate interface to the Amazon S3 Simple Storage Service. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
B<NOTE:> Until AWS::S3 gets to version 1.000 it will not implement the full S3 interface. |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
B<Disclaimer:> Several portions of AWS::S3 have been adopted from L<Net::Amazon::S3>. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
B<NOTE:> AWS::S3 is NOT a drop-in replacement for L<Net::Amazon::S3>. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
B<TODO:> CloudFront integration. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
Call C<new()> with the following parameters. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head2 access_key_id |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Required. String. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Provided by Amazon, this is your access key id. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 secret_access_key |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
Required. String. |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
Provided by Amazon, this is your secret access key. |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=head2 secure |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
Optional. Boolean. |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Default is C<0> |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head2 endpoint |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
Optional. String. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Default is C<s3.amazonaws.com> |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 ua |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Optional. Should be an instance of L<LWP::UserAgent> or a subclass of it. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
Defaults to creating a new instance of L<LWP::UserAgent::Determined> |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 PUBLIC PROPERTIES |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head2 access_key_id |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
String. Read-only |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 secret_access_key |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
String. Read-only. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head2 secure |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Boolean. Read-only. |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head2 endpoint |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
String. Read-only. |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=head2 ua |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
L<LWP::UserAgent> object. Read-only. |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head2 owner |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
L<AWS::S3::Owner> object. Read-only. |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=head1 PUBLIC METHODS |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 buckets |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Returns an array of L<AWS::S3::Bucket> objects. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=head2 bucket( $name ) |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
Returns the L<AWS::S3::Bucket> object matching C<$name> if found. |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Returns nothing otherwise. |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head2 add_bucket( name => $name ) |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
Attempts to create a new bucket with the name provided. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
On success, returns the new L<AWS::S3::Bucket> |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
On failure, dies with the error message. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
See L<AWS::S3::Bucket> for details on how to use buckets (and access their files). |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head1 SEE ALSO |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
L<The Amazon S3 API Documentation|http://docs.amazonwebservices.com/AmazonS3/latest/API/> |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
L<AWS::S3::Bucket> |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
L<AWS::S3::File> |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
L<AWS::S3::FileIterator> |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
L<AWS::S3::Owner> |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head1 AUTHOR |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Originally John Drago C<jdrago_999@yahoo.com>, currently maintained by Lee Johnson (LEEJO) C<leejo@cpan.org> |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=head1 LICENSE |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
This software is Free software and may be used and redistributed under the same |
307
|
|
|
|
|
|
|
terms as any version of perl itself. |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Copyright John Drago 2011 all rights reserved. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=cut |
312
|
|
|
|
|
|
|
|