| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Backblaze::B2V2Client; | 
| 2 |  |  |  |  |  |  | # API client library for V2 of the API to Backblaze B2 object storage | 
| 3 |  |  |  |  |  |  | # Allows for creating/deleting buckets, listing files in buckets, and uploading/downloading files | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | $Backblaze::B2V2Client::VERSION = '1.5'; | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | # our dependencies: | 
| 8 | 1 |  |  | 1 |  | 1034 | use Cpanel::JSON::XS; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 88 |  | 
| 9 | 1 |  |  | 1 |  | 592 | use Digest::SHA qw(sha1_hex); | 
|  | 1 |  |  |  |  | 3494 |  | 
|  | 1 |  |  |  |  | 115 |  | 
| 10 | 1 |  |  | 1 |  | 626 | use MIME::Base64; | 
|  | 1 |  |  |  |  | 662 |  | 
|  | 1 |  |  |  |  | 62 |  | 
| 11 | 1 |  |  | 1 |  | 945 | use Path::Tiny; | 
|  | 1 |  |  |  |  | 12332 |  | 
|  | 1 |  |  |  |  | 104 |  | 
| 12 | 1 |  |  | 1 |  | 772 | use URI::Escape; | 
|  | 1 |  |  |  |  | 1611 |  | 
|  | 1 |  |  |  |  | 75 |  | 
| 13 | 1 |  |  | 1 |  | 1018 | use WWW::Mechanize; | 
|  | 1 |  |  |  |  | 178105 |  | 
|  | 1 |  |  |  |  | 65 |  | 
| 14 |  |  |  |  |  |  |  | 
| 15 |  |  |  |  |  |  | # I wish I could apply this to my diet. | 
| 16 | 1 |  |  | 1 |  | 15 | use strict; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 31 |  | 
| 17 | 1 |  |  | 1 |  | 6 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 3086 |  | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | # object constructor; will automatically authorize this session | 
| 20 |  |  |  |  |  |  | sub new { | 
| 21 | 1 |  |  | 1 | 1 | 687 | my $class = shift; | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | # required args are the account ID and application_key | 
| 24 | 1 |  |  |  |  | 4 | my ($application_key_id, $application_key) = @_; | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | # cannot operate without these | 
| 27 | 1 | 50 | 33 |  |  | 23 | if (!$application_key_id || !$application_key) { | 
| 28 | 0 |  |  |  |  | 0 | die "ERROR: Cannot create B2V5Client object without both application_key_id and application_key arguments.\n"; | 
| 29 |  |  |  |  |  |  | } | 
| 30 |  |  |  |  |  |  |  | 
| 31 |  |  |  |  |  |  | # initiate class with my keys + WWW::Mechanize object | 
| 32 | 1 |  |  |  |  | 14 | my $self = bless { | 
| 33 |  |  |  |  |  |  | 'application_key_id' => $application_key_id, | 
| 34 |  |  |  |  |  |  | 'application_key' => $application_key, | 
| 35 |  |  |  |  |  |  | 'mech' => WWW::Mechanize->new( | 
| 36 |  |  |  |  |  |  | timeout => 60, | 
| 37 |  |  |  |  |  |  | autocheck => 0, | 
| 38 |  |  |  |  |  |  | cookie_jar => {}, | 
| 39 |  |  |  |  |  |  | keep_alive => 1, | 
| 40 |  |  |  |  |  |  | ), | 
| 41 |  |  |  |  |  |  | }, $class; | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | # now start our B2 session via method below | 
| 44 | 1 |  |  |  |  | 20601 | $self->b2_authorize_account();  # this adds more goodness to $self for use in the other methods | 
| 45 |  |  |  |  |  |  |  | 
| 46 | 1 |  |  |  |  | 8 | return $self; | 
| 47 |  |  |  |  |  |  | } | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  | # method to start your backblaze session:  authorize the account and get your api URL's | 
| 50 |  |  |  |  |  |  | sub b2_authorize_account { | 
| 51 | 1 |  |  | 1 | 0 | 3 | my $self = shift; | 
| 52 |  |  |  |  |  |  |  | 
| 53 |  |  |  |  |  |  | # prepare our authorization header | 
| 54 | 1 |  |  |  |  | 22 | my $encoded_auth_string = encode_base64($self->{application_key_id}.':'.$self->{application_key}); | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | # add that header in | 
| 57 | 1 |  |  |  |  | 10 | $self->{mech}->add_header( 'Authorization' => 'Basic '.$encoded_auth_string ); | 
| 58 |  |  |  |  |  |  |  | 
| 59 |  |  |  |  |  |  | # call the b2_talker() method to authenticate our session | 
| 60 | 1 |  |  |  |  | 25 | $self->b2_talker('url' => 'https://api.backblazeb2.com/b2api/v2/b2_authorize_account' ); | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | # if we succeeded, load in our authentication and prepare to proceed | 
| 63 | 1 | 50 |  |  |  | 5 | if ($self->{current_status} eq 'OK') { | 
| 64 |  |  |  |  |  |  |  | 
| 65 | 1 |  |  |  |  | 6 | $self->{account_id} = $self->{b2_response}{accountId}; | 
| 66 | 1 |  |  |  |  | 4 | $self->{api_url} = $self->{b2_response}{apiUrl}; | 
| 67 | 1 |  |  |  |  | 8 | $self->{account_authorization_token} = $self->{b2_response}{authorizationToken}; | 
| 68 | 1 |  |  |  |  | 5 | $self->{download_url} = $self->{b2_response}{downloadUrl}; | 
| 69 |  |  |  |  |  |  | # for uploading large files | 
| 70 | 1 |  | 50 |  |  | 7 | $self->{recommended_part_size} = $self->{b2_response}{recommendedPartSize} || 104857600; | 
| 71 |  |  |  |  |  |  | # ready! | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | # otherwise, not ready! | 
| 74 |  |  |  |  |  |  | } else { | 
| 75 | 0 |  |  |  |  | 0 | $self->{b2_login_error} = 1; | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | } | 
| 79 |  |  |  |  |  |  |  | 
| 80 |  |  |  |  |  |  | # method to download a file by ID; probably most commonly used | 
| 81 |  |  |  |  |  |  | sub b2_download_file_by_id { | 
| 82 | 1 |  |  | 1 | 1 | 11026 | my $self = shift; | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | # required arg is the file ID | 
| 85 |  |  |  |  |  |  | # option arg is a target directory to auto-save the new file into | 
| 86 | 1 |  |  |  |  | 4 | my ($file_id, $save_to_location) = @_; | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 1 | 50 |  |  |  | 13 | if (!$file_id) { | 
| 89 | 0 |  |  |  |  | 0 | $self->error_tracker('The file_id must be provided for b2_download_file_by_id().'); | 
| 90 | 0 |  |  |  |  | 0 | return; | 
| 91 |  |  |  |  |  |  | } | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | # send the request, as a GET | 
| 94 |  |  |  |  |  |  | $self->b2_talker( | 
| 95 |  |  |  |  |  |  | 'url' => $self->{download_url}.'/b2api/v2/b2_download_file_by_id?fileId='.$file_id, | 
| 96 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 97 | 1 |  |  |  |  | 11 | ); | 
| 98 |  |  |  |  |  |  |  | 
| 99 |  |  |  |  |  |  | # if the file was found, you will have the relevant headers in %{ $self->{b2_response} } | 
| 100 |  |  |  |  |  |  | # as well as the file's contents in $self->{b2_response}{file_contents} | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | # if they provided a save-to location (a directory) and the file was found, let's save it out | 
| 103 | 1 | 50 | 33 |  |  | 17 | if ($self->{current_status} eq 'OK' && $save_to_location) { | 
| 104 | 0 |  |  |  |  | 0 | $self->save_downloaded_file($save_to_location); | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  |  | 
| 110 |  |  |  |  |  |  | # method to download a file via the bucket name + file name | 
| 111 |  |  |  |  |  |  | sub b2_download_file_by_name { | 
| 112 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | # required args are the bucket name and file name | 
| 115 | 0 |  |  |  |  | 0 | my ($bucket_name, $file_name, $save_to_location) = @_; | 
| 116 |  |  |  |  |  |  |  | 
| 117 | 0 | 0 | 0 |  |  | 0 | if (!$bucket_name || !$file_name) { | 
| 118 | 0 |  |  |  |  | 0 | $self->error_tracker('The bucket_name and file_name must be provided for b2_download_file_by_name().'); | 
| 119 | 0 |  |  |  |  | 0 | return; | 
| 120 |  |  |  |  |  |  | } | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | # send the request, as a GET | 
| 123 |  |  |  |  |  |  | $self->b2_talker( | 
| 124 |  |  |  |  |  |  | 'url' => $self->{download_url}.'/file/'.uri_escape($bucket_name).'/'.uri_escape($file_name), | 
| 125 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 126 | 0 |  |  |  |  | 0 | ); | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | # if the file was found, you will have the relevant headers in %{ $self->{b2_response} } | 
| 130 |  |  |  |  |  |  | # as well as the file's contents in $self->{b2_response}{file_contents} | 
| 131 |  |  |  |  |  |  |  | 
| 132 |  |  |  |  |  |  | # if they provided a save-to location (a directory) and the file was found, let's save it out | 
| 133 | 0 | 0 | 0 |  |  | 0 | if ($self->{current_status} eq 'OK' && $save_to_location) { | 
| 134 | 0 |  |  |  |  | 0 | $self->save_downloaded_file($save_to_location); | 
| 135 |  |  |  |  |  |  | } | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | } | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | # method to save downloaded files into a target location | 
| 140 |  |  |  |  |  |  | # only call after successfully calling b2_download_file_by_id() or b2_download_file_by_name() | 
| 141 |  |  |  |  |  |  | sub save_downloaded_file { | 
| 142 | 0 |  |  | 0 | 0 | 0 | my $self = shift; | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | # required arg is a valid directory on this file system | 
| 145 | 0 |  |  |  |  | 0 | my ($save_to_location) = @_; | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | # error out if that location don't exist | 
| 148 | 0 | 0 | 0 |  |  | 0 | if (!$save_to_location || !(-d "$save_to_location") ) { | 
| 149 | 0 |  |  |  |  | 0 | $self->error_tracker("Can not auto-save file without a valid location. $save_to_location"); | 
| 150 | 0 |  |  |  |  | 0 | return; | 
| 151 |  |  |  |  |  |  | } | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | # make sure they actually downloaded a file | 
| 154 | 0 | 0 | 0 |  |  | 0 | if ( !$self->{b2_response}{'X-Bz-File-Name'} || !length($self->{b2_response}{file_contents}) ) { | 
| 155 | 0 |  |  |  |  | 0 | $self->error_tracker("Can not auto-save without first downloading a file."); | 
| 156 | 0 |  |  |  |  | 0 | return; | 
| 157 |  |  |  |  |  |  | } | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | # still here?  do the save | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | # add the filename | 
| 162 | 0 |  |  |  |  | 0 | $save_to_location .= '/'.$self->{b2_response}{'X-Bz-File-Name'}; | 
| 163 |  |  |  |  |  |  |  | 
| 164 |  |  |  |  |  |  | # i really love Path::Tiny | 
| 165 | 0 |  |  |  |  | 0 | path($save_to_location)->spew_raw( $self->{b2_response}{file_contents} ); | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | } | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | # method to upload a file into Backblaze B2 | 
| 170 |  |  |  |  |  |  | sub b2_upload_file { | 
| 171 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 172 |  |  |  |  |  |  |  | 
| 173 | 0 |  |  |  |  | 0 | my (%args) = @_; | 
| 174 |  |  |  |  |  |  | # this must include valid entries for 'new_file_name' and 'bucket_name' | 
| 175 |  |  |  |  |  |  | # and it has to include either the raw file contents in 'file_contents' | 
| 176 |  |  |  |  |  |  | # or a valid location in 'file_location' | 
| 177 |  |  |  |  |  |  | # also, you can include 'content_type' (which would be the MIME Type' | 
| 178 |  |  |  |  |  |  | # if you do not want B2 to auto-determine the MIME/content-type | 
| 179 |  |  |  |  |  |  |  | 
| 180 |  |  |  |  |  |  | # did they provide a file location or path? | 
| 181 | 0 | 0 | 0 |  |  | 0 | if ($args{file_location} && -e "$args{file_location}") { | 
| 182 | 0 |  |  |  |  | 0 | $args{file_contents} = path( $args{file_location} )->slurp_raw; | 
| 183 |  |  |  |  |  |  |  | 
| 184 |  |  |  |  |  |  | # if they didn't provide a file-name, use the one on this file | 
| 185 | 0 |  |  |  |  | 0 | $args{new_file_name} = path( $args{file_location} )->basename; | 
| 186 |  |  |  |  |  |  | } | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | # were these file contents either provided or found? | 
| 189 | 0 | 0 |  |  |  | 0 | if (!length($args{file_contents})) { | 
| 190 | 0 |  |  |  |  | 0 | $self->error_tracker(qq{You must provide either a valid 'file_location' or 'file_contents' arg for b2_upload_file().}); | 
| 191 | 0 |  |  |  |  | 0 | return; | 
| 192 |  |  |  |  |  |  | } | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | # check the other needed args | 
| 195 | 0 | 0 | 0 |  |  | 0 | if (!$args{bucket_name} || !$args{new_file_name}) { | 
| 196 | 0 |  |  |  |  | 0 | $self->error_tracker(qq{You must provide 'bucket_name' and 'new_file_name' args for b2_upload_file().}); | 
| 197 | 0 |  |  |  |  | 0 | return; | 
| 198 |  |  |  |  |  |  | } | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | # default content-type | 
| 201 | 0 |  | 0 |  |  | 0 | $args{content_type} ||= 'b2/x-auto'; | 
| 202 |  |  |  |  |  |  |  | 
| 203 |  |  |  |  |  |  | # OK, let's continue:  get the upload URL and authorization token for this bucket | 
| 204 | 0 |  |  |  |  | 0 | $self->b2_get_upload_url( $args{bucket_name} ); | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | # send the special request | 
| 207 |  |  |  |  |  |  | $self->b2_talker( | 
| 208 |  |  |  |  |  |  | 'url' => $self->{bucket_info}{ $args{bucket_name} }{upload_url}, | 
| 209 |  |  |  |  |  |  | 'authorization' => $self->{bucket_info}{ $args{bucket_name} }{authorization_token}, | 
| 210 |  |  |  |  |  |  | 'file_contents' => $args{file_contents}, | 
| 211 |  |  |  |  |  |  | 'special_headers' => { | 
| 212 |  |  |  |  |  |  | 'X-Bz-File-Name' => uri_escape( $args{new_file_name} ), | 
| 213 |  |  |  |  |  |  | 'X-Bz-Content-Sha1' => sha1_hex( $args{file_contents} ), | 
| 214 |  |  |  |  |  |  | 'Content-Type' => $args{content_type}, | 
| 215 |  |  |  |  |  |  | }, | 
| 216 | 0 |  |  |  |  | 0 | ); | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | # b2_talker will handle the rest | 
| 219 |  |  |  |  |  |  |  | 
| 220 |  |  |  |  |  |  | } | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | # method to get the information needed to upload into a specific B2 bucket | 
| 223 |  |  |  |  |  |  | sub b2_get_upload_url { | 
| 224 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | # the bucket name is required | 
| 227 | 0 |  |  |  |  | 0 | my ($bucket_name) = @_; | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | # bucket_name is required | 
| 230 | 0 | 0 |  |  |  | 0 | if (!$bucket_name) { | 
| 231 | 0 |  |  |  |  | 0 | $self->error_tracker('The bucket_name must be provided for b2_get_upload_url().'); | 
| 232 | 0 |  |  |  |  | 0 | return; | 
| 233 |  |  |  |  |  |  | } | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | # no need to proceed if we already have done for this bucket this during this session | 
| 236 |  |  |  |  |  |  | # return if $self->{bucket_info}{$bucket_name}{upload_url}; | 
| 237 |  |  |  |  |  |  | # COMMENTED OUT:  It seems like B2 wants a new upload_url endpoint for each upload, | 
| 238 |  |  |  |  |  |  | # and we may want to upload multiple files into each bucket...so this won't work | 
| 239 |  |  |  |  |  |  |  | 
| 240 |  |  |  |  |  |  | # if we don't have the info for the bucket name, retrieve the bucket's ID | 
| 241 | 0 | 0 |  |  |  | 0 | if (ref($self->{buckets}{$bucket_name}) ne 'HASH') { | 
| 242 | 0 |  |  |  |  | 0 | $self->b2_list_buckets($bucket_name); | 
| 243 |  |  |  |  |  |  | } | 
| 244 |  |  |  |  |  |  |  | 
| 245 |  |  |  |  |  |  | # send the request | 
| 246 |  |  |  |  |  |  | $self->b2_talker( | 
| 247 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_get_upload_url', | 
| 248 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 249 |  |  |  |  |  |  | 'post_params' => { | 
| 250 |  |  |  |  |  |  | 'bucketId' => $self->{buckets}{$bucket_name}{bucket_id}, | 
| 251 |  |  |  |  |  |  | }, | 
| 252 | 0 |  |  |  |  | 0 | ); | 
| 253 |  |  |  |  |  |  |  | 
| 254 |  |  |  |  |  |  | # if we succeeded, get the info for this bucket | 
| 255 | 0 | 0 |  |  |  | 0 | if ($self->{current_status} eq 'OK') { | 
| 256 |  |  |  |  |  |  |  | 
| 257 |  |  |  |  |  |  | $self->{bucket_info}{$bucket_name} = { | 
| 258 |  |  |  |  |  |  | 'upload_url' => $self->{b2_response}{uploadUrl}, | 
| 259 |  |  |  |  |  |  | 'authorization_token' => $self->{b2_response}{authorizationToken}, | 
| 260 | 0 |  |  |  |  | 0 | }; | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | } | 
| 263 |  |  |  |  |  |  |  | 
| 264 |  |  |  |  |  |  | } | 
| 265 |  |  |  |  |  |  |  | 
| 266 |  |  |  |  |  |  | # method to get information on one bucket or all buckets | 
| 267 |  |  |  |  |  |  | # specify the bucket-name to search by name | 
| 268 |  |  |  |  |  |  | sub b2_list_buckets { | 
| 269 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | # optional first arg is a target bucket name | 
| 272 |  |  |  |  |  |  | # optional second arg tells us to auto-create a bucket, if the name is provided but it was not found | 
| 273 | 0 |  |  |  |  | 0 | my ($bucket_name, $auto_create_bucket) = @_; | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | # send the request | 
| 276 |  |  |  |  |  |  | $self->b2_talker( | 
| 277 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_list_buckets', | 
| 278 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 279 |  |  |  |  |  |  | 'post_params' => { | 
| 280 |  |  |  |  |  |  | 'accountId' => $self->{account_id}, | 
| 281 | 0 |  |  |  |  | 0 | 'bucketName' => $bucket_name, | 
| 282 |  |  |  |  |  |  | }, | 
| 283 |  |  |  |  |  |  | ); | 
| 284 |  |  |  |  |  |  |  | 
| 285 |  |  |  |  |  |  | # if we succeeded, load in all the found buckets to $self->{buckets} | 
| 286 |  |  |  |  |  |  | # that will be a hash of info, keyed by name | 
| 287 |  |  |  |  |  |  |  | 
| 288 | 0 | 0 |  |  |  | 0 | if ($self->{current_status} eq 'OK') { | 
| 289 | 0 |  |  |  |  | 0 | foreach my $bucket_info (@{ $self->{b2_response}{buckets} }) { | 
|  | 0 |  |  |  |  | 0 |  | 
| 290 | 0 |  |  |  |  | 0 | $bucket_name = $$bucket_info{bucketName}; | 
| 291 |  |  |  |  |  |  |  | 
| 292 |  |  |  |  |  |  | $self->{buckets}{$bucket_name} = { | 
| 293 |  |  |  |  |  |  | 'bucket_id' => $$bucket_info{bucketId}, | 
| 294 |  |  |  |  |  |  | 'bucket_type' => $$bucket_info{bucketType}, | 
| 295 | 0 |  |  |  |  | 0 | }; | 
| 296 |  |  |  |  |  |  | } | 
| 297 |  |  |  |  |  |  | } | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  | # if that bucket was not found, maybe they want to go ahead and create it? | 
| 300 | 0 | 0 | 0 |  |  | 0 | if ($bucket_name && !$self->{buckets}{$bucket_name} && $auto_create_bucket) { | 
|  |  |  | 0 |  |  |  |  | 
| 301 | 0 |  |  |  |  | 0 | $self->b2_bucket_maker($bucket_name); | 
| 302 |  |  |  |  |  |  | # this will call back to me and get the info | 
| 303 |  |  |  |  |  |  | } | 
| 304 |  |  |  |  |  |  |  | 
| 305 |  |  |  |  |  |  | } | 
| 306 |  |  |  |  |  |  |  | 
| 307 |  |  |  |  |  |  | # method to retrieve file names / info from a bucket | 
| 308 |  |  |  |  |  |  | # this client library is bucket-name-centric, so it looks for the bucket name as a arg | 
| 309 |  |  |  |  |  |  | # if there are more than 1000 files, then call this repeatedly | 
| 310 |  |  |  |  |  |  | sub b2_list_file_names { | 
| 311 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 312 |  |  |  |  |  |  |  | 
| 313 | 0 |  |  |  |  | 0 | my ($bucket_name) = @_; | 
| 314 |  |  |  |  |  |  |  | 
| 315 |  |  |  |  |  |  | # bucket_name is required | 
| 316 | 0 | 0 |  |  |  | 0 | if (!$bucket_name) { | 
| 317 | 0 |  |  |  |  | 0 | $self->error_tracker('The bucket_name must be provided for b2_list_file_names().'); | 
| 318 | 0 |  |  |  |  | 0 | return; | 
| 319 |  |  |  |  |  |  | } | 
| 320 |  |  |  |  |  |  |  | 
| 321 |  |  |  |  |  |  | # we need the bucket ID | 
| 322 |  |  |  |  |  |  | # if we don't have the info for the bucket name, retrieve the bucket's ID | 
| 323 | 0 | 0 |  |  |  | 0 | if (ref($self->{buckets}{$bucket_name}) ne 'HASH') { | 
| 324 | 0 |  |  |  |  | 0 | $self->b2_list_buckets($bucket_name); | 
| 325 |  |  |  |  |  |  | } | 
| 326 |  |  |  |  |  |  |  | 
| 327 |  |  |  |  |  |  | # retrieve the files | 
| 328 |  |  |  |  |  |  | $self->b2_talker( | 
| 329 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_list_file_names', | 
| 330 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 331 |  |  |  |  |  |  | 'post_params' => { | 
| 332 |  |  |  |  |  |  | 'accountId' => $self->{account_id}, | 
| 333 |  |  |  |  |  |  | 'bucketId' => $self->{buckets}{$bucket_name}{bucket_id}, | 
| 334 |  |  |  |  |  |  | 'startFileName' => $self->{buckets}{$bucket_name}{next_file_name}, | 
| 335 |  |  |  |  |  |  | }, | 
| 336 | 0 |  |  |  |  | 0 | ); | 
| 337 |  |  |  |  |  |  |  | 
| 338 |  |  |  |  |  |  | # if we succeeded, read in the files | 
| 339 | 0 | 0 |  |  |  | 0 | if ($self->{current_status} eq 'OK') { | 
| 340 | 0 |  |  |  |  | 0 | $self->{buckets}{$bucket_name}{next_file_name} = $self->{b2_response}{nextFileName}; | 
| 341 |  |  |  |  |  |  |  | 
| 342 |  |  |  |  |  |  | # i am not going to waste the CPU cycles de-camelizing these sub-keys | 
| 343 |  |  |  |  |  |  | # add to our possibly-started array of file info for this bucket | 
| 344 |  |  |  |  |  |  | push( | 
| 345 | 0 |  |  |  |  | 0 | @{ $self->{buckets}{$bucket_name}{files} }, | 
| 346 | 0 |  |  |  |  | 0 | @{ $self->{b2_response}{files} } | 
|  | 0 |  |  |  |  | 0 |  | 
| 347 |  |  |  |  |  |  | ); | 
| 348 |  |  |  |  |  |  | } | 
| 349 |  |  |  |  |  |  |  | 
| 350 |  |  |  |  |  |  |  | 
| 351 |  |  |  |  |  |  | } | 
| 352 |  |  |  |  |  |  |  | 
| 353 |  |  |  |  |  |  | # method to get info for a specific file | 
| 354 |  |  |  |  |  |  | # I assume you have the File ID for the file | 
| 355 |  |  |  |  |  |  | sub b2_get_file_info { | 
| 356 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 357 |  |  |  |  |  |  |  | 
| 358 |  |  |  |  |  |  | # required arg is the file ID | 
| 359 | 0 |  |  |  |  | 0 | my ($file_id) = @_; | 
| 360 |  |  |  |  |  |  |  | 
| 361 | 0 | 0 |  |  |  | 0 | if (!$file_id) { | 
| 362 | 0 |  |  |  |  | 0 | $self->error_tracker('The file_id must be provided for b2_get_file_info().'); | 
| 363 | 0 |  |  |  |  | 0 | return; | 
| 364 |  |  |  |  |  |  | } | 
| 365 |  |  |  |  |  |  |  | 
| 366 |  |  |  |  |  |  | # kick out if we already have it | 
| 367 | 0 | 0 |  |  |  | 0 | return if ref($self->{file_info}{$file_id}) eq 'HASH'; | 
| 368 |  |  |  |  |  |  |  | 
| 369 |  |  |  |  |  |  | # retrieve the file information | 
| 370 |  |  |  |  |  |  | $self->b2_talker( | 
| 371 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_get_file_info', | 
| 372 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 373 | 0 |  |  |  |  | 0 | 'post_params' => { | 
| 374 |  |  |  |  |  |  | 'fileId' => $file_id, | 
| 375 |  |  |  |  |  |  | }, | 
| 376 |  |  |  |  |  |  | ); | 
| 377 |  |  |  |  |  |  |  | 
| 378 |  |  |  |  |  |  | # if we succeeded, read in the information | 
| 379 | 0 | 0 |  |  |  | 0 | if ($self->{current_status} eq 'OK') { | 
| 380 |  |  |  |  |  |  | # i am not going to waste the CPU cycles de-camelizing these sub-keys | 
| 381 | 0 |  |  |  |  | 0 | $self->{file_info}{$file_id} = $self->{b2_response}; | 
| 382 |  |  |  |  |  |  | } | 
| 383 |  |  |  |  |  |  |  | 
| 384 |  |  |  |  |  |  | } | 
| 385 |  |  |  |  |  |  |  | 
| 386 |  |  |  |  |  |  | # combo method to create a bucket | 
| 387 |  |  |  |  |  |  | sub b2_bucket_maker { | 
| 388 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 389 |  |  |  |  |  |  |  | 
| 390 | 0 |  |  |  |  | 0 | my ($bucket_name, $disable_encryption) = @_; | 
| 391 |  |  |  |  |  |  |  | 
| 392 |  |  |  |  |  |  | # can't proceed without the bucket_name | 
| 393 | 0 | 0 |  |  |  | 0 | if (!$bucket_name) { | 
| 394 | 0 |  |  |  |  | 0 | $self->error_tracker('The bucket_name must be provided for b2_bucket_maker().'); | 
| 395 | 0 |  |  |  |  | 0 | return; | 
| 396 |  |  |  |  |  |  | } | 
| 397 |  |  |  |  |  |  |  | 
| 398 |  |  |  |  |  |  | # prepare the basics for our request | 
| 399 |  |  |  |  |  |  | my $post_params = { | 
| 400 |  |  |  |  |  |  | 'accountId' => $self->{account_id}, | 
| 401 | 0 |  |  |  |  | 0 | 'bucketName' => $bucket_name, | 
| 402 |  |  |  |  |  |  | 'bucketType' => 'allPrivate', | 
| 403 |  |  |  |  |  |  | }; | 
| 404 |  |  |  |  |  |  |  | 
| 405 |  |  |  |  |  |  | # unless instructed otherwise, we should encrypt the files in this bucket | 
| 406 | 0 | 0 |  |  |  | 0 | unless ($disable_encryption) { | 
| 407 |  |  |  |  |  |  | $$post_params{defaultServerSideEncryption} = { | 
| 408 | 0 |  |  |  |  | 0 | 'mode' => 'SSE-B2', | 
| 409 |  |  |  |  |  |  | 'algorithm' => 'AES256', | 
| 410 |  |  |  |  |  |  | }; | 
| 411 |  |  |  |  |  |  | } | 
| 412 |  |  |  |  |  |  |  | 
| 413 |  |  |  |  |  |  | # create the bucket... | 
| 414 |  |  |  |  |  |  | $self->b2_talker( | 
| 415 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_create_bucket', | 
| 416 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 417 | 0 |  |  |  |  | 0 | 'post_params' => $post_params, | 
| 418 |  |  |  |  |  |  | ); | 
| 419 |  |  |  |  |  |  |  | 
| 420 | 0 | 0 |  |  |  | 0 | if ($self->{current_status} eq 'OK') { # if successful... | 
| 421 |  |  |  |  |  |  |  | 
| 422 |  |  |  |  |  |  | # stash our new bucket into $self->{buckets} | 
| 423 |  |  |  |  |  |  | $self->{buckets}{$bucket_name} = { | 
| 424 |  |  |  |  |  |  | 'bucket_id' => $self->{b2_response}{bucketId}, | 
| 425 | 0 |  |  |  |  | 0 | 'bucket_type' => 'allPrivate', | 
| 426 |  |  |  |  |  |  | }; | 
| 427 |  |  |  |  |  |  |  | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  |  | 
| 430 |  |  |  |  |  |  | } | 
| 431 |  |  |  |  |  |  |  | 
| 432 |  |  |  |  |  |  | # method to delete a bucket -- please don't use ;) | 
| 433 |  |  |  |  |  |  | sub b2_delete_bucket { | 
| 434 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 435 |  |  |  |  |  |  |  | 
| 436 | 0 |  |  |  |  | 0 | my ($bucket_name) = @_; | 
| 437 |  |  |  |  |  |  |  | 
| 438 |  |  |  |  |  |  | # bucket_id is required | 
| 439 | 0 | 0 |  |  |  | 0 | if (!$bucket_name) { | 
| 440 | 0 |  |  |  |  | 0 | $self->error_tracker('The bucket_name must be provided for b2_delete_bucket().'); | 
| 441 | 0 |  |  |  |  | 0 | return; | 
| 442 |  |  |  |  |  |  | } | 
| 443 |  |  |  |  |  |  |  | 
| 444 |  |  |  |  |  |  | # resolve that bucket_name to a bucket_id | 
| 445 | 0 |  |  |  |  | 0 | $self->b2_list_buckets($bucket_name); | 
| 446 |  |  |  |  |  |  |  | 
| 447 |  |  |  |  |  |  | # send the request | 
| 448 |  |  |  |  |  |  | $self->b2_talker( | 
| 449 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_delete_bucket', | 
| 450 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 451 |  |  |  |  |  |  | 'post_params' => { | 
| 452 |  |  |  |  |  |  | 'accountId' => $self->{account_id}, | 
| 453 |  |  |  |  |  |  | 'bucketId' => $self->{buckets}{$bucket_name}{bucket_id}, | 
| 454 |  |  |  |  |  |  | }, | 
| 455 | 0 |  |  |  |  | 0 | ); | 
| 456 |  |  |  |  |  |  |  | 
| 457 |  |  |  |  |  |  | } | 
| 458 |  |  |  |  |  |  |  | 
| 459 |  |  |  |  |  |  | # method to delete a stored file object.  B2 thinks of these as 'versions,' | 
| 460 |  |  |  |  |  |  | # but if you use unique names, one version = one file | 
| 461 |  |  |  |  |  |  | sub b2_delete_file_version { | 
| 462 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 463 |  |  |  |  |  |  |  | 
| 464 |  |  |  |  |  |  | # required arguments are the file_name and file_id for the target file | 
| 465 | 0 |  |  |  |  | 0 | my ($file_name, $file_id) = @_; | 
| 466 |  |  |  |  |  |  |  | 
| 467 |  |  |  |  |  |  | # bucket_id is required | 
| 468 | 0 | 0 | 0 |  |  | 0 | if (!$file_name || !$file_id) { | 
| 469 | 0 |  |  |  |  | 0 | $self->error_tracker('The file_name and file_id args must be provided for b2_delete_file_version().'); | 
| 470 | 0 |  |  |  |  | 0 | return; | 
| 471 |  |  |  |  |  |  | } | 
| 472 |  |  |  |  |  |  |  | 
| 473 |  |  |  |  |  |  | # send the request | 
| 474 |  |  |  |  |  |  | $self->b2_talker( | 
| 475 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_delete_file_version', | 
| 476 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 477 | 0 |  |  |  |  | 0 | 'post_params' => { | 
| 478 |  |  |  |  |  |  | 'fileName' => $file_name, | 
| 479 |  |  |  |  |  |  | 'fileId' => $file_id, | 
| 480 |  |  |  |  |  |  | }, | 
| 481 |  |  |  |  |  |  | ); | 
| 482 |  |  |  |  |  |  |  | 
| 483 |  |  |  |  |  |  |  | 
| 484 |  |  |  |  |  |  | } | 
| 485 |  |  |  |  |  |  |  | 
| 486 |  |  |  |  |  |  | # method to upload a large file (>100MB) | 
| 487 |  |  |  |  |  |  | sub b2_upload_large_file { | 
| 488 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 489 | 0 |  |  |  |  | 0 | my (%args) = @_; | 
| 490 |  |  |  |  |  |  | # this must include valid entries for 'new_file_name' and 'bucket_name' | 
| 491 |  |  |  |  |  |  | # and it has to a valid location in 'file_location' (Do not load in file contents) | 
| 492 |  |  |  |  |  |  | # also, you can include 'content_type' (which would be the MIME Type' | 
| 493 |  |  |  |  |  |  | # if you do not want B2 to auto-determine the MIME/content-type | 
| 494 |  |  |  |  |  |  |  | 
| 495 |  |  |  |  |  |  | # did they provide a file location or path? | 
| 496 | 0 | 0 | 0 |  |  | 0 | if ($args{file_location} && -e "$args{file_location}") { | 
| 497 |  |  |  |  |  |  | # if they didn't provide a file-name, use the one on this file | 
| 498 | 0 |  |  |  |  | 0 | $args{new_file_name} = path( $args{file_location} )->basename; | 
| 499 |  |  |  |  |  |  | } else { | 
| 500 | 0 |  |  |  |  | 0 | $self->error_tracker(qq{You must provide a valid 'file_location' arg for b2_upload_large_file().}); | 
| 501 | 0 |  |  |  |  | 0 | return; | 
| 502 |  |  |  |  |  |  | } | 
| 503 |  |  |  |  |  |  |  | 
| 504 |  |  |  |  |  |  | # protect my sanity... | 
| 505 | 0 |  |  |  |  | 0 | my ($bucket_name, $file_contents_part, $file_location, $large_file_id, $part_number, $remaining_file_size, $sha1_array, $size_sent, $stat); | 
| 506 | 0 |  |  |  |  | 0 | $file_location = $args{file_location}; | 
| 507 | 0 |  |  |  |  | 0 | $bucket_name = $args{bucket_name}; | 
| 508 |  |  |  |  |  |  |  | 
| 509 |  |  |  |  |  |  | # must be 100MB or bigger | 
| 510 | 0 |  |  |  |  | 0 | $stat = path($file_location)->stat; | 
| 511 | 0 | 0 |  |  |  | 0 | if ($stat->size < $self->{recommended_part_size} ) { | 
| 512 | 0 |  |  |  |  | 0 | $self->error_tracker(qq{Please use b2_upload_large_file() for files larger than $self->{recommended_part_size} .}); | 
| 513 | 0 |  |  |  |  | 0 | return; | 
| 514 |  |  |  |  |  |  | } | 
| 515 |  |  |  |  |  |  |  | 
| 516 |  |  |  |  |  |  | # need a bucket name | 
| 517 | 0 | 0 |  |  |  | 0 | if (!$bucket_name) { | 
| 518 | 0 |  |  |  |  | 0 | $self->error_tracker(qq{You must provide a valid 'bucket_name' arg for b2_upload_large_file().}); | 
| 519 | 0 |  |  |  |  | 0 | return; | 
| 520 |  |  |  |  |  |  | } | 
| 521 |  |  |  |  |  |  |  | 
| 522 |  |  |  |  |  |  | # default content-type | 
| 523 | 0 |  | 0 |  |  | 0 | $args{content_type} ||= 'b2/x-auto'; | 
| 524 |  |  |  |  |  |  |  | 
| 525 |  |  |  |  |  |  | # get the bucket ID | 
| 526 | 0 |  |  |  |  | 0 | $self->b2_list_buckets($bucket_name); | 
| 527 |  |  |  |  |  |  |  | 
| 528 |  |  |  |  |  |  | # kick off the upload in the API | 
| 529 |  |  |  |  |  |  | $self->b2_talker( | 
| 530 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_start_large_file', | 
| 531 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 532 |  |  |  |  |  |  | 'post_params' => { | 
| 533 |  |  |  |  |  |  | 'bucketId' => $self->{buckets}{$bucket_name}{bucket_id}, | 
| 534 |  |  |  |  |  |  | 'fileName' => $args{new_file_name}, | 
| 535 |  |  |  |  |  |  | 'contentType' => $args{content_type}, | 
| 536 |  |  |  |  |  |  | }, | 
| 537 | 0 |  |  |  |  | 0 | ); | 
| 538 |  |  |  |  |  |  |  | 
| 539 |  |  |  |  |  |  | # these are all needed for each b2_upload_part web call | 
| 540 | 0 |  |  |  |  | 0 | $large_file_id = $self->{b2_response}{fileId}; | 
| 541 | 0 | 0 |  |  |  | 0 | return if !$large_file_id; # there was an error in the request | 
| 542 |  |  |  |  |  |  |  | 
| 543 |  |  |  |  |  |  | # open the large file | 
| 544 | 0 |  |  |  |  | 0 | open(FH, $file_location); | 
| 545 |  |  |  |  |  |  |  | 
| 546 | 0 |  |  |  |  | 0 | $remaining_file_size = $stat->size; | 
| 547 |  |  |  |  |  |  |  | 
| 548 | 0 |  |  |  |  | 0 | $part_number = 1; | 
| 549 |  |  |  |  |  |  |  | 
| 550 |  |  |  |  |  |  | # cycle thru each chunk of the file | 
| 551 | 0 |  |  |  |  | 0 | while ($remaining_file_size >= 0) { | 
| 552 |  |  |  |  |  |  | # how much to send? | 
| 553 | 0 | 0 |  |  |  | 0 | if ($remaining_file_size < $self->{recommended_part_size} ) { | 
| 554 | 0 |  |  |  |  | 0 | $size_sent = $remaining_file_size; | 
| 555 |  |  |  |  |  |  | } else { | 
| 556 | 0 |  |  |  |  | 0 | $size_sent = $self->{recommended_part_size} ; | 
| 557 |  |  |  |  |  |  | } | 
| 558 |  |  |  |  |  |  |  | 
| 559 |  |  |  |  |  |  | # get the next upload url for this part | 
| 560 |  |  |  |  |  |  | $self->b2_talker( | 
| 561 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_get_upload_part_url', | 
| 562 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 563 | 0 |  |  |  |  | 0 | 'post_params' => { | 
| 564 |  |  |  |  |  |  | 'fileId' => $large_file_id, | 
| 565 |  |  |  |  |  |  | }, | 
| 566 |  |  |  |  |  |  | ); | 
| 567 |  |  |  |  |  |  |  | 
| 568 |  |  |  |  |  |  | # read in that section of the file and prep the SHA | 
| 569 | 0 |  |  |  |  | 0 | sysread FH, $file_contents_part, $size_sent; | 
| 570 | 0 |  |  |  |  | 0 | push(@$sha1_array,sha1_hex( $file_contents_part )); | 
| 571 |  |  |  |  |  |  |  | 
| 572 |  |  |  |  |  |  | # upload that part | 
| 573 |  |  |  |  |  |  | $self->b2_talker( | 
| 574 |  |  |  |  |  |  | 'url' => $self->{b2_response}{uploadUrl}, | 
| 575 |  |  |  |  |  |  | 'authorization' => $self->{b2_response}{authorizationToken}, | 
| 576 | 0 |  |  |  |  | 0 | 'special_headers' => { | 
| 577 |  |  |  |  |  |  | 'X-Bz-Content-Sha1' => $$sha1_array[-1], | 
| 578 |  |  |  |  |  |  | 'X-Bz-Part-Number' => $part_number, | 
| 579 |  |  |  |  |  |  | 'Content-Length' => $size_sent, | 
| 580 |  |  |  |  |  |  | }, | 
| 581 |  |  |  |  |  |  | 'file_contents' => $file_contents_part, | 
| 582 |  |  |  |  |  |  | ); | 
| 583 |  |  |  |  |  |  |  | 
| 584 |  |  |  |  |  |  | # advance | 
| 585 | 0 |  |  |  |  | 0 | $part_number++; | 
| 586 | 0 |  |  |  |  | 0 | $remaining_file_size -= $self->{recommended_part_size} ; | 
| 587 |  |  |  |  |  |  | } | 
| 588 |  |  |  |  |  |  |  | 
| 589 |  |  |  |  |  |  | # close the file | 
| 590 | 0 |  |  |  |  | 0 | close FH; | 
| 591 |  |  |  |  |  |  |  | 
| 592 |  |  |  |  |  |  | # and tell B2 | 
| 593 |  |  |  |  |  |  | $self->b2_talker( | 
| 594 |  |  |  |  |  |  | 'url' => $self->{api_url}.'/b2api/v2/b2_finish_large_file', | 
| 595 |  |  |  |  |  |  | 'authorization' => $self->{account_authorization_token}, | 
| 596 | 0 |  |  |  |  | 0 | 'post_params' => { | 
| 597 |  |  |  |  |  |  | 'fileId' => $large_file_id, | 
| 598 |  |  |  |  |  |  | 'partSha1Array' => $sha1_array, | 
| 599 |  |  |  |  |  |  | }, | 
| 600 |  |  |  |  |  |  | ); | 
| 601 |  |  |  |  |  |  |  | 
| 602 |  |  |  |  |  |  | # phew, i'm tired... | 
| 603 |  |  |  |  |  |  | } | 
| 604 |  |  |  |  |  |  |  | 
| 605 |  |  |  |  |  |  |  | 
| 606 |  |  |  |  |  |  | # generic method to handle communication to B2 | 
| 607 |  |  |  |  |  |  | sub b2_talker { | 
| 608 | 2 |  |  | 2 | 1 | 6 | my $self = shift; | 
| 609 |  |  |  |  |  |  |  | 
| 610 |  |  |  |  |  |  | # args hash must include 'url' for the target API endpoint URL | 
| 611 |  |  |  |  |  |  | # most other requests will also include a 'post_params' hashref, and 'authorization' value for the header | 
| 612 |  |  |  |  |  |  | # for the b2_upload_file function, there will be several other headers + a file_contents arg | 
| 613 | 2 |  |  |  |  | 11 | my (%args) = @_; | 
| 614 |  |  |  |  |  |  |  | 
| 615 | 2 | 50 |  |  |  | 10 | if (!$args{url}) { | 
| 616 | 0 |  |  |  |  | 0 | $self->error_tracker('Can not use b2_talker() without an endpoint URL.'); | 
| 617 |  |  |  |  |  |  | } | 
| 618 |  |  |  |  |  |  |  | 
| 619 |  |  |  |  |  |  | # if they sent an Authorization header, set that value | 
| 620 | 2 | 100 |  |  |  | 11 | if ($args{authorization}) { | 
| 621 | 1 |  |  |  |  | 10 | $self->{mech}->delete_header( 'Authorization' ); | 
| 622 | 1 |  |  |  |  | 21 | $self->{mech}->add_header( 'Authorization' => $args{authorization} ); | 
| 623 |  |  |  |  |  |  | } | 
| 624 |  |  |  |  |  |  |  | 
| 625 | 2 |  |  |  |  | 21 | my ($response, $response_code, $error_message, $header, @header_keys); | 
| 626 |  |  |  |  |  |  |  | 
| 627 |  |  |  |  |  |  | # short-circuit if we had difficulty logging in previously | 
| 628 | 2 | 50 |  |  |  | 10 | if ($self->{b2_login_error}) { | 
| 629 |  |  |  |  |  |  |  | 
| 630 |  |  |  |  |  |  | # track the error / set current state | 
| 631 | 0 |  |  |  |  | 0 | $self->error_tracker("Problem logging into Backblaze.  Please check the 'errors' array in this object.", $args{url}); | 
| 632 |  |  |  |  |  |  |  | 
| 633 | 0 |  |  |  |  | 0 | return; | 
| 634 |  |  |  |  |  |  | } | 
| 635 |  |  |  |  |  |  |  | 
| 636 |  |  |  |  |  |  | # are we uploading a file? | 
| 637 | 2 | 50 |  |  |  | 17 | if ($args{url} =~ /b2_upload_file|b2_upload_part/) { | 
|  |  | 50 |  |  |  |  |  | 
| 638 |  |  |  |  |  |  |  | 
| 639 |  |  |  |  |  |  | # add the special headers | 
| 640 | 0 |  |  |  |  | 0 | @header_keys = keys %{ $args{special_headers} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 641 | 0 |  |  |  |  | 0 | foreach $header (@header_keys) { | 
| 642 | 0 |  |  |  |  | 0 | $self->{mech}->delete_header( $header ); | 
| 643 | 0 |  |  |  |  | 0 | $self->{mech}->add_header( $header => $args{special_headers}{$header} ); | 
| 644 |  |  |  |  |  |  | } | 
| 645 |  |  |  |  |  |  |  | 
| 646 |  |  |  |  |  |  | # now upload the file | 
| 647 | 0 |  |  |  |  | 0 | eval { | 
| 648 | 0 |  |  |  |  | 0 | $response = $self->{mech}->post( $args{url}, content => $args{file_contents} ); | 
| 649 |  |  |  |  |  |  |  | 
| 650 |  |  |  |  |  |  | # we want this to be 200 | 
| 651 | 0 |  |  |  |  | 0 | $response_code = $response->{_rc}; | 
| 652 |  |  |  |  |  |  |  | 
| 653 | 0 |  |  |  |  | 0 | $self->{b2_response} = decode_json( $self->{mech}->content() ); | 
| 654 |  |  |  |  |  |  |  | 
| 655 |  |  |  |  |  |  | }; | 
| 656 |  |  |  |  |  |  |  | 
| 657 |  |  |  |  |  |  | # remove those special headers, cleaned-up for next time | 
| 658 | 0 |  |  |  |  | 0 | foreach $header (@header_keys) { | 
| 659 | 0 |  |  |  |  | 0 | $self->{mech}->delete_header( $header ); | 
| 660 |  |  |  |  |  |  | } | 
| 661 |  |  |  |  |  |  |  | 
| 662 |  |  |  |  |  |  | # if not uploading and they sent POST params, we are doing a POST | 
| 663 |  |  |  |  |  |  | } elsif (ref($args{post_params}) eq 'HASH') { | 
| 664 | 0 |  |  |  |  | 0 | eval { | 
| 665 |  |  |  |  |  |  | # send the POST | 
| 666 | 0 |  |  |  |  | 0 | $response = $self->{mech}->post( $args{url}, content => encode_json($args{post_params}) ); | 
| 667 |  |  |  |  |  |  |  | 
| 668 |  |  |  |  |  |  | # we want this to be 200 | 
| 669 | 0 |  |  |  |  | 0 | $response_code = $response->code; | 
| 670 |  |  |  |  |  |  |  | 
| 671 |  |  |  |  |  |  | # decode results | 
| 672 | 0 |  |  |  |  | 0 | $self->{b2_response} = decode_json( $self->{mech}->content() ); | 
| 673 |  |  |  |  |  |  | }; | 
| 674 |  |  |  |  |  |  |  | 
| 675 |  |  |  |  |  |  | # otherwise, we are doing a GET | 
| 676 |  |  |  |  |  |  | } else { | 
| 677 |  |  |  |  |  |  |  | 
| 678 |  |  |  |  |  |  | # attempt the GET | 
| 679 | 2 |  |  |  |  | 6 | eval { | 
| 680 | 2 |  |  |  |  | 15 | $response = $self->{mech}->get( $args{url} ); | 
| 681 |  |  |  |  |  |  |  | 
| 682 |  |  |  |  |  |  | # we want this to be 200 | 
| 683 | 2 |  |  |  |  | 1829935 | $response_code = $response->code; | 
| 684 |  |  |  |  |  |  |  | 
| 685 |  |  |  |  |  |  | # did we download a file? | 
| 686 | 2 | 100 |  |  |  | 59 | if ($response->header( 'X-Bz-File-Name' )) { | 
|  |  | 50 |  |  |  |  |  | 
| 687 |  |  |  |  |  |  |  | 
| 688 |  |  |  |  |  |  | # grab those needed headers | 
| 689 | 1 |  |  |  |  | 53 | foreach $header ('Content-Length','Content-Type','X-Bz-File-Id','X-Bz-File-Name','X-Bz-Content-Sha1') { | 
| 690 | 5 |  |  |  |  | 189 | $self->{b2_response}{$header} = $response->header( $header ); | 
| 691 |  |  |  |  |  |  | } | 
| 692 |  |  |  |  |  |  |  | 
| 693 |  |  |  |  |  |  | # and the file itself | 
| 694 | 1 |  |  |  |  | 52 | $self->{b2_response}{file_contents} = $self->{mech}->content(); | 
| 695 |  |  |  |  |  |  |  | 
| 696 |  |  |  |  |  |  | } elsif ($response_code eq '200') { # no, regular JSON, decode results | 
| 697 | 1 |  |  |  |  | 157 | $self->{b2_response} = decode_json( $self->{mech}->content() ); | 
| 698 |  |  |  |  |  |  | } | 
| 699 |  |  |  |  |  |  | }; | 
| 700 |  |  |  |  |  |  | } | 
| 701 |  |  |  |  |  |  |  | 
| 702 |  |  |  |  |  |  | # there is a problem if there is a problem | 
| 703 | 2 | 50 | 33 |  |  | 138 | if ($@ || $response_code ne '200') { | 
| 704 | 0 | 0 |  |  |  | 0 | if ($self->{b2_response}{message}) { | 
| 705 | 0 |  |  |  |  | 0 | $error_message = 'API Message: '.$self->{b2_response}{message}; | 
| 706 |  |  |  |  |  |  | } else { | 
| 707 | 0 |  |  |  |  | 0 | $error_message = 'Error: '.$@; | 
| 708 |  |  |  |  |  |  | } | 
| 709 |  |  |  |  |  |  |  | 
| 710 |  |  |  |  |  |  | # track the error / set current state | 
| 711 | 0 |  |  |  |  | 0 | $self->error_tracker($error_message, $args{url}, $response_code); | 
| 712 |  |  |  |  |  |  |  | 
| 713 |  |  |  |  |  |  | # otherwise, we are in pretty good shape | 
| 714 |  |  |  |  |  |  | } else { | 
| 715 |  |  |  |  |  |  |  | 
| 716 | 2 |  |  |  |  | 14 | $self->{current_status} = 'OK'; | 
| 717 |  |  |  |  |  |  | } | 
| 718 |  |  |  |  |  |  |  | 
| 719 |  |  |  |  |  |  | } | 
| 720 |  |  |  |  |  |  |  | 
| 721 |  |  |  |  |  |  | # for tracking errors into $self->{errrors}[]; | 
| 722 |  |  |  |  |  |  | sub error_tracker { | 
| 723 | 0 |  |  | 0 | 0 | 0 | my $self = shift; | 
| 724 |  |  |  |  |  |  |  | 
| 725 | 0 |  |  |  |  | 0 | my ($error_message, $url, $response_code) = @_; | 
| 726 |  |  |  |  |  |  | # required is the error message; optional is the URL we were trying to call, | 
| 727 |  |  |  |  |  |  | # and the HTTP status code returned in that API call | 
| 728 |  |  |  |  |  |  |  | 
| 729 | 0 | 0 |  |  |  | 0 | return if !$error_message; | 
| 730 |  |  |  |  |  |  |  | 
| 731 |  |  |  |  |  |  | # defaults | 
| 732 | 0 |  | 0 |  |  | 0 | $url ||= 'N/A'; | 
| 733 | 0 |  | 0 |  |  | 0 | $response_code ||= 'N/A'; | 
| 734 |  |  |  |  |  |  |  | 
| 735 |  |  |  |  |  |  | # we must currently be in an error state | 
| 736 | 0 |  |  |  |  | 0 | $self->{current_status} = 'Error'; | 
| 737 |  |  |  |  |  |  |  | 
| 738 |  |  |  |  |  |  | # track the error | 
| 739 | 0 |  |  |  |  | 0 | push(@{ $self->{errors} }, { | 
|  | 0 |  |  |  |  | 0 |  | 
| 740 |  |  |  |  |  |  | 'error_message' => $error_message, | 
| 741 |  |  |  |  |  |  | 'url' => $url, | 
| 742 |  |  |  |  |  |  | 'response_code' => $response_code, | 
| 743 |  |  |  |  |  |  | }); | 
| 744 |  |  |  |  |  |  |  | 
| 745 |  |  |  |  |  |  | } | 
| 746 |  |  |  |  |  |  |  | 
| 747 |  |  |  |  |  |  | # please tell me the lastest error message | 
| 748 |  |  |  |  |  |  | sub latest_error { | 
| 749 | 2 |  |  | 2 | 0 | 13 | my $self = shift; | 
| 750 |  |  |  |  |  |  |  | 
| 751 |  |  |  |  |  |  | # don't fall for the old "Modification of non-creatable array value attempted" trick | 
| 752 | 2 | 50 |  |  |  | 21 | return 'No error message found' if !$self->{errors}[0]; | 
| 753 |  |  |  |  |  |  |  | 
| 754 | 0 |  |  |  |  |  | my $error = $self->{errors}[-1]; | 
| 755 | 0 |  |  |  |  |  | return $$error{error_message}.' ('.$$error{response_code}.')'; | 
| 756 |  |  |  |  |  |  |  | 
| 757 |  |  |  |  |  |  | } | 
| 758 |  |  |  |  |  |  |  | 
| 759 |  |  |  |  |  |  | 1; | 
| 760 |  |  |  |  |  |  |  | 
| 761 |  |  |  |  |  |  | __END__ |