Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

add copy_object

  • Loading branch information...
commit a3da92915eb907ec68a16b7539780a2707ef343f 1 parent 6b88460
Tomohiro Ikebe authored
Showing with 70 additions and 7 deletions.
  1. +5 −0 Changes
  2. +34 −4 lib/Furl/S3.pm
  3. +3 −3 t/01_signature.t
  4. +28 −0 t/10_online.t
5 Changes
View
@@ -1,4 +1,9 @@
Revision history for Perl extension Furl::S3
+0.02
+ - use Furl::HTTP
+ - use utf-8 string correctly
+ - added copy_object method
+
0.01 Mon Nov 29 11:52:08 2010
- original version
38 lib/Furl/S3.pm
View
@@ -12,12 +12,12 @@ use XML::LibXML;
use XML::LibXML::XPathContext;
use Furl::S3::Error;
use Params::Validate qw(:types validate_with validate_pos);
-use URI::Escape qw(uri_escape);
+use URI::Escape qw(uri_escape_utf8);
use Carp ();
Class::Accessor::Lite->mk_accessors(qw(aws_access_key_id aws_secret_access_key secure furl endpoint));
-our $VERSION = '0.01';
+our $VERSION = '0.02';
our $DEFAULT_ENDPOINT = 's3.amazonaws.com';
our $XMLNS = 'http://s3.amazonaws.com/doc/2006-03-01/';
@@ -140,6 +140,7 @@ sub resource {
my $resource = $bucket;
$resource = '/'. $resource unless $resource =~ m{^/};
if ( defined $key ) {
+ $key = _normalize_key($key);
$resource = join '/', $resource, $key;
}
if ( $subresource ) {
@@ -153,7 +154,7 @@ sub _path_query {
my( $self, $path, $q ) = @_;
$path = '/'. $path unless $path =~ m{^/};
my $qs = ref($q) eq 'HASH' ?
- join('&', map { $_. '='. uri_escape( $q->{$_} ) } keys %{$q}) : $q;
+ join('&', map { $_. '='. uri_escape_utf8( $q->{$_} ) } keys %{$q}) : $q;
$path .= '?'. $qs if $qs;
$path;
}
@@ -161,6 +162,7 @@ sub _path_query {
sub host_and_path_query {
my( $self, $bucket, $key, $params ) = @_;
my($host, $path_query);
+ $key = _normalize_key($key);
if ( is_dns_style($bucket) ) {
$host = join '.', $bucket, $self->endpoint;
$path_query = $self->_path_query( $key, $params );
@@ -372,6 +374,21 @@ sub create_object_from_file {
$self->create_object( $bucket, $key, $fh, $headers )
}
+sub copy_object {
+ my $self = shift;
+ my( $source_bucket, $source_key, $dest_bucket, $dest_key, $headers ) = @_;
+ validate_pos( @_,
+ 1, 1, 1,
+ { type => SCALAR | UNDEF, optional => 1 },
+ { type => HASHREF, optional => 1} );
+ $headers ||= +{};
+ my $source = $self->resource( $source_bucket, $source_key );
+ $self->create_object( $dest_bucket, $dest_key, '', {
+ %{$headers},
+ 'x-amz-copy-source' => $source,
+ });
+}
+
sub _normalize_response {
my( $self, $res, $is_head ) = @_;
my %res;
@@ -453,10 +470,18 @@ sub error {
$self->{_error};
}
+sub _normalize_key {
+ my $key = shift;
+ join '/', map { _uri_escape($_) } split /\//, $key;
+}
+
sub _http_is_success {
$_[0] >= 200 && $_[0] < 300;
}
+sub _uri_escape {
+ uri_escape_utf8($_[0], '^A-Za-z0-9\._-');
+}
1;
@@ -682,9 +707,14 @@ returns a HASH-REF
delete object.
returns a boolean value.
+=head2 copy_object($source_bucket, $source_key, $dest_bucket, $dest_key, [ \%headers ]);
+
+copy object.
+return a boolean value.
+
=head1 AUTHOR
-Tomohiro Ikebe E<lt>ikebe {at} livedoor.jpE<gt>
+Tomohiro Ikebe E<lt>ikebe {at} shebang.jpE<gt>
=head1 SEE ALSO
6 t/01_signature.t
View
@@ -29,7 +29,7 @@ my $s3 = Furl::S3->new(
{
my $date = time2str( time );
- my $resource = '/foo/bar.txt';
+ my $resource = '/foo/bar-baz.txt';
# encode_base64(md5('hoge'));
my $md5 = '6nA+eqHv2gBk6qUH2eirfg==';
my $content_type = 'text/plain';
@@ -66,11 +66,11 @@ my $s3 = Furl::S3->new(
{
my $expires = time + 10;
- my $string_to_sign = $s3->string_to_sign('GET', '/foo/bar.txt', {
+ my $string_to_sign = $s3->string_to_sign('GET', '/foo/bar-baz.txt', {
expires => $expires,
});
my $sig = uri_escape( $s3->sign( $string_to_sign ) );
- my $url = $s3->signed_url('foo', 'bar.txt', $expires);
+ my $url = $s3->signed_url('foo', 'bar-baz.txt', $expires);
like $url, qr/Expires=$expires/;
like $url, qr/foo\.s3.amazonaws\.com/;
like $url, qr/Signature=$sig/;
28 t/10_online.t
View
@@ -133,6 +133,34 @@ my $bucket = $ENV{TEST_S3_BUCKET} || lc('test-'. $ENV{TEST_AWS_ACCESS_KEY_ID}. '
}
}
+# multi-byte
+{
+ use utf8;
+ my $str = time;
+ my $key = 'ほげ/ほげ ほげ.txt';
+ ok $s3->create_object($bucket, $key, $str, +{
+ content_type => 'text/plain',
+ }), 'create_object multi-byte key name';
+
+ my $res = $s3->get_object($bucket, $key);
+ ok $res, 'get_object';
+ is $res->{content}, $str, 'content';
+ is $res->{content_type}, 'text/plain', 'content_type';
+ is $res->{content_length}, length($str), 'content_length';
+
+
+ my $key2 = 'あいうえお.txt';
+ ok $s3->copy_object( $bucket, $key, $bucket, $key2 ), 'copy_object';
+ ok $s3->delete_object( $bucket, $key ), 'delete old file';
+
+ $res = $s3->get_object($bucket, $key2);
+ ok $res, 'get_object';
+ is $res->{content}, $str, 'content';
+
+ $s3->delete_object( $bucket, $key2 );
+}
+
+
ok $s3->delete_bucket( $bucket );
Please sign in to comment.
Something went wrong with that request. Please try again.