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
|
package Net::Amazon::S3::Client;
use Moose 0.85;
use HTTP::Status qw(is_error status_message);
use MooseX::StrictConstructor 0.16;
use Moose::Util::TypeConstraints;
type 'Etag' => where { $_ =~ /^[a-z0-9]{32}$/ };
type 'OwnerId' => where { $_ =~ /^[a-z0-9]{64}$/ };
has 's3' => ( is => 'ro', isa => 'Net::Amazon::S3', required => 1 );
__PACKAGE__->meta->make_immutable;
sub buckets {
my $self = shift;
my $s3 = $self->s3;
my $http_request
= Net::Amazon::S3::Request::ListAllMyBuckets->new( s3 => $s3 )
->http_request;
my $xpc = $self->_send_request_xpc($http_request);
my $owner_id
= $xpc->findvalue('/s3:ListAllMyBucketsResult/s3:Owner/s3:ID');
my $owner_display_name = $xpc->findvalue(
'/s3:ListAllMyBucketsResult/s3:Owner/s3:DisplayName');
my @buckets;
foreach my $node (
$xpc->findnodes('/s3:ListAllMyBucketsResult/s3:Buckets/s3:Bucket') )
{
push @buckets,
Net::Amazon::S3::Client::Bucket->new(
{ client => $self,
name => $xpc->findvalue( './s3:Name', $node ),
creation_date =>
$xpc->findvalue( './s3:CreationDate', $node ),
owner_id => $owner_id,
owner_display_name => $owner_display_name,
}
);
}
return @buckets;
}
sub create_bucket {
my ( $self, %conf ) = @_;
my $bucket = Net::Amazon::S3::Client::Bucket->new(
client => $self,
name => $conf{name},
);
$bucket->_create(
acl_short => $conf{acl_short},
location_constraint => $conf{location_constraint},
);
return $bucket;
}
sub bucket {
my ( $self, %conf ) = @_;
return Net::Amazon::S3::Client::Bucket->new(
client => $self,
%conf,
);
}
sub _send_request_raw {
my ( $self, $http_request, $filename ) = @_;
return $self->s3->ua->request( $http_request, $filename );
}
sub _send_request {
my ( $self, $http_request, $filename ) = @_;
my $http_response = $self->_send_request_raw( $http_request, $filename );
my $content = $http_response->content;
my $content_type = $http_response->content_type;
my $code = $http_response->code;
if ( is_error($code) ) {
if ( $content_type eq 'application/xml' ) {
my $doc = $self->s3->libxml->parse_string($content);
my $xpc = XML::LibXML::XPathContext->new($doc);
$xpc->registerNs( 's3',
'http://s3.amazonaws.com/doc/2006-03-01/' );
if ( $xpc->findnodes('/Error') ) {
my $code = $xpc->findvalue('/Error/Code');
my $message = $xpc->findvalue('/Error/Message');
confess("$code: $message");
} else {
confess status_message($code);
}
} else {
confess status_message($code);
}
}
return $http_response;
}
sub _send_request_content {
my ( $self, $http_request, $filename ) = @_;
my $http_response = $self->_send_request( $http_request, $filename );
return $http_response->content;
}
sub _send_request_xpc {
my ( $self, $http_request, $filename ) = @_;
my $http_response = $self->_send_request( $http_request, $filename );
my $doc = $self->s3->libxml->parse_string( $http_response->content );
my $xpc = XML::LibXML::XPathContext->new($doc);
$xpc->registerNs( 's3', 'http://s3.amazonaws.com/doc/2006-03-01/' );
return $xpc;
}
1;
__END__
=head1 NAME
Net::Amazon::S3::Client - An easy-to-use Amazon S3 client
=head1 SYNOPSIS
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 $client = Net::Amazon::S3::Client->new( s3 => $s3 );
# list all my buckets
# returns a list of L<Net::Amazon::S3::Client::Bucket> objects
my @buckets = $client->buckets;
foreach my $bucket (@buckets) {
print $bucket->name . "\n";
}
# create a new bucket
# returns a L<Net::Amazon::S3::Client::Bucket> object
my $bucket = $client->create_bucket(
name => $bucket_name,
acl_short => 'private',
location_constraint => 'US',
);
# or use an existing bucket
# returns a L<Net::Amazon::S3::Client::Bucket> object
my $bucket = $client->bucket( name => $bucket_name );
=head1 DESCRIPTION
The L<Net::Amazon::S3> module was written when the Amazon S3 service
had just come out and it is a light wrapper around the APIs. Some
bad API decisions were also made. The
L<Net::Amazon::S3::Client>, L<Net::Amazon::S3::Client::Bucket> and
L<Net::Amazon::S3::Client::Object> classes are designed after years
of usage to be easy to use for common tasks.
These classes throw an exception when a fatal error occurs. It
also is very careful to pass an MD5 of the content when uploaded
to S3 and check the resultant ETag.
WARNING: This is an early release of the Client classes, the APIs
may change.
=head1 METHODS
=head2 buckets
# list all my buckets
# returns a list of L<Net::Amazon::S3::Client::Bucket> objects
my @buckets = $client->buckets;
foreach my $bucket (@buckets) {
print $bucket->name . "\n";
}
=head2 create_bucket
# create a new bucket
# returns a L<Net::Amazon::S3::Client::Bucket> object
my $bucket = $client->create_bucket(
name => $bucket_name,
acl_short => 'private',
location_constraint => 'US',
);
=head2 bucket
# or use an existing bucket
# returns a L<Net::Amazon::S3::Client::Bucket> object
my $bucket = $client->bucket( name => $bucket_name );
|
