File Coverage

lib/Yandex/Disk.pm
Criterion Covered Total %
statement 216 257 84.0
branch 45 98 45.9
condition 12 35 34.2
subroutine 29 32 90.6
pod 9 12 75.0
total 311 434 71.6


line stmt bran cond sub pod time code
1             package Yandex::Disk;
2              
3 2     2   71830 use 5.008001;
  2         6  
4 2     2   9 use strict;
  2         4  
  2         46  
5 2     2   9 use warnings;
  2         3  
  2         40  
6 2     2   657 use utf8;
  2         16  
  2         8  
7 2     2   449 use Yandex::Disk::Public;
  2         5  
  2         59  
8 2     2   10 use Carp qw/croak carp/;
  2         4  
  2         85  
9 2     2   1269 use LWP::UserAgent;
  2         86347  
  2         71  
10 2     2   1287 use JSON::XS;
  2         9383  
  2         105  
11 2     2   14 use File::Basename;
  2         3  
  2         109  
12 2     2   12 use URI::Escape;
  2         3  
  2         84  
13 2     2   1009 use Encode;
  2         18666  
  2         137  
14 2     2   1532 use IO::Socket::SSL;
  2         156438  
  2         15  
15 2     2   1413 use Term::Sk;
  2         10611  
  2         5509  
16              
17             our $VERSION = '0.07';
18              
19             my $WAIT_RETRY = 20;
20             my $BUFF_SIZE = 8192;
21              
22             sub new {
23 3     3 0 1320 my $class = shift;
24 3         12 my %opt = @_;
25 3         6 my $self = {};
26 3   33     18 $self->{token} = $opt{-token} || croak "Specify -token param";
27              
28 3         22 my $ua = LWP::UserAgent->new;
29 3         5705 $ua->agent("Yandex::Disk perl module");
30 3         186 $ua->default_header('Accept' => 'application/json');
31 3         129 $ua->default_header('Content-Type' => 'application/json');
32 3         126 $ua->default_header('Connection' => 'keep-alive');
33 3         126 $ua->default_header('Authorization' => 'OAuth ' . $self->{token});
34 3         120 $self->{ua} = $ua;
35 3         10 $self->{public_info} = {};
36 3         18 return bless $self, $class;
37             }
38              
39              
40             sub getDiskInfo {
41 1     1 1 742 my $self = shift;
42 1         2 my $url = 'https://cloud-api.yandex.net/v1/disk/';
43 1         4 my $res = $self->__request($url, "GET");
44 1 50       7 if ($res->is_success) {
45 1         19 return __fromJson($res->decoded_content);
46             }
47             else {
48 0         0 croak "Cant execute request to $url: " . $res->status_line;
49             }
50             }
51              
52             sub uploadFile {
53 1     1 1 845 my $self = shift;
54 1         11 my %opt = @_;
55 1         8 my $overwrite = $opt{-overwrite};
56 1   33     4 my $file = $opt{-file} || croak "Specify -file param";
57 1   33     5 my $remote_path = $opt{-remote_path} || croak "Specify -remote_path param";
58 1         3 my $show_progress_bar = $opt{-show_progress_bar};
59              
60 1 50       3 $overwrite = 1 if not defined $overwrite;
61              
62 1 50       57 if (not -f $file) {
63 0         0 croak "File $file not exists";
64             }
65              
66 1 50       7 $overwrite = $overwrite ? 'true' : 'false';
67              
68             #Delete end slash
69 1         8 $remote_path =~ s/^\/|\/$//g;
70 1         58 $remote_path = sprintf("/%s/%s", $remote_path, basename($file));
71              
72 1         7 my $param = "?path=" . uri_escape($remote_path) . "&overwrite=$overwrite";
73 1         38 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/upload' . $param, "GET");
74 1         3 my $url_to_upload;
75 1         3 my $code = $res->code;
76 1 50       17 if ($code eq '409') {
    50          
77 0         0 croak "Folder $remote_path not exists";
78             }
79             elsif ($code eq '200') {
80 1         4 $url_to_upload = __fromJson($res->decoded_content)->{href};
81             }
82             else {
83 0         0 croak "Cant uploadFile: " . $res->status_line;
84             }
85              
86             # Progress bar if need
87 1         3 my $term;
88 1 50       5 if ($show_progress_bar) {
89 0         0 $term = __prepareProgressBar(-s $file);
90             }
91              
92 1         5 my $upl_code = __upload_file($url_to_upload, $file, $term);
93              
94 1 50       175 if ($upl_code ne '201') {
95 0         0 croak "Cant upload file. Code: $code";
96             }
97 1         103 return 1;
98             }
99              
100             sub createFolder {
101 3     3 1 1896 my $self = shift;
102 3         13 my %opt = @_;
103 3   33     14 my $path = $opt{-path} || croak "Specify -path param";
104 3         5 my $recursive = $opt{-recursive};
105              
106 3 100       11 if ($recursive) {
107 1         2 my @half_path;
108 1         6 for my $l_path (split /\//, $path) {
109 2         7 push @half_path, $l_path;
110 2         16 $self->createFolder( -path => join('/', @half_path) );
111             }
112             }
113              
114 3         27 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/?path=' . uri_escape($path), "PUT");
115 3         17 my $code = $res->code;
116 3 100       45 if ($code eq '409') {
    50          
117             #Папка или существует или не создана родительская папка
118 2         13 my $json_res = __fromJson($res->decoded_content);
119 2 50       14 if ($json_res->{error} eq 'DiskPathPointsToExistentDirectoryError') {
120 2         384 return 1;
121             }
122 0         0 croak $json_res->{description};
123             }
124             elsif ($code ne '201') {
125 0         0 croak "Cant create folder $path. Error: " . $res->status_line;
126             }
127              
128 1         19 return 1;
129             }
130              
131             sub deleteResource {
132 1     1 1 2620 my $self = shift;
133 1         4 my %opt = @_;
134 1   33     5 my $path = $opt{-path} || croak "Specify -path param";
135 1         1 my $wait = $opt{-wait};
136 1         2 my $permanently = $opt{-permanently};
137              
138 1 50       3 $permanently = $permanently ? 'true' : 'false';
139              
140 1         5 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources?path=' . uri_escape($path) . "&permanently=$permanently", "DELETE");
141 1         4 my $code = $res->code;
142 1 50       13 if ($code eq '204') {
    0          
143             #Free folder
144 1         16 return 1;
145             }
146             elsif ($code eq '202') {
147 0 0       0 if ($wait) {
148 0         0 my $href = __fromJson($res->decoded_content)->{href};
149 0 0       0 $self->__waitResponse($href, $WAIT_RETRY) or croak "Timeout to wait response. Try increase $WAIT_RETRY variable";
150             }
151 0         0 return 1;
152             }
153             else {
154 0         0 croak "Cant delete $path. Error: " . $res->status_line;
155             }
156             }
157              
158             sub downloadFile {
159 1     1 1 166330 my $self = shift;
160 1         5 my %opt = @_;
161 1   33     10 my $path = $opt{-path} || croak "Specify -path param";
162 1   33     1231 my $file = $opt{-file} || croak "Specify -file param";
163 1         3 my $show_progress_bar = $opt{-show_progress_bar};
164              
165 1         90 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/download?path=' . uri_escape($path), "GET");
166 1         5 my $code = $res->code;
167 1 50       12 if ($code ne '200') {
168 0         0 croak "Error on request file $path: " . $res->status_line;
169             }
170              
171 1         4 my $download_url = __fromJson($res->decoded_content)->{href};
172              
173 1         4 my $term;
174 1 50       3 if ($show_progress_bar) {
175 0 0       0 if ($download_url =~ /[&?]fsize=(\d+)/) {
176 0         0 $term = __prepareProgressBar($1);
177             }
178             else {
179 0         0 carp "Can't get size of downloaded file. Progress bar will disabled.";
180             }
181             }
182              
183 1         7 $self->__download($download_url, $file, $term);
184 1         21 return 1;
185             }
186              
187             sub emptyTrash {
188 1     1 1 1535 my $self = shift;
189 1         2 my %opt = @_;
190 1   50     8 my $path = $opt{-path} || '';
191 1         2 my $wait = $opt{-wait};
192              
193 1 50       3 my $param = $path ? '?path=' . uri_escape($path) : '';
194 1         5 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/trash/resources/' . $path, 'DELETE');
195 1         4 my $code = $res->code;
196 1 50       12 if ($code eq '204') {
    50          
197 0         0 return 1;
198             }
199             elsif ($code eq '202') {
200 1 50       3 if ($wait) {
201 0         0 my $href = __fromJson($res->decoded_content)->{href};
202 0 0       0 $self->__waitResponse($href, $WAIT_RETRY) or croak "Timeout to wait response. Try increase $WAIT_RETRY variable";
203             }
204 1         16 return 1;
205             }
206             else {
207 0 0       0 $path = "by path $path" if $path;
208 0         0 croak "Cant empty trash$path. Error: " . $res->status_line;
209             }
210             }
211              
212             sub listFiles {
213 1     1 1 981 my $self = shift;
214 1         5 my %opt = @_;
215 1   33     6 my $path = $opt{-path} || croak "Specify -path param";
216 1   50     8 my $limit = $opt{-limit} || 999999;
217 1         3 my $offset = $opt{-offset};
218 1 50       8 $offset = 0 if not $offset;
219              
220 1         8 my $param = '?path=' . uri_escape($path) . "&limit=$limit&offset=$offset&fields=_embedded.items";
221 1         41 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources' . $param, 'GET');
222 1         6 my $code = $res->code;
223 1 50       15 if ($code ne '200') {
224 0         0 croak "Error on listFiles. Error: " . $res->status_line;
225             }
226 1         6 my $json_res = __fromJson($res->decoded_content);
227              
228 1         24 return $json_res->{_embedded}->{items};
229             }
230              
231             sub listAllFiles {
232 1     1 1 912 my $self = shift;
233 1         4 my %opt = @_;
234 1   50     9 my $limit = $opt{-limit} || 999999;
235 1         2 my $media_type = $opt{-media_type};
236 1         4 my $offset = $opt{-offset};
237 1 50       3 $offset = 0 if not $offset;
238              
239 1         5 my $param = "?limit=$limit&offset=$offset";
240 1 50       5 $param .= '&media_type=' . $media_type if $media_type;
241              
242 1         6 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/files' . $param, 'GET');
243 1         6 my $code = $res->code;
244 1 50       38 if ($code ne '200') {
245 0         0 croak "Error on listFiles. Error: " . $res->status_line;
246             }
247 1         6 my $json_res = __fromJson($res->decoded_content);
248              
249 1         7066 return $json_res->{items};
250             }
251              
252             sub lastUploadedFiles {
253 1     1 1 132374 my $self = shift;
254 1         4 my %opt = @_;
255 1   50     10 my $limit = $opt{-limit} || 999999;
256 1         2 my $media_type = $opt{-media_type};
257              
258 1         1482 my $param = "?limit=$limit";
259 1 50       3077 $param .= '&media_type=' . $media_type if $media_type;
260              
261 1         3127 my $res = $self->__request('https://cloud-api.yandex.net/v1/disk/resources/last-uploaded' . $param, 'GET');
262 1         4 my $code = $res->code;
263 1 50       12 if ($code ne '200') {
264 0         0 croak "Error on listFiles. Error: " . $res->status_line;
265             }
266 1         4 my $json_res = __fromJson($res->decoded_content);
267              
268 1         6649 return $json_res->{items};
269             }
270              
271              
272             sub public {
273 1     1 0 399 my $self = shift;
274 1         33 return Yandex::Disk::Public->new( -token => $self->{token} );
275             }
276              
277             sub __download {
278 1     1   3 my ($self, $url, $fname, $term) = @_;
279 1         3 my $ua = $self->{ua};
280              
281 1 50       157 open my $FL, ">$fname" or croak "Cant open $fname to write $!";
282 1         6 binmode $FL;
283             my $res = $ua->get($url, ':read_size_hint' => $BUFF_SIZE, ':content_cb' =>
284             sub {
285 4     4   694264 print $FL $_[0];
286 4 50       16 $term->up($BUFF_SIZE) if $term;
287             }
288 1         10 );
289 1         2358 close $FL;
290 1 50       6 $term->close if $term;
291              
292 1 50       4 if ($res->code eq '200') {
293 1         39 return 1;
294             }
295 0         0 croak "Cant download file $url to $fname. Error: " . $res->status_line;
296             }
297              
298             sub __waitResponse {
299             #Дожидается ответа о статусе операции
300 0     0   0 my ($self, $url, $retry) = @_;
301              
302 0         0 while ($retry > 0) {
303 0         0 my $res = $self->__request($url, "GET");
304 0         0 my $code = $res->code;
305 0 0 0     0 if ($code eq '200' && __fromJson($res->decoded_content)->{status} eq 'success') {
306 0         0 return 1;
307             }
308 0         0 sleep 1;
309 0         0 $retry--;
310             }
311 0         0 return;
312             }
313              
314              
315             sub __upload_file {
316             #Buffered chunked upload file
317 1     1   3 my ($url, $file, $term) = @_;
318              
319 1         10 my $u1 = URI->new($url);
320              
321             # $IO::Socket::SSL::DEBUG = 3;
322 1         114 my $host = $u1->host;
323 1         456 my $port = $u1->port;
324 1         38 my $path = $u1->path;
325              
326 1 50       37 my $sock = IO::Socket::SSL->new(
327             PeerAddr => $host,
328             PeerPort => $port,
329             Proto => 'tcp',
330             ) or croak "Cant connect to $host:$port";
331 1         469159 binmode $sock;
332 1         12 $sock->autoflush(1);
333              
334 1         69 $sock->print("PUT $path HTTP/1.1\n");
335 1         1544 $sock->print("HOST: $host\n");
336 1         199 $sock->print("Connection: close\n");
337 1         183 $sock->print("Content-Type: application/json\n");
338 1         180 $sock->print("Transfer-Encoding: chunked\n");
339 1         177 $sock->print("\n");
340              
341 1 50       303 open my $FH, "<$file" or croak "Cant open $file $!";
342 1         8 binmode $FH;
343 1         4 my $filebuf;
344 1         22 while (my $bytes = read($FH, $filebuf, $BUFF_SIZE)) {
345 2         14 my $hex = sprintf("%X", $bytes);
346 2 50       8 $sock->print($hex) or croak "Cant print to socket";
347 2 50       368 $sock->print("\r\n") or croak "Cant print to socket";
348              
349 2 50       354 $sock->print($filebuf) or croak "Cant print to socket";
350 2 50       749 $sock->print("\r\n") or croak "Cant print to socket";
351              
352 2 50       380 $term->up($BUFF_SIZE) if $term;
353             }
354 1         13 close $FH;
355              
356 1 50       7 $sock->print("0\r\n") or croak "Cant print to socket";
357 1 50       181 $sock->print("\r\n") or croak "Cant print to socket";
358              
359 1         181 my @answer = $sock->getlines();
360 1         1239752 $sock->close();
361              
362 1 50       599 $term->close if $term;
363              
364 1         16 my ($code) = $answer[0] =~ /(\d{3})/;
365              
366 1         20 return $code;
367             }
368              
369              
370             sub __request {
371 15     15   304 my ($self, $url, $type) = @_;
372              
373 15         53 my $ua = $self->{ua};
374 15         119 my $req = HTTP::Request->new($type => $url);
375 15         16849 my $res = $ua->request($req);
376              
377 15         211983408 return $res;
378             }
379              
380             sub __fromJson {
381 11 100   11   105191 my $string = ref($_[0]) ? $_[1] : $_[0];
382 11         767117 my $res = JSON::XS::decode_json($string);
383 11         94 return $res;
384             }
385              
386             sub __prepareProgressBar {
387 0     0     my ($file_size) = @_;
388 0           my $format = '%2d Elapsed: %8t %21b %4p %2d (%8c of %11m bytes)';
389 0           my $target = $file_size;
390 0           my $term = Term::Sk->new($format, {
391             freq => 'd',
392             base => 0,
393             target => $target,
394             pdisp => '!',
395             }
396             );
397 0           return $term;
398             }
399              
400              
401             sub errstr {
402 0     0 0   return shift->{errstr};
403             }
404              
405             1;
406              
407             __END__