File Coverage

blib/lib/Amazon/S3/FastUploader.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Amazon::S3::FastUploader;
2 1     1   23805 use strict;
  1         3  
  1         44  
3 1     1   6 use warnings;
  1         3  
  1         33  
4 1     1   6 use File::Find;
  1         6  
  1         78  
5 1     1   494 use Amazon::S3;
  0            
  0            
6             use Amazon::S3::FastUploader::File;
7             use Parallel::ForkManager;
8             use base qw( Class::Accessor );
9             __PACKAGE__->mk_accessors( qw(config) );
10              
11             our $VERSION = '0.08';
12              
13             sub new {
14             my $class = shift;
15             my $config = shift;
16             bless { config => $config }, $class;
17             }
18              
19              
20             sub upload {
21              
22             my $self = shift;
23             my $local_dir = shift;
24             my $bucket_name = shift;
25             my $target_dir = shift;
26              
27             my $config = $self->config;
28              
29             my $process = $config->{process};
30             my $s3 = Amazon::S3->new($config);
31              
32             my $bucket = $s3->bucket($bucket_name) or die 'cannot get bucket';
33              
34             $self->_print("local dir : " . $local_dir . "\n");
35             $self->_print("remote dir : " . $target_dir . "\n");
36             $self->_print("max process: " . $process . "\n");
37             $self->_print("use SSL: " . $config->{secure}. "\n");
38             $self->_print("use encryption: " . $config->{encrypt}. "\n");
39              
40             my @local_files;
41              
42             my $callback = sub {
43             return unless -f ;
44             my $file = Amazon::S3::FastUploader::File->new({
45             s3 => $s3,
46             local_path => $File::Find::name,
47             target_dir => $target_dir,
48             bucket => $bucket,
49             config => $config,
50             });
51             push @local_files , $file;
52             };
53              
54             chdir $local_dir;
55             find($callback, '.');
56              
57             if ($process > 1) {
58             $self->_upload_parallel(\@local_files, $process);
59             } else {
60             $self->_upload_single(\@local_files);
61             }
62             }
63              
64             sub _upload_single {
65             my $self = shift;
66             my @files = @{ shift; };
67              
68             $self->_print("uploading by a single process\n");
69              
70             my $i = 0;
71             my $total_num = @files;
72              
73             for my $file (@files) {
74             $i++;
75              
76             $file->upload();
77             $self->_print("ok $i / $total_num " . $file->from_to . "\n");
78              
79             }
80              
81             $self->_print(sprintf("%d files uploaded\n" , $i));
82             }
83              
84             sub _upload_parallel {
85             my $self = shift;
86             my @files = @{ shift; };
87             my $max = shift;
88              
89             $self->_print("uploading by multi processes\n");
90              
91             my $pm = new Parallel::ForkManager($max);
92             $pm->run_on_finish(
93             sub {
94             my ($pid, $exit_code, $ident) = @_;
95             if ($exit_code != 0) {
96             # on Windows 7, I saw sometimes error like below:
97             #URI/_query.pm did not return a true value at C:/Perl/lib/URI/_generic.pm line 3.
98             #
99             #Compilation failed in require at C:/Perl/lib/URI/_server.pm line 2.
100             #Compilation failed in require at C:/Perl/lib/URI/http.pm line 3.
101             #Compilation failed in require at (eval 25) line 2.
102              
103             die("error (exit_code = $exit_code )");
104             }
105             });
106              
107             my $i = 0;
108             my $total_num = @files;
109              
110             for my $file (@files) {
111             $i++;
112              
113             $pm->start and next;
114             $file->upload();
115             $self->_print("ok $i / $total_num " . $file->from_to . "\n");
116              
117             $pm->finish;
118             $i++;
119             }
120              
121             $pm->wait_all_children;
122             my $count = @files;
123             $self->_print(sprintf("%d files uploaded\n" , $count));
124             }
125              
126             sub _print {
127             my $self = shift;
128             return unless $self->config->{verbose};
129             print @_;
130             }
131              
132              
133             =head1 NAME
134              
135             Amazon::S3::FastUploader - fast uploader to Amazon S3
136              
137              
138             =head1 SYNOPSIS
139              
140             By this module, you can upload many files to Amazon S3 at the same time
141             (in another word, in parallel) .
142             The module uses Parallel::ForkManager internally.
143              
144              
145             use Amazon::S3::FastUploader;
146              
147             my $local_dir = '/path/to/dir/';
148             my $bucket_name = 'myubcket';
149             my $remote_dir '/path/to/dir/';
150             my $uploader = Amazon::S3::FastUploader->new({
151             aws_access_key_id => 'your_key_id',
152             aws_secret_access_key => 'your_secre_key',
153             process => 10, # num of proccesses in parallel
154             secure => 1, # use SSL
155             encrypt => 1, # use ServerSide Encryption
156             retry => 5,
157             verbose => 1, # print log to stdout
158             acl_short => 'public-read', # private if ommited
159             });
160              
161             $uploader->upload($local_dir, $bucket_name, $remote_dir);
162              
163             =head1 METHODS
164              
165             =head2 new
166              
167             Instaniates a new object.
168              
169             Requires a hashref
170              
171              
172             =head2 upload $local_dir $bucket_name $remote_dir
173              
174             upload recursively $local_dir to $remote_dir
175              
176              
177             =head1 AUTHOR
178              
179             DQNEO, C<< >>
180              
181             =head1 Github Repository
182              
183             https://github.com/DQNEO/Amazon-S3-FastUploader
184              
185             Forks & Pull Requests are wellcome!
186              
187             =head1 BUGS
188              
189             Please report any bugs or feature requests to C, or through
190             the web interface at L. I will be notified, and then you'll
191             automatically be notified of progress on your bug as I make changes.
192              
193              
194              
195              
196             =head1 SUPPORT
197              
198             You can find documentation for this module with the perldoc command.
199              
200             perldoc Amazon::S3::FastUploader
201              
202              
203             You can also look for information at:
204              
205             =over 4
206              
207             =item * RT: CPAN's request tracker (report bugs here)
208              
209             L
210              
211             =item * AnnoCPAN: Annotated CPAN documentation
212              
213             L
214              
215             =item * CPAN Ratings
216              
217             L
218              
219             =item * Search CPAN
220              
221             L
222              
223             =back
224              
225             =head1 SEE ALSO
226              
227             L
228             L
229              
230             =head1 LICENSE AND COPYRIGHT
231              
232             Copyright 2012 DQNEO.
233              
234             This program is free software; you can redistribute it and/or modify it
235             under the terms of either: the GNU General Public License as published
236             by the Free Software Foundation; or the Artistic License.
237              
238             See http://dev.perl.org/licenses/ for more information.
239              
240              
241             =cut
242              
243             1; # End of Amazon::S3::FastUploader