File Coverage

lib/Mailru/Cloud.pm
Criterion Covered Total %
statement 38 174 21.8
branch 0 40 0.0
condition 0 22 0.0
subroutine 13 24 54.1
pod 7 8 87.5
total 58 268 21.6


line stmt bran cond sub pod time code
1             package Mailru::Cloud;
2              
3 1     1   1298 use 5.008001;
  1         3  
4 1     1   4 use strict;
  1         2  
  1         19  
5 1     1   4 use warnings;
  1         1  
  1         48  
6 1     1   6 use utf8;
  1         2  
  1         6  
7 1     1   34 use open qw(:std :utf8);
  1         2  
  1         8  
8 1     1   150 use Carp qw/croak carp/;
  1         2  
  1         57  
9 1     1   6 use URI::Escape;
  1         2  
  1         57  
10 1     1   7 use File::Basename;
  1         2  
  1         56  
11 1     1   5 use HTTP::Request;
  1         2  
  1         33  
12 1     1   6 use JSON::XS;
  1         1  
  1         50  
13 1     1   576 use Encode;
  1         14482  
  1         91  
14 1     1   862 use IO::Socket::SSL;
  1         86963  
  1         9  
15 1     1   210 use base qw/Mailru::Cloud::Auth/;
  1         2  
  1         2384  
16              
17             our $VERSION = '0.09';
18              
19             my $BUFF_SIZE = 512;
20              
21             sub uploadFile {
22 0     0 1   my ($self, %opt) = @_;
23 0   0       my $upload_file = $opt{'-file'} || croak "You must specify -file param for method uploadFile";
24 0   0       my $path = $opt{'-path'} || '/';
25 0           my $rename = $opt{'-rename'};
26 0           $self->{file_hash} = undef;
27              
28 0           $self->__isLogin();
29              
30 0 0         my $conflict_mode = $rename ? 'rename' : 'rewrite';
31              
32 0 0         if (not -f $upload_file) {
33 0           croak "File $upload_file not exist";
34             }
35              
36 0 0         if ($path !~ /\/$/) {
37 0           $path .= '/';
38             }
39              
40 0           my $request = 'https://cld-upload10.cloud.mail.ru/upload/?' .'cloud_domain=2&x-email=' . uri_escape($self->{email});
41              
42 0 0         my ($file_hash, $size) = $self->__upload_file($request, $upload_file) or return;
43 0           $self->{file_hash} = $file_hash;
44              
45             #Опубликуем файл
46             my %param = (
47             'api' => '2',
48             'build' => $self->{build},
49             'conflict' => $conflict_mode,
50             'email' => $self->{email},
51             'hash' => $file_hash,
52             'home' => $path . basename($upload_file),
53             'size' => $size,
54             'token' => $self->{authToken},
55             'x-email' => $self->{email},
56 0           'x-page-id' => $self->{'x-page-id'},
57             );
58 0           my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/file/add', \%param);
59              
60 0           my $code = $res->code;
61 0 0         if ($code eq '200') {
62 0           my $json = JSON::XS::decode_json($res->content);
63 0           my $new_fname = $json->{body};
64 0           return $new_fname;
65             }
66              
67 0           croak "Cant upload file $upload_file. Code: $code " . $res->decoded_content . "\n";
68             }
69              
70             sub downloadFile {
71 0     0 1   my ($self, %opt) = @_;
72 0   0       my $file = $opt{-file} || croak "You must specify -file param for method downloadFile";
73 0   0       my $cloud_file = $opt{-cloud_file} || croak "You must specify -cloud_file param for method downloadFile";
74              
75 0           $self->__isLogin();
76              
77 0           my $FL;
78 0           my $ua = $self->{ua};
79 0           my $url = 'https://cloclo5.datacloudmail.ru/get/' . uri_escape($cloud_file) . '?x-email=' . uri_escape($self->{email});
80             my $res = $ua->get($url, ':read_size_hint' => $BUFF_SIZE, ':content_cb' => sub {
81 0 0   0     if (not $FL) {
82 0 0         open $FL, ">$file" or croak "Cant open $file to write $!";
83 0           binmode $FL;
84             }
85 0           print $FL $_[0];
86 0           });
87 0           my $code = $res->code;
88 0 0         if ($code ne '200') {
89 0           croak "Cant download file $cloud_file to $file. Code: $code";
90             }
91 0 0         close $FL if $FL;
92 0           return 1;
93             }
94              
95             sub createFolder {
96 0     0 1   my ($self, %opt) = @_;
97 0   0       my $path = $opt{-path} || croak "You must specify -path param for method createFolder";
98              
99 0           $self->__isLogin();
100              
101 0           my $ua = $self->{ua};
102             my %param = (
103             'api' => '2',
104             'build' => $self->{build},
105             'conflict' => 'strict',
106             'email' => $self->{email},
107             'home' => $path,
108             'token' => $self->{authToken},
109             'x-email' => $self->{email},
110 0           'x-page-id' => $self->{'x-page-id'},
111             );
112 0           my $res = $ua->post('https://cloud.mail.ru/api/v2/folder/add', \%param);
113              
114 0           my $code = $res->code;
115 0 0         if ($code eq '200') {
116 0           return 1;
117             }
118 0 0         if ($code eq '400') {
119 0           carp "Can't create folder $path. Folder exists";
120 0           return;
121             }
122 0           croak "Cant create folder $path. Code: $code";
123              
124             }
125              
126             sub deleteResource {
127 0     0 1   my ($self, %opt) = @_;
128 0   0       my $path = $opt{-path} || croak "You must specify -path options for method deleteResource";
129              
130 0           $self->__isLogin();
131              
132             my %param = (
133             'api' => '2',
134             'build' => $self->{build},
135             'email' => $self->{email},
136             'home' => $path,
137             'token' => $self->{authToken},
138             'x-email' => $self->{email},
139 0           'x-page-id' => $self->{'x-page-id'},
140             );
141              
142 0           my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/file/remove', \%param);
143 0           my $code = $res->code;
144              
145 0 0         if ($code eq '200') {
146 0           return 1;
147             }
148 0           croak "Cant remove $path. Code: $code";
149             }
150              
151             sub emptyTrash {
152 0     0 1   my $self = shift;
153              
154 0           $self->__isLogin();
155              
156             my %param = (
157             'api' => '2',
158             'build' => $self->{build},
159             'email' => $self->{email},
160             'token' => $self->{authToken},
161             'x-email' => $self->{email},
162 0           'x-page-id' => $self->{'x-page-id'},
163             );
164              
165 0           my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/trashbin/empty', \%param);
166 0           my $code = $res->code;
167              
168 0 0         if ($code eq '200') {
169 0           return 1;
170             }
171 0           croak "Cant empty trash. Code: $code";
172             }
173              
174             sub listFiles {
175 0     0 1   my ($self, %opt) = @_;
176 0   0       my $path = $opt{-path} || '/';
177 0           my $orig_path = $path;
178              
179 0           $self->__isLogin();
180 0           $path = uri_escape($path);
181 0           my $res = $self->{ua}->get('https://cloud.mail.ru/api/v2/folder' . '?token=' . $self->{authToken} . '&home=' . $path);
182 0           my $code = $res->code;
183 0 0         if ($res->is_success) {
184 0           my $json_parsed = decode_json($res->content);
185 0           my @list_files;
186              
187 0           for my $item (@{$json_parsed->{body}->{list}}) {
  0            
188             my $h = {
189             'type' => $item->{type},
190             'name' => $item->{name},
191             'size' => $item->{size},
192 0           };
193 0 0         if ($item->{weblink}) {
194 0           $h->{weblink} = 'https://cloud.mail.ru/public/' . $item->{weblink};
195             }
196 0           push @list_files, $h;
197             }
198 0           return \@list_files;
199             }
200 0 0         if ($code eq '404') {
201 0           croak "Folder $orig_path not exists";
202             }
203 0           croak "Cant get file list for path: $orig_path. Code: $code";
204             }
205              
206             sub shareResource {
207 0     0 1   my ($self, %opt) = @_;
208 0   0       my $path = $opt{-path} || croak "You must specify -path param for method shareResource";
209              
210             #Добавим слеш в начало, если его нет
211 0           $path =~ s/^([^\/])/\/$1/;
212              
213             my %param = (
214             'api' => '2',
215             'build' => $self->{build},
216             'email' => $self->{email},
217             'home' => $path,
218             'token' => $self->{authToken},
219             'x-email' => $self->{email},
220 0           'x-page-id' => $self->{'x-page-id'},
221             );
222              
223 0           my $res = $self->{ua}->post('https://cloud.mail.ru/api/v2/file/publish', \%param);
224 0           my $code = $res->code;
225 0 0         if ($code ne '200') {
226 0           croak "Error on shareResource. Path: $path. Code: $code";
227             }
228 0           my $json = decode_json($res->decoded_content);
229 0           my $link = 'https://cloud.mail.ru/public/' . $json->{body};
230 0           return $link;
231             }
232              
233             sub __upload_file {
234 0     0     my ($self, $url, $file) = @_;
235              
236 0           my $u1 = URI->new($url);
237              
238             # $IO::Socket::SSL::DEBUG = 5;
239 0           my $host = $u1->host;
240 0           my $port = $u1->port;
241 0           my $path = $u1->path;
242              
243 0 0         my $sock = IO::Socket::SSL->new(
244             PeerAddr => $host,
245             PeerPort => $port,
246             Proto => 'tcp',
247             ) or croak "Cant connect to $host:$port";
248 0           binmode $sock;
249 0           $sock->autoflush(1);
250              
251             #Generate boundary
252 0           my $boundary = '5';
253 0           for (1..20) {
254 0           $boundary .= int(rand(10) + 1);
255             }
256 0           $boundary = '----------------------------' . $boundary;
257              
258 0           my $content_disposition = 'Content-Disposition: form-data; name="file"; filename="' . basename($file) . '"' . "\n";
259 0           $content_disposition .= "Content-Type: text/plain\n\n";
260 0           my $length = (stat $file)[7];
261              
262 0           my @cookie_arr;
263 0     0     $self->{ua}->cookie_jar->scan(sub {push @cookie_arr, "$_[1]=$_[2]"});
  0            
264 0           my $cookie = join('; ', @cookie_arr);
265              
266              
267 0           my @headers = ( "PUT $path HTTP/1.1",
268             "HOST: $host",
269             "User-Agent: Mozilla/5.0 (X11; Ubuntu; Linux x86_64; rv:46.0) Gecko/20100101 Firefox/46.0",
270             "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8",
271             "Accept-Language: en-US,en;q=0.5",
272             "Accept-Encoding: gzip, deflate, br",
273             "Content-Type: multipart/form-data; boundary=$boundary",
274             "Connection: close",
275             "Referer: https://cloud.mail.ru/home/",
276             "Origin: https://cloud.mail.ru",
277             "Cookie: $cookie",
278             "X-Requested-With: XMLHttpRequest",
279             );
280              
281 0           for my $head (@headers) {
282 0           $sock->print($head . "\n");
283             }
284              
285 0           $sock->print("Content-Length: $length\n");
286 0           $sock->print("\n");
287              
288              
289 0 0         open my $FH, "<$file" or croak "Cant open $file $!";
290 0           binmode $FH;
291 0           my $filebuf;
292 0           while (my $bytes = read($FH, $filebuf, $BUFF_SIZE)) {
293 0           $sock->print($filebuf);
294             }
295 0           $sock->print("\n");
296              
297 0           my @answer = $sock->getlines();
298 0           $sock->close();
299              
300             #Если запрос успешен
301 0 0         if ($answer[0] =~ /201/) {
302             #Возврат хэша файла
303 0           return (pop @answer, $length);
304             }
305              
306 0           return;
307             }
308              
309             ################################## ACCESSORS ##########################3
310             #
311             sub get_last_uploaded_file_hash {
312 0     0 0   return $_[0]->{file_hash};
313             }
314              
315             1;
316              
317             __END__