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__ |