File Coverage

blib/lib/Backblaze/B2.pm
Criterion Covered Total %
statement 42 181 23.2
branch 0 24 0.0
condition 0 16 0.0
subroutine 14 72 19.4
pod 1 1 100.0
total 57 294 19.3


line stmt bran cond sub pod time code
1             package Backblaze::B2;
2 2     2   18929 use strict;
  2         3  
  2         49  
3 2     2   5 use vars qw($VERSION);
  2         2  
  2         243  
4             $VERSION = '0.02';
5              
6             =head1 NAME
7              
8             Backblaze::B2 - interface to the Backblaze B2 API
9              
10             =head1 SYNOPSIS
11              
12             =head1 METHODS
13              
14             =head2 C<< Backblaze::B2->new %options >>
15              
16             =over 4
17              
18             =item B<< version >>
19              
20             Allows you to specify the API version. The current
21             default is C<< v1 >>, which corresponds to the
22             Backblaze B2 API version 1 as documented at
23             L.
24              
25             =back
26              
27             =cut
28              
29             sub new {
30 0     0 1   my( $class, %options ) = @_;
31 0   0       $options{ version } ||= 'v1';
32 0           $class = "$class\::$options{ version }";
33 0           $class->new( %options );
34             };
35              
36             =head1 SETUP
37              
38             =over 4
39              
40             =item 0. Have a telephone / mobile phone number you're willing to
41             share with Backblaze
42              
43             =item 1. Register at for Backblaze B2 Cloud Storage at
44              
45             L
46              
47             =item 2. Add the phone number to your account at
48              
49             L
50              
51             =item 3. Enable Two-Factor verification through your phone at
52              
53             L
54              
55             =item 4. Create a JSON file named C
56              
57             This file should live in your
58             home directory
59             with the application key and the account key:
60              
61             { "accountId": "...",
62             "applicationKey": ".............."
63             }
64              
65             =back
66              
67             =cut
68              
69             package Backblaze::B2::v1;
70 2     2   6 use strict;
  2         5  
  2         35  
71 2     2   5 use Carp qw(croak);
  2         2  
  2         96  
72              
73             =head1 NAME
74              
75             Backblaze::B2::v1 - Backblaze B2 API account
76              
77             =head1 METHODS
78              
79             =head2 C<< ->new %options >>
80              
81             my $b2 = Backblaze::B2::v1->new(
82             api => 'Backblaze::B2::v1::Synchronous', # the default
83             );
84              
85             Creates a new instance. Depending on whether you pass in
86             C<> or C<>,
87             you will get a synchronous or asynchronous API.
88              
89             The synchronous API is what is documented here, as this is the
90             most likely use case.
91              
92             my @buckets = $b2->buckets();
93             for( @buckets ) {
94             ...
95             }
96              
97             The asynchronous API is identical to the synchronous API in spirit, but
98             will return L . These condvars usually return
99             two or more parameters upon completion:
100              
101             my $results = $b2->buckets();
102             $results->then( sub{
103             my( @buckets ) = @_;
104             for( @buckets ) {
105             ...
106             }
107             }
108              
109             The asynchronous API puts the burden of error handling into your code.
110              
111             =cut
112              
113 2     2   6 use vars '$API_BASE';
  2         2  
  2         1146  
114             $API_BASE = 'https://api.backblazeb2.com/b2api/v1/';
115              
116             sub new {
117 0     0     my( $class, %options ) = @_;
118            
119             # Hrr. We need to get at an asynchronous API here and potentially
120             # wrap the results to synchronous results in case the user wants them.
121             # Turtles all the way down, this means we can't reuse calls into ourselves...
122              
123 0   0       $options{ api } ||= 'Backblaze::B2::v1::Synchronous';
124 0 0         if( ! ref $options{ api }) {
125 0           eval "require $options{ api }";
126 0           my $class = delete $options{ api };
127 0           $options{ api } = $class->new(%options);
128             };
129            
130 0 0         if( $options{ api }->isAsync ) {
131 0   0       $options{ bucket_class } ||= 'Backblaze::B2::v1::Bucket';
132 0   0       $options{ file_class } ||= 'Backblaze::B2::v1::File';
133             } else {
134 0   0       $options{ bucket_class } ||= 'Backblaze::B2::v1::Bucket::Synchronized';
135 0   0       $options{ file_class } ||= 'Backblaze::B2::v1::File::Synchronized';
136             };
137            
138 0           bless \%options => $class
139             }
140              
141             sub read_credentials {
142 0     0     my( $self, @args ) = @_;
143 0           $self->api->read_credentials(@args)
144             }
145              
146             sub authorize_account {
147 0     0     my( $self, @args ) = @_;
148 0           $self->api->authorize_account(@args)
149             }
150              
151             sub _new_bucket {
152 0     0     my( $self, %options ) = @_;
153            
154             $self->{bucket_class}->new(
155             %options,
156             api => $self->api,
157             parent => $self,
158             file_class => $self->{file_class}
159             )
160 0           }
161              
162             sub await($) {
163 0     0     my $promise = $_[0];
164 0           my @res;
165 0 0         if( $promise->is_unfulfilled ) {
166 0           require AnyEvent;
167 0           my $await = AnyEvent->condvar;
168             $promise->then(sub{
169 0     0     $await->send(@_);
170             }, sub {
171 0     0     warn "@_";
172 0           });
173 0           @res = $await->recv;
174             } else {
175 0           warn "Have results already";
176 0           @res = @{ $promise->result }
  0            
177             }
178             @res
179 0           };
180              
181             sub payload($) {
182 0     0     my( $ok, $msg, @results ) = await( $_[0] );
183 0 0         if(! $ok) { croak $msg };
  0            
184 0 0         return wantarray ? @results : $results[0];
185             }
186              
187             =head2 C<< ->buckets >>
188              
189             my @buckets = $b2->buckets();
190              
191             Returns a list of L objects associated with
192             the B2 account.
193              
194             =cut
195              
196             sub buckets {
197 0     0     my( $self ) = @_;
198             my $list = $self->api->asyncApi->list_buckets()->then( sub {
199 0     0     my( $ok, $msg, $list ) = @_;
200 0           map { $self->_new_bucket( %$_ ) }
201 0           @{ $list->{buckets} }
  0            
202 0           });
203            
204 0 0         if( !$self->api->isAsync ) {
205 0           return Backblaze::B2::v1::payload $list
206             } else {
207 0           return $list
208             }
209             }
210              
211             =head2 C<< ->bucket_from_id >>
212              
213             my @buckets = $b2->bucket_from_id(
214             'deadbeef'
215             );
216              
217             Returns a L object that has the given ID. It
218             does not make an HTTP request to fetch the name and status of that bucket.
219              
220             =cut
221              
222             sub bucket_from_id {
223 0     0     my( $self, $bucket_id ) = @_;
224 0           $self->_new_bucket( bucketId => $bucket_id );
225             }
226              
227             =head2 C<< ->create_bucket >>
228              
229             my $new_bucket = $b2->create_bucket(
230             name => 'my-new-bucket', # only /[A-Za-z0-9-]/i are allowed as bucket names
231             type => 'allPrivate', # or allPublic
232             );
233            
234             print sprintf "Created new bucket %s\n", $new_bucket->id;
235              
236             Creates a new bucket and returns it.
237              
238             =cut
239              
240             sub create_bucket {
241 0     0     my( $self, %options ) = @_;
242 0   0       $options{ type } ||= 'allPrivate';
243             my $b = $self->api->asyncApi->create_bucket(
244             bucketName => $options{ name },
245             bucketType => $options{ type },
246             )->then( sub {
247 0     0     my( $bucket ) = @_;
248 0           $self->_new_bucket( %$bucket );
249 0           });
250              
251 0 0         if( !$self->api->isAsync ) {
252 0           Backblaze::B2::v1::payload $b
253             }
254             }
255              
256             =head2 C<< ->api >>
257              
258             Returns the underlying API object
259              
260             =cut
261              
262 0     0     sub api { $_[0]->{api} }
263              
264             1;
265              
266             package Backblaze::B2::v1::Bucket;
267 2     2   8 use strict;
  2         2  
  2         29  
268 2     2   6 use Scalar::Util 'weaken';
  2         1  
  2         992  
269              
270             sub new {
271 0     0     my( $class, %options ) = @_;
272 0           weaken $options{ parent };
273            
274             # Whoa! We assume that the async version has the same class name
275             # as the synchronous version and just strip it off.
276 0           $options{ file_class } =~ s!::Synchronized$!!;
277            
278 0           bless \%options => $class,
279             }
280              
281 0     0     sub name { $_[0]->{bucketName} }
282             #sub api { $_[0]->{api} }
283 0     0     sub downloadUrl { join "/", $_[0]->api->downloadUrl, $_[0]->name }
284 0     0     sub id { $_[0]->{bucketId} }
285 0     0     sub type { $_[0]->{bucketType} }
286 0     0     sub account { $_[0]->{parent} }
287              
288             sub _new_file {
289 0     0     my( $self, %options ) = @_;
290             # Should this one magically unwrap AnyEvent::condvar objects?!
291            
292             #warn $self->{file_class};
293             #use Data::Dumper;
294             #warn Dumper \%options;
295            
296             $self->{file_class}->new(
297 0           %options,
298             api => $self->api,
299             bucket => $self
300             );
301             }
302              
303             =head2 C<< ->files( %options ) >>
304              
305             Lists the files contained in this bucket
306              
307             my @files = $bucket->files(
308             startFileName => undef,
309             );
310              
311             By default it returns only the first 1000
312             files, but see the C parameter.
313              
314             =over 4
315              
316             =item C<< allFiles >>
317              
318             allFiles => 1
319              
320             Passing in a true value for this parameter will make
321             as many API calls as necessary to fetch all files.
322              
323             =back
324              
325             =cut
326              
327             sub files {
328 0     0     my( $self, %options ) = @_;
329 0   0       $options{ maxFileCount } ||= 1000;
330             #$options{ startFileName } ||= undef;
331            
332             $self->api->asyncApi->list_all_file_names(
333             bucketId => $self->id,
334             %options,
335             )->then( sub {
336 0     0     my( $ok, $msg, @res ) = @_;
337            
338 0           $ok, $msg, map { $self->_new_file( %$_, bucket => $self ) } @res
  0            
339             })
340 0           }
341              
342             =head2 C<< ->upload_file( %options ) >>
343              
344             Uploads a file into this bucket, potentially creating
345             a new file version.
346              
347             my $new_file = $bucket->upload_file(
348             file => 'some/local/file.txt',
349             target_file => 'the/public/name.txt',
350             );
351              
352             =over 4
353              
354             =item C<< file >>
355              
356             Local name of the source file. This file will be loaded
357             into memory in one go.
358              
359             =item C<< target_file >>
360              
361             Name of the file on the B2 API. Defaults to the local name.
362              
363             The target file name will have backslashes replaced by forward slashes
364             to comply with the B2 API.
365              
366             =item C<< mime_type >>
367              
368             Content-type of the stored file. Defaults to autodetection by the B2 API.
369              
370             =item C<< content >>
371              
372             If you don't have the local content in a file on disk, you can
373             pass the content in as a string.
374              
375             =item C<< mtime >>
376              
377             Time in miliseconds since the epoch to when the content was created.
378             Defaults to the current time.
379              
380             =item C<< sha1 >>
381              
382             Hexdigest of the SHA1 of the content. If this is missing, the SHA1
383             will be calculated upon upload.
384              
385             =back
386              
387             =cut
388              
389             sub upload_file {
390 0     0     my( $self, %options ) = @_;
391            
392 0           my $api = $self->api->asyncApi;
393             $api->get_upload_url(
394             bucketId => $self->id,
395             )->then(sub {
396 0     0     my( $ok, $msg, $upload_handle ) = @_;
397 0           $api->upload_file(
398             %options,
399             handle => $upload_handle
400             );
401             })->then( sub {
402 0     0     my( $ok, $msg, @res ) = @_;
403              
404 0           (my $res) = map { $self->_new_file( %$_, bucket => $self ) } @res;
  0            
405 0           $ok, $msg, $res
406 0           });
407             }
408              
409             =head2 C<< ->download_file_by_name( %options ) >>
410              
411             Downloads a file from this bucket by name:
412              
413             my $content = $bucket->download_file_by_name(
414             fileName => 'the/public/name.txt',
415             );
416              
417             This saves you searching through the list of existing files
418             if you already know the filename.
419              
420             =cut
421              
422             sub download_file_by_name {
423 0     0     my( $self, %options ) = @_;
424 0           $self->api->asyncApi->download_file_by_name(
425             bucketName => $self->name,
426             %options
427             );
428             }
429              
430             =head2 C<< ->get_download_authorization( %options ) >>
431              
432             Downloads a file from this bucket by name:
433              
434             my $authToken = $bucket->get_download_authorization(
435             fileNamePrefix => '/members/downloads/',
436             validDurationInSeconds => 300, # five minutes
437             );
438              
439             This returns an authorization token that can download files with the
440             given prefix.
441              
442             =cut
443              
444             sub get_download_authorization {
445 0     0     my( $self, %options ) = @_;
446 0           $self->api->asyncApi->get_download_authorization(
447             bucketId => $self->id,
448             %options
449             );
450             }
451              
452             =head2 C<< ->api >>
453              
454             Returns the underlying API object
455              
456             =cut
457              
458 0     0     sub api { $_[0]->{api} }
459              
460             package Backblaze::B2::v1::Bucket::Synchronized;
461 2     2   9 use strict;
  2         2  
  2         40  
462 2     2   7 use Carp qw(croak);
  2         2  
  2         202  
463              
464 0     0     sub name { $_[0]->{impl}->name }
465             #sub api { $_[0]->{api} }
466 0     0     sub downloadUrl { $_[0]->{impl}->downloadUrl }
467 0     0     sub id { $_[0]->{impl}->id }
468 0     0     sub type { $_[0]->{impl}->type }
469 0     0     sub account { $_[0]->{impl}->parent }
470              
471             # Our simple method reflector
472 2     2   13 use vars '$AUTOLOAD';
  2         2  
  2         233  
473             sub AUTOLOAD {
474 0     0     my( $self, @arguments ) = @_;
475 0 0         $AUTOLOAD =~ /::([^:]+)$/
476             or croak "Invalid method name '$AUTOLOAD' called";
477 0           my $method = $1;
478 0 0         $self->impl->can( $method )
479             or croak "Unknown method '$method' called on $self";
480              
481             # Install the subroutine for caching
482 0           my $namespace = ref $self;
483 2     2   9 no strict 'refs';
  2         3  
  2         659  
484 0           my $new_method = *{"$namespace\::$method"} = sub {
485 0     0     my $self = shift;
486 0           warn "In <$namespace\::$method>";
487 0           my( $ok, $msg, @results) = Backblaze::B2::v1::await $self->impl->$method( @_ );
488             #warn "Results: $ok/$msg/@results";
489 0 0         if( ! $ok ) {
490 0           croak $msg;
491             } else {
492             #use Data::Dumper;
493             #warn Dumper \@results;
494 0 0         return wantarray ? @results : $results[0]
495             };
496 0           };
497              
498             # Invoke the newly installed method
499 0           goto &$new_method;
500             };
501              
502             sub new {
503 0     0     my( $class, %options ) = @_;
504            
505             my $self = {
506             impl => Backblaze::B2::v1::Bucket->new(%options),
507             file_class => $options{ file_class },
508 0           };
509            
510 0           bless $self => $class,
511             }
512              
513 0     0     sub impl { $_[0]->{impl} }
514              
515             sub _new_file {
516 0     0     my( $self, %options ) = @_;
517              
518             $self->{file_class}->new(
519 0           %options,
520             api => $self->api,
521             bucket => $self
522             );
523             }
524              
525             =head2 C<< ->files( %options ) >>
526              
527             Lists the files contained in this bucket
528              
529             my @files = $bucket->files(
530             startFileName => undef,
531             );
532              
533             By default it returns only the first 1000
534             files, but see the C parameter.
535              
536             =over 4
537              
538             =item C<< allFiles >>
539              
540             allFiles => 1
541              
542             Passing in a true value for this parameter will make
543             as many API calls as necessary to fetch all files.
544              
545             =back
546              
547             =cut
548              
549             sub files {
550 0     0     my( $self, %options ) = @_;
551 0           map { $self->_new_file( impl => $_ ) }
  0            
552             Backblaze::B2::v1::payload $self->impl->files( %options );
553             }
554              
555             =head2 C<< ->upload_file( %options ) >>
556              
557             Uploads a file into this bucket, potentially creating
558             a new file version.
559              
560             my $new_file = $bucket->upload_file(
561             file => 'some/local/file.txt',
562             target_file => 'the/public/name.txt',
563             );
564              
565             =over 4
566              
567             =item C<< file >>
568              
569             Local name of the source file. This file will be loaded
570             into memory in one go.
571              
572             =item C<< target_file >>
573              
574             Name of the file on the B2 API. Defaults to the local name.
575              
576             The target file name will have backslashes replaced by forward slashes
577             to comply with the B2 API.
578              
579             =item C<< mime_type >>
580              
581             Content-type of the stored file. Defaults to autodetection by the B2 API.
582              
583             =item C<< content >>
584              
585             If you don't have the local content in a file on disk, you can
586             pass the content in as a string.
587              
588             =item C<< mtime >>
589              
590             Time in miliseconds since the epoch to when the content was created.
591             Defaults to the current time.
592              
593             =item C<< sha1 >>
594              
595             Hexdigest of the SHA1 of the content. If this is missing, the SHA1
596             will be calculated upon upload.
597              
598             =back
599              
600             =cut
601              
602             sub upload_file {
603 0     0     my( $self, %options ) = @_;
604              
605 0           Backblaze::B2::v1::payload $self->impl->upload_file( %options );
606             }
607              
608             =head2 C<< ->download_file_by_name( %options ) >>
609              
610             Downloads a file from this bucket by name:
611              
612             my $content = $bucket->download_file_by_name(
613             file => 'the/public/name.txt',
614             );
615              
616             This saves you searching through the list of existing files
617             if you already know the filename.
618              
619             =cut
620              
621             sub download_file_by_name {
622 0     0     my( $self, %options ) = @_;
623 0           return Backblaze::B2::v1::payload $self->impl->download_file_by_name(
624             %options
625             )
626             }
627              
628             =head2 C<< ->api >>
629              
630             Returns the underlying API object
631              
632             =cut
633              
634 0     0     sub api { $_[0]->{api} }
635              
636             package Backblaze::B2::v1::File;
637 2     2   7 use strict;
  2         2  
  2         251  
638             #use Scalar::Util 'weaken'; # do we really want to weaken our link?!
639             # The bucket doesn't hold a ref to us, so we don't want to weaken it
640              
641             sub new {
642 0     0     my( $class, %options ) = @_;
643             #weaken $options{ bucket };
644             #warn "$class: " . join ",", sort keys %options;
645            
646 0           bless \%options => $class,
647             }
648              
649 0     0     sub name { $_[0]->{fileName} }
650 0     0     sub id { $_[0]->{fileId} }
651 0     0     sub action { $_[0]->{action} }
652 0     0     sub bucket { $_[0]->{bucket} }
653 0     0     sub size { $_[0]->{size} }
654 0     0     sub downloadUrl { join "/", $_[0]->bucket->downloadUrl, $_[0]->name }
655              
656             package Backblaze::B2::v1::File::Synchronized;
657 2     2   9 use strict;
  2         2  
  2         36  
658 2     2   10 use Carp qw(croak);
  2         1  
  2         293  
659             #use Scalar::Util 'weaken'; # do we really want to weaken our link?!
660             # The bucket doesn't hold a ref to us, so we don't want to weaken it
661              
662             sub new {
663 0     0     my( $class, %options ) = @_;
664             #weaken $options{ bucket };
665             #warn "$class: " . join ",", sort keys %options;
666 0 0         croak "Need impl" unless $options{ impl };
667            
668 0           bless \%options => $class,
669             }
670              
671 0     0     sub name { $_[0]->{impl}->name }
672 0     0     sub id { $_[0]->{impl}->id }
673 0     0     sub action { $_[0]->{impl}->action }
674 0     0     sub bucket { $_[0]->{impl}->bucket }
675 0     0     sub size { $_[0]->{impl}->size }
676 0     0     sub downloadUrl { $_[0]->{impl}->downloadUrl }
677              
678              
679             1;