File Coverage

blib/lib/WebService/CloudPT.pm
Criterion Covered Total %
statement 38 249 15.2
branch 1 90 1.1
condition 0 67 0.0
subroutine 12 52 23.0
pod 23 36 63.8
total 74 494 14.9


line stmt bran cond sub pod time code
1             package WebService::CloudPT;
2 1     1   25864 use strict;
  1         3  
  1         37  
3 1     1   4 use warnings;
  1         3  
  1         27  
4 1     1   25 use Carp ();
  1         6  
  1         30  
5 1     1   5 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK SEEK_SET SEEK_END);
  1         1  
  1         91  
6 1     1   1207 use JSON;
  1         50831  
  1         7  
7 1     1   1338 use Net::OAuth;
  1         812  
  1         46  
8             $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
9 1     1   1005 use URI;
  1         5363  
  1         37  
10 1     1   11 use URI::Escape;
  1         3  
  1         14621  
11              
12             our $VERSION = '1.00';
13             my $request_token_url = 'https://cloudpt.pt/oauth/request_token';
14             my $access_token_url = 'https://cloudpt.pt/oauth/access_token';
15             my $authorize_url = 'https://cloudpt.pt/oauth/authorize';
16              
17              
18             __PACKAGE__->mk_accessors(qw/
19             key
20             secret
21             request_token
22             request_secret
23             access_token
24             access_secret
25             root
26              
27             no_decode_json
28             error
29             code
30             request_url
31             request_method
32             timeout
33             oauth_callback
34             callback
35             oauth_verifier
36             /);
37              
38             $WebService::CloudPT::USE_LWP = 0;
39              
40             sub import {
41 1     1   50 eval {
42 1         554 require Furl::HTTP;
43 0         0 require IO::Socket::SSL;
44 1 50       8 };if ($@) {
45 1         7 __PACKAGE__->use_lwp;
46             }
47             }
48              
49             sub use_lwp {
50 1     1 0 1509 require LWP::UserAgent;
51 1         62864 require HTTP::Request;
52 1         19 $WebService::CloudPT::USE_LWP++;
53             }
54              
55             sub new {
56 0     0 0 0 my ($class, $args) = @_;
57              
58 0   0     0 bless {
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
59             key => $args->{key} || '',
60             secret => $args->{secret} || '',
61             request_token => $args->{request_token} || '',
62             request_secret => $args->{request_secret} || '',
63             access_token => $args->{access_token} || '',
64             access_secret => $args->{access_secret} || '',
65             root => $args->{root} || 'cloudpt',
66             timeout => $args->{timeout} || (60 * 60 * 24),
67             no_decode_json => $args->{no_decode_json} || 0,
68             no_uri_escape => $args->{no_uri_escape} || 0,
69             env_proxy => $args->{lwp_env_proxy} || $args->{env_proxy} || 0,
70             }, $class;
71             }
72              
73             sub login {
74 0     0 1 0 my ($self, $callback_url) = @_;
75              
76 0 0       0 my $body = $self->api({
77             method => 'POST',
78             url => $request_token_url,
79             'callback' => $callback_url,
80             }) or return;
81              
82 0         0 my $response = Net::OAuth->response('request token')->from_post_body($body);
83 0         0 $self->request_token($response->token);
84 0         0 $self->request_secret($response->token_secret);
85              
86 0         0 my $url = URI->new($authorize_url);
87 0         0 $url->query_form(
88             oauth_token => $response->token,
89             #oauth_callback => $callback_url
90             );
91 0         0 $url->as_string;
92             }
93              
94             sub auth {
95 0     0 1 0 my ($self, $args) = @_;
96              
97 0 0       0 my $body = $self->api({
98             method => 'POST',
99             url => $access_token_url,
100             'verifier' => $args->{'verifier'},
101            
102             }) or return;
103              
104 0         0 my $response = Net::OAuth->response('access token')->from_post_body($body);
105 0         0 $self->access_token($response->token);
106 0         0 $self->access_secret($response->token_secret);
107             }
108              
109             sub share_folder {
110 0     0 1 0 my ($self, $path, $to) = @_;
111 0         0 $self->api_json({
112             method => 'POST',
113             url => 'https://publicapi.cloudpt.pt/1/ShareFolder/' . $self->root . $path,
114             content => 'to_email=' . $to
115             });
116             }
117            
118             sub list_shared_folders {
119 0     0 1 0 my ($self) = @_;
120 0         0 $self->api_json({
121             url => 'https://publicapi.cloudpt.pt/1/ListSharedFolders',
122             });
123             }
124              
125             sub list_links {
126 0     0 1 0 my ($self) = @_;
127 0         0 $self->api_json({
128             url => 'https://publicapi.cloudpt.pt/1/ListLinks',
129             });
130             }
131              
132             sub _delete_link {
133 0     0   0 my ($self, $share_id) = @_;
134            
135 0         0 $self->api_json({
136             method => 'POST',
137             url => 'https://publicapi.cloudpt.pt/1/DeleteLink',
138             content => 'shareid=' . $share_id
139             });
140             }
141              
142             sub list {
143 0     0 1 0 my ($self, $path, $params) = @_;
144 0         0 $self->api_json({
145             url => 'https://publicapi.cloudpt.pt/1/List/' . $self->root . $path,
146             extra_params => $params
147             });
148             }
149              
150             sub account_info {
151 0     0 1 0 my $self = shift;
152              
153 0         0 $self->api_json({
154             url => 'https://publicapi.cloudpt.pt/1/Account/Info'
155             });
156             }
157              
158             sub files {
159 0     0 1 0 my ($self, $path, $output, $params, $opts) = @_;
160              
161 0   0     0 $opts ||= {};
162 0 0       0 if (ref $output eq 'CODE') {
    0          
163 0         0 $opts->{write_code} = $output; # code ref
164             } elsif (ref $output) {
165 0         0 $opts->{write_file} = $output; # file handle
166 0         0 binmode $opts->{write_file};
167             } else {
168 0         0 open $opts->{write_file}, '>', $output; # file path
169 0 0       0 Carp::croak("invalid output, output must be code ref or filehandle or filepath.")
170             unless $opts->{write_file};
171 0         0 binmode $opts->{write_file};
172             }
173 0         0 $self->api({
174             url => $self->url('https://api-content.cloudpt.pt/1/Files/' . $self->root, $path),
175             extra_params => $params,
176             %$opts
177             });
178              
179 0 0       0 return if $self->error;
180 0         0 return 1;
181             }
182              
183             sub files_post {
184 0     0 0 0 my ($self, $path, $content, $params, $opts) = @_;
185 0 0 0     0 if ((exists $params->{'overwrite'}) and ($params->{'overwrite'})){
186             ### XXX RETURN ERRROR IF NO parent_rev ?
187 0         0 $params->{'overwrite'} = 'true';
188             }
189              
190 0   0     0 $opts ||= {};
191 0         0 $self->api_json({
192             extra_params => $params,
193             method => 'POST',
194             url => $self->url('https://api-content.cloudpt.pt/1/Files/' . $self->root, $path),
195             content => $content,
196             %$opts
197             });
198             }
199              
200             sub files_put {
201 0     0 1 0 my ($self, $path, $content, $params, $opts) = @_;
202              
203 0 0 0     0 if ((exists $params->{'overwrite'}) and ($params->{'overwrite'})){
204             ### XXX RETURN ERRROR IF NO parent_rev ?
205 0         0 $params->{'overwrite'} = 'true';
206             }
207 0   0     0 $opts ||= {};
208 0         0 $self->api_json({
209             extra_params => $params,
210             method => 'PUT',
211             url => $self->url('https://api-content.cloudpt.pt/1/Files/' . $self->root, $path),
212             content => $content,
213             %$opts
214             });
215             }
216              
217             sub _metadata_share {
218             ### NOT WORKING YET
219 0     0   0 my ($self, $share_id, $path) = @_;
220              
221 0         0 $self->api_json({
222             url => $self->url('https://publicapi.cloudpt.pt/1/MetadataShare/'. $share_id . $path),
223             });
224             }
225              
226             sub metadata {
227 0     0 1 0 my ($self, $path, $params) = @_;
228              
229 0         0 $self->api_json({
230             url => $self->url('https://publicapi.cloudpt.pt/1/Metadata/' . $self->root, $path),
231             extra_params => $params
232             });
233             }
234              
235             sub delta {
236 0     0 1 0 my ($self, $params) = @_;
237              
238 0         0 $self->api_json({
239             method => 'POST',
240             url => $self->url('https://publicapi.cloudpt.pt/1/Delta', ''),
241             extra_params => $params
242             });
243             }
244              
245             sub revisions {
246 0     0 1 0 my ($self, $path, $params) = @_;
247              
248 0         0 $self->api_json({
249             url => $self->url('https://publicapi.cloudpt.pt/1/Revisions/' . $self->root, $path),
250             extra_params => $params
251             });
252             }
253              
254             sub restore {
255 0     0 1 0 my ($self, $path, $params) = @_;
256              
257 0         0 $self->api_json({
258             method => 'POST',
259             url => $self->url('https://publicapi.cloudpt.pt/1/Restore/' . $self->root, $path),
260             extra_params => $params,
261             content => 'rev=' . $params->{'rev'},
262             });
263             }
264              
265             sub search {
266 0     0 1 0 my ($self, $path, $params) = @_;
267              
268 0         0 $self->api_json({
269             url => $self->url('https://publicapi.cloudpt.pt/1/Search/' . $self->root, $path),
270             extra_params => $params
271             });
272             }
273              
274             sub shares {
275 0     0 1 0 my ($self, $path, $params) = @_;
276              
277 0         0 $self->api_json({
278             method => 'POST',
279             url => $self->url('https://publicapi.cloudpt.pt/1/Shares/' . $self->root, $path),
280             extra_params => $params
281             });
282             }
283              
284             sub media {
285 0     0 1 0 my ($self, $path, $params) = @_;
286              
287 0         0 $self->api_json({
288             method => 'POST',
289             url => $self->url('https://publicapi.cloudpt.pt/1/Media/' . $self->root, $path),
290             extra_params => $params
291             });
292             }
293              
294             sub copy_ref {
295 0     0 1 0 my ($self, $path, $params) = @_;
296              
297 0         0 $self->api_json({
298             method => 'GET',
299             url => $self->url('https://publicapi.cloudpt.pt/1/CopyRef/' . $self->root, $path),
300             extra_params => $params
301             });
302             }
303              
304             sub thumbnails {
305 0     0 1 0 my ($self, $path, $output, $params, $opts) = @_;
306              
307 0   0     0 $opts ||= {};
308 0 0       0 if (ref $output eq 'CODE') {
    0          
309 0         0 $opts->{write_code} = $output; # code ref
310             } elsif (ref $output) {
311 0         0 $opts->{write_file} = $output; # file handle
312 0         0 binmode $opts->{write_file};
313             } else {
314 0         0 open $opts->{write_file}, '>', $output; # file path
315 0 0       0 Carp::croak("invalid output, output must be code ref or filehandle or filepath.")
316             unless $opts->{write_file};
317 0         0 binmode $opts->{write_file};
318             }
319 0 0       0 $opts->{extra_params} = $params if $params;
320 0         0 $self->api({
321             url => $self->url('https://api-content.cloudpt.pt/1/Thumbnails/' . $self->root, $path),
322             extra_params => $params,
323             %$opts,
324             });
325 0 0       0 return if $self->error;
326 0         0 return 1;
327             }
328              
329             sub create_folder {
330 0     0 1 0 my ($self, $path, $params) = @_;
331              
332 0   0     0 $params ||= {};
333 0   0     0 $params->{root} ||= $self->root;
334 0         0 $params->{path} = $self->path($path);
335              
336 0         0 $self->api_json({
337             method => 'POST',
338             url => $self->url('https://publicapi.cloudpt.pt/1/Fileops/CreateFolder', ''),
339             extra_params => $params,
340             content => 'path='. $path . '&root=' . $self->root,
341             });
342             }
343              
344             sub copy {
345 0     0 1 0 my ($self, $from, $to_path, $params) = @_;
346              
347 0   0     0 $params ||= {};
348 0   0     0 $params->{root} ||= $self->root;
349 0         0 $params->{to_path} = $self->path($to_path);
350 0         0 my $content;
351 0 0       0 if (ref $from) {
352 0         0 $params->{from_copy_ref} = $from->{copy_ref};
353 0         0 $content = 'from_copy_ref=' . $from->{'copy_ref'};
354             } else {
355 0         0 $params->{from_path} = $self->path($from);
356 0         0 $content = 'from_path=' . $from;
357             }
358 0         0 $content.='&to_path=' .$to_path . '&root=' . $self->root;
359              
360 0         0 $self->api_json({
361             method => 'POST',
362             url => $self->url('https://publicapi.cloudpt.pt/1/Fileops/Copy', ''),
363             extra_params => $params,
364             content => $content,
365            
366             });
367             }
368              
369             sub move {
370 0     0 1 0 my ($self, $from_path, $to_path, $params) = @_;
371              
372 0   0     0 $params ||= {};
373 0   0     0 $params->{root} ||= $self->root;
374 0         0 $params->{from_path} = $self->path($from_path);
375 0         0 $params->{to_path} = $self->path($to_path);
376              
377 0         0 $self->api_json({
378             method => 'POST',
379             url => $self->url('https://publicapi.cloudpt.pt/1/Fileops/Move', ''),
380             #extra_params => $params,
381             extra_params => {},
382             content => 'from_path=' . $from_path . '&to_path=' . $to_path .'&root=' . $self->root,
383             });
384             }
385              
386             sub delete {
387 0     0 1 0 my ($self, $path, $params) = @_;
388              
389 0   0     0 $params ||= {};
390 0   0     0 $params->{root} ||= $self->root;
391 0   0     0 $params->{path} ||= $self->path($path);
392 0         0 $self->api_json({
393             method => 'POST',
394             url => $self->url('https://publicapi.cloudpt.pt/1/Fileops/Delete', ''),
395             extra_params => $params,
396             content => 'path=' . $path .'&root=' . $self->root,
397             });
398             }
399              
400             # private
401              
402             sub api {
403 0     0 0 0 my ($self, $args) = @_;
404              
405 0   0     0 $args->{method} ||= 'GET';
406 0         0 $args->{url} = $self->oauth_request_url($args);
407              
408 0         0 $self->request_url($args->{url});
409 0         0 $self->request_method($args->{method});
410              
411 0 0       0 return $self->api_lwp($args) if $WebService::CloudPT::USE_LWP;
412              
413 0         0 my ($minor_version, $code, $msg, $headers, $body) = $self->furl->request(%$args);
414              
415 0         0 $self->code($code);
416 0 0       0 if ($code != 200) {
417 0         0 $self->error($body);
418 0         0 return;
419             } else {
420 0         0 $self->error(undef);
421             }
422              
423 0         0 return $body;
424             }
425              
426             sub api_lwp {
427 0     0 0 0 my ($self, $args) = @_;
428              
429 0         0 my $headers = [];
430 0 0       0 if ($args->{write_file}) {
431             $args->{write_code} = sub {
432 0     0   0 my $buf = shift;
433 0         0 $args->{write_file}->print($buf);
434 0         0 };
435             }
436 0 0       0 if ($args->{content}) {
437 0         0 my $buf;
438 0         0 my $content = delete $args->{content};
439 0 0 0     0 if (($content !~/^path=/) and ($content !~/^rev=/) and ($content !~/^from_/) and ($content !~/^to_email/) and ($content !~/^shareid=/)){
440             $args->{content} = sub {
441 0     0   0 read($content, $buf, 1024);
442 0         0 return $buf;
443            
444 0         0 };
445             } else {
446 0         0 $args->{'content'} = $content;
447             }
448             my $assert = sub {
449 0 0   0   0 $_[0] or Carp::croak(
450             "Failed to $_[1] for Content-Length: $!",
451             );
452 0         0 };
453 0 0 0     0 if (($content !~/^path\=/) and ($content !~/^rev=/) and ($content !~/^from_/) and ($content !~/^to_email/) and ($content !~/^shareid=/)){
454 0         0 $assert->(defined(my $cur_pos = tell($content)), 'tell');
455 0         0 $assert->(seek($content, 0, SEEK_END), 'seek');
456 0         0 $assert->(defined(my $end_pos = tell($content)), 'tell');
457 0         0 $assert->(seek($content, $cur_pos, SEEK_SET), 'seek');
458 0         0 my $content_length = $end_pos - $cur_pos;
459 0         0 push @$headers, 'Content-Length' => $content_length;
460             } else {
461 0         0 push @$headers, 'Content-Legnth' => length($content);
462             }
463             } else {
464 0         0 push @$headers, 'Content-Length' => 0;
465             }
466            
467 0 0       0 if ($args->{headers}) {
468 0         0 push @$headers, @{ $args->{headers} };
  0         0  
469             }
470 0         0 my $req = HTTP::Request->new($args->{method}, $args->{url}, $headers, $args->{content});
471 0         0 my $ua = LWP::UserAgent->new;
472 0         0 $ua->timeout($self->timeout);
473 0 0       0 $ua->env_proxy if $self->{env_proxy};
474 0         0 my $res = $ua->request($req, $args->{write_code});
475 0         0 $self->code($res->code);
476 0 0       0 if ($res->is_success) {
477 0         0 $self->error(undef);
478             } else {
479 0         0 $self->error($res->decoded_content);
480             }
481 0         0 return $res->decoded_content;
482             }
483              
484             sub api_json {
485 0     0 0 0 my ($self, $args) = @_;
486              
487 0 0       0 my $body = $self->api($args) or return;
488 0 0       0 if ($self->error) {
489 0         0 print $self->error ."\n";
490 0         0 print $body ."\n";
491             }
492 0 0       0 return if $self->error;
493 0 0       0 return $body if $self->no_decode_json;
494 0         0 return decode_json($body);
495             }
496              
497             sub oauth_request_url {
498 0     0 0 0 my ($self, $args) = @_;
499              
500 0 0       0 Carp::croak("missing url.") unless $args->{url};
501 0 0       0 Carp::croak("missing method.") unless $args->{method};
502              
503 0         0 my ($type, $token, $token_secret);
504 0 0       0 if ($args->{url} eq $request_token_url) {
    0          
505 0         0 $type = 'request token';
506             } elsif ($args->{url} eq $access_token_url) {
507 0 0       0 Carp::croak("missing request_token.") unless $self->request_token;
508 0 0       0 Carp::croak("missing request_secret.") unless $self->request_secret;
509 0         0 $type = 'access token';
510 0         0 $token = $self->request_token;
511 0         0 $token_secret = $self->request_secret;
512             } else {
513 0 0       0 Carp::croak("missing access_token, please `\$cloudpt->auth;`.") unless $self->access_token;
514 0 0       0 Carp::croak("missing access_secret, please `\$cloudpt->auth;`.") unless $self->access_secret;
515 0         0 $type = 'protected resource';
516 0         0 $token = $self->access_token;
517 0         0 $token_secret = $self->access_secret;
518             }
519              
520 0         0 my $request = Net::OAuth->request($type)->new(
521             extra_params => $args->{extra_params},
522             consumer_key => $self->key,
523             consumer_secret => $self->secret,
524             request_url => $args->{url},
525             request_method => uc($args->{method}),
526             signature_method => 'PLAINTEXT', # HMAC-SHA1 can't delete %20.txt bug...
527             timestamp => time,
528             nonce => $self->nonce,
529             token => $token,
530             token_secret => $token_secret,
531             callback => $args->{'callback'},
532             verifier => $args->{'verifier'},
533             );
534 0         0 $request->sign;
535 0         0 $request->to_url;
536             }
537              
538             sub furl {
539 0     0 0 0 my $self = shift;
540 0 0       0 unless ($self->{furl}) {
541 0         0 $self->{furl} = Furl::HTTP->new(
542             timeout => $self->timeout,
543             ssl_opts => {
544             SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
545             },
546             );
547 0 0       0 $self->{furl}->env_proxy if $self->{env_proxy};
548             }
549 0         0 $self->{furl};
550             }
551              
552             sub url {
553 0     0 0 0 my ($self, $base, $path, $params) = @_;
554 0         0 my $url = URI->new($base . uri_escape_utf8($self->path($path), q{^a-zA-Z0-9_.~/-}));
555 0 0       0 $url->query_form($params) if $params;
556 0         0 $url->as_string;
557             }
558              
559             sub path {
560 0     0 0 0 my ($self, $path) = @_;
561 0 0       0 return '' unless defined $path;
562 0 0       0 return '' unless length $path;
563 0         0 $path =~ s|^/||;
564 0         0 return '/' . $path;
565             }
566              
567             sub nonce {
568 0     0 0 0 my $length = 16;
569 0         0 my @chars = ( 'A'..'Z', 'a'..'z', '0'..'9' );
570 0         0 my $ret;
571 0         0 for (1..$length) {
572 0         0 $ret .= $chars[int rand @chars];
573             }
574 0         0 return $ret;
575             }
576              
577             sub mk_accessors {
578 1     1 0 2 my $package = shift;
579 1     1   18 no strict 'refs';
  1         3  
  1         244  
580 1         2 foreach my $field ( @_ ) {
581 16         82 *{ $package . '::' . $field } = sub {
582 0 0   0     return $_[0]->{ $field } if scalar( @_ ) == 1;
583 0 0         return $_[0]->{ $field } = scalar( @_ ) == 2 ? $_[1] : [ @_[1..$#_] ];
584 16         70 };
585             }
586             }
587              
588 0 0   0 1   sub env_proxy { $_[0]->{env_proxy} = defined $_[1] ? $_[1] : 1 }
589              
590             # Backward Compatibility
591 0     0 0   sub lwp_env_proxy { shift->env_proxy(@_) }
592              
593             1;
594             __END__