line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::MyOpera; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
39935
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
81
|
|
4
|
2
|
|
|
2
|
|
13
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
75
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
12
|
use Carp (); |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
31
|
|
7
|
2
|
|
|
2
|
|
21986
|
use CGI (); |
|
2
|
|
|
|
|
45986
|
|
|
2
|
|
|
|
|
66
|
|
8
|
2
|
|
|
2
|
|
2425
|
use LWP::UserAgent (); |
|
2
|
|
|
|
|
110521
|
|
|
2
|
|
|
|
|
66
|
|
9
|
2
|
|
|
2
|
|
8818
|
use Net::OAuth 0.25; |
|
2
|
|
|
|
|
2092
|
|
|
2
|
|
|
|
|
81
|
|
10
|
2
|
|
|
2
|
|
17
|
use URI (); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
36
|
|
11
|
2
|
|
|
2
|
|
12
|
use URI::Escape (); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
70
|
|
12
|
|
|
|
|
|
|
|
13
|
2
|
|
|
2
|
|
13
|
use constant OAUTH_BASE_URL => 'https://auth.opera.com/service/oauth'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
316
|
|
14
|
2
|
|
|
2
|
|
14
|
use constant STATUS_UPDATE_URL => 'http://my.opera.com/community/api/users/status.pl'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
4607
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# Opera supports only OAuth 1.0a |
19
|
|
|
|
|
|
|
$Net::OAuth::PROTOCOL_VERSION = &Net::OAuth::PROTOCOL_VERSION_1_0A; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub new { |
22
|
1
|
|
|
1
|
1
|
776
|
my ($class, %opts) = @_; |
23
|
|
|
|
|
|
|
|
24
|
1
|
|
33
|
|
|
10
|
$class = ref $class || $class; |
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
|
|
3
|
for (qw(consumer_key consumer_secret)) { |
27
|
2
|
50
|
33
|
|
|
18
|
if (! exists $opts{$_} || ! $opts{$_}) { |
28
|
0
|
|
|
|
|
0
|
Carp::croak "Missing '$_'. Can't instance $class\n"; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
1
|
|
|
|
|
7
|
my $self = { |
33
|
|
|
|
|
|
|
_consumer_key => $opts{consumer_key}, |
34
|
|
|
|
|
|
|
_consumer_secret => $opts{consumer_secret}, |
35
|
|
|
|
|
|
|
_access_token => undef, |
36
|
|
|
|
|
|
|
_access_token_secret => undef, |
37
|
|
|
|
|
|
|
_request_token => undef, |
38
|
|
|
|
|
|
|
_request_token_secret => undef, |
39
|
|
|
|
|
|
|
_authorized => 0, |
40
|
|
|
|
|
|
|
}; |
41
|
|
|
|
|
|
|
|
42
|
1
|
|
|
|
|
4
|
bless $self, $class; |
43
|
|
|
|
|
|
|
|
44
|
1
|
|
|
|
|
5
|
return $self; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub authorized { |
48
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# We assume to be authorized if we have access token and access token secret |
51
|
0
|
|
|
|
|
0
|
my $acc_tok = $self->access_token(); |
52
|
0
|
|
|
|
|
0
|
my $acc_tok_secret = $self->access_token_secret(); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# TODO: No real check if the token is still valid |
55
|
0
|
0
|
0
|
|
|
0
|
unless ($acc_tok && $acc_tok_secret) { |
56
|
0
|
|
|
|
|
0
|
return; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
0
|
|
|
|
|
0
|
return 1; |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
sub access_token { |
63
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
64
|
0
|
0
|
|
|
|
0
|
if (@_) { |
65
|
0
|
|
|
|
|
0
|
$self->{_access_token} = shift; |
66
|
|
|
|
|
|
|
} |
67
|
0
|
|
|
|
|
0
|
return $self->{_access_token}; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
sub access_token_secret { |
71
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
72
|
0
|
0
|
|
|
|
0
|
if (@_) { |
73
|
0
|
|
|
|
|
0
|
$self->{_access_token_secret} = shift; |
74
|
|
|
|
|
|
|
} |
75
|
0
|
|
|
|
|
0
|
return $self->{_access_token_secret}; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub consumer_key { |
79
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
80
|
0
|
|
|
|
|
0
|
return $self->{_consumer_key}; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub consumer_secret { |
84
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
85
|
0
|
|
|
|
|
0
|
return $self->{_consumer_secret}; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub request_token { |
89
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
90
|
0
|
0
|
|
|
|
0
|
if (@_) { |
91
|
0
|
|
|
|
|
0
|
$self->{_request_token} = shift; |
92
|
|
|
|
|
|
|
} |
93
|
0
|
|
|
|
|
0
|
return $self->{_request_token}; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
sub request_token_secret { |
97
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
98
|
0
|
0
|
|
|
|
0
|
if (@_) { |
99
|
0
|
|
|
|
|
0
|
$self->{_request_token_secret} = shift; |
100
|
|
|
|
|
|
|
} |
101
|
0
|
|
|
|
|
0
|
return $self->{_request_token_secret}; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub get_authorization_url { |
105
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
# Get a request token first |
108
|
|
|
|
|
|
|
# and then build the authorize URL |
109
|
0
|
|
|
|
|
0
|
my $oauth_resp = $self->request_request_token(); |
110
|
|
|
|
|
|
|
|
111
|
0
|
|
|
|
|
0
|
my $req_tok = $oauth_resp->{oauth_token}; |
112
|
0
|
|
|
|
|
0
|
my $req_tok_secret = $oauth_resp->{oauth_token_secret}; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# Store in the object for the access-token phase later |
115
|
0
|
|
|
|
|
0
|
$self->request_token($req_tok); |
116
|
0
|
|
|
|
|
0
|
$self->request_token_secret($req_tok_secret); |
117
|
|
|
|
|
|
|
|
118
|
0
|
|
|
|
|
0
|
return $self->oauth_url_for('authorize', oauth_token=> $req_tok); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub _do_oauth_request { |
122
|
0
|
|
|
0
|
|
0
|
my ($self, $url) = @_; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
0
|
my $ua = $self->_user_agent(); |
125
|
0
|
|
|
|
|
0
|
my $resp = $ua->get($url); |
126
|
|
|
|
|
|
|
|
127
|
0
|
0
|
|
|
|
0
|
if ($resp->is_success) { |
128
|
0
|
|
|
|
|
0
|
my $query = CGI->new($resp->content()); |
129
|
|
|
|
|
|
|
return { |
130
|
0
|
|
|
|
|
0
|
ok => 1, |
131
|
|
|
|
|
|
|
$query->Vars |
132
|
|
|
|
|
|
|
}; |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
return { |
136
|
0
|
|
|
|
|
0
|
ok => 0, |
137
|
|
|
|
|
|
|
errstr => $resp->status_line(), |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub _user_agent { |
142
|
0
|
|
|
0
|
|
0
|
my $ua = LWP::UserAgent->new(); |
143
|
0
|
|
|
|
|
0
|
return $ua; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub oauth_url_for { |
147
|
1
|
|
|
1
|
1
|
9
|
my ($self, $step, %args) = @_; |
148
|
|
|
|
|
|
|
|
149
|
1
|
|
|
|
|
2
|
$step = lc $step; |
150
|
|
|
|
|
|
|
|
151
|
1
|
|
|
|
|
8
|
my $url = URI->new(OAUTH_BASE_URL . '/' . $step); |
152
|
1
|
|
|
|
|
9858
|
$url->query_form(%args); |
153
|
|
|
|
|
|
|
|
154
|
1
|
|
|
|
|
218
|
return $url; |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub request_access_token { |
158
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
159
|
|
|
|
|
|
|
|
160
|
0
|
0
|
|
|
|
|
if (! exists $args{verifier}) { |
161
|
0
|
|
|
|
|
|
Carp::croak "The 'verifier' argument is required. Check the docs."; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
my $verifier = $args{verifier}; |
165
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
my %opt = ( |
167
|
|
|
|
|
|
|
step => 'access_token', |
168
|
|
|
|
|
|
|
request_method => 'GET', |
169
|
|
|
|
|
|
|
request_url => $self->oauth_url_for('access_token'), |
170
|
|
|
|
|
|
|
token => $self->request_token(), |
171
|
|
|
|
|
|
|
token_secret => $self->request_token_secret(), |
172
|
|
|
|
|
|
|
verifier => $verifier, |
173
|
|
|
|
|
|
|
); |
174
|
|
|
|
|
|
|
|
175
|
0
|
|
|
|
|
|
my $request = $self->_prepare_request(%opt); |
176
|
0
|
0
|
|
|
|
|
if (! $request) { |
177
|
0
|
|
|
|
|
|
Carp::croak "Unable to initialize access-token request"; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
|
my $access_token_url = $request->to_url(); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
#print 'access_token_url:', $access_token_url, "\n"; |
183
|
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
|
my $response = $self->_do_oauth_request($access_token_url); |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
# Check if the request-token request failed |
187
|
0
|
0
|
0
|
|
|
|
if (! $response || ref $response ne 'HASH' || $response->{ok} == 0) { |
|
|
|
0
|
|
|
|
|
188
|
0
|
|
|
|
|
|
Carp::croak "Access-token request failed. Might be a temporary problem. Please retry later."; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# Store access token for future requests |
192
|
0
|
|
|
|
|
|
$self->access_token($response->{oauth_token}); |
193
|
0
|
|
|
|
|
|
$self->access_token_secret($response->{oauth_token_secret}); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# And return them as well, so user can save them to persistent storage |
196
|
|
|
|
|
|
|
return ( |
197
|
0
|
|
|
|
|
|
$response->{oauth_token}, |
198
|
|
|
|
|
|
|
$response->{oauth_token_secret} |
199
|
|
|
|
|
|
|
); |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub request_request_token { |
203
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
my %opt = ( |
206
|
|
|
|
|
|
|
step => 'request_token', |
207
|
|
|
|
|
|
|
callback => 'oob', |
208
|
|
|
|
|
|
|
request_method => 'GET', |
209
|
|
|
|
|
|
|
request_url => $self->oauth_url_for('request_token'), |
210
|
|
|
|
|
|
|
); |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
my $request = $self->_prepare_request(%opt); |
213
|
0
|
0
|
|
|
|
|
if (! $request) { |
214
|
0
|
|
|
|
|
|
Carp::croak "Unable to initialize request-token request"; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
my $request_token_url = $request->to_url(); |
218
|
0
|
|
|
|
|
|
my $response = $self->_do_oauth_request($request_token_url); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# Check if the request-token request failed |
221
|
0
|
0
|
0
|
|
|
|
if (! $response || ref $response ne 'HASH' || $response->{ok} == 0) { |
|
|
|
0
|
|
|
|
|
222
|
0
|
|
|
|
|
|
Carp::croak "Request-token request failed. Might be a temporary problem. Please retry later."; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
return $response; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub _fill_default_values { |
229
|
0
|
|
|
0
|
|
|
my ($self, $req) = @_; |
230
|
|
|
|
|
|
|
|
231
|
0
|
|
0
|
|
|
|
$req ||= {}; |
232
|
|
|
|
|
|
|
|
233
|
0
|
|
0
|
|
|
|
$req->{step} ||= 'request_token'; |
234
|
0
|
|
0
|
|
|
|
$req->{nonce} ||= _random_string(32); |
235
|
0
|
|
0
|
|
|
|
$req->{request_method} ||= 'GET'; |
236
|
0
|
|
0
|
|
|
|
$req->{consumer_key} ||= $self->consumer_key(); |
237
|
0
|
|
0
|
|
|
|
$req->{consumer_secret} ||= $self->consumer_secret(); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# Opera OAuth provider supports only HMAC-SHA1 |
240
|
0
|
|
|
|
|
|
$req->{signature_method} = 'HMAC-SHA1'; |
241
|
0
|
|
0
|
|
|
|
$req->{timestamp} ||= time(); |
242
|
0
|
|
|
|
|
|
$req->{version} = '1.0'; |
243
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
|
return $req; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub _prepare_request { |
248
|
0
|
|
|
0
|
|
|
my ($self, %opt) = @_; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Fill in the default OAuth request values |
251
|
0
|
|
|
|
|
|
$self->_fill_default_values(\%opt); |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Use Net::OAuth to obtain a valid request object |
254
|
0
|
|
|
|
|
|
my $step = delete $opt{step}; |
255
|
0
|
|
|
|
|
|
my $request = Net::OAuth->request($step)->new(%opt); |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
# User authorization step doesn't need signing |
258
|
0
|
0
|
|
|
|
|
if ($step ne 'user_auth') { |
259
|
0
|
|
|
|
|
|
$request->sign; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
return $request; |
263
|
|
|
|
|
|
|
} |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub _random_string { |
266
|
0
|
|
|
0
|
|
|
my ($length) = @_; |
267
|
0
|
0
|
|
|
|
|
if (! $length) { $length = 16 } |
|
0
|
|
|
|
|
|
|
268
|
0
|
|
|
|
|
|
my @chars = ('a'..'z','A'..'Z','0'..'9'); |
269
|
0
|
|
|
|
|
|
my $str = ''; |
270
|
0
|
|
|
|
|
|
for (1 .. $length) { |
271
|
0
|
|
|
|
|
|
$str .= $chars[ int rand @chars ]; |
272
|
|
|
|
|
|
|
} |
273
|
0
|
|
|
|
|
|
return $str; |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub update { |
277
|
0
|
|
|
0
|
1
|
|
my ($self, $args) = @_; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Nothing to update? |
280
|
0
|
0
|
|
|
|
|
if (! $args) { |
281
|
0
|
|
|
|
|
|
return; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
my $new_status = $args->{status}; |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
my $status_update_url = URI->new(STATUS_UPDATE_URL); |
287
|
|
|
|
|
|
|
|
288
|
0
|
|
|
|
|
|
$status_update_url->query_form( |
289
|
|
|
|
|
|
|
new_status => $new_status |
290
|
|
|
|
|
|
|
); |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
#warn "status-update-url: $status_update_url\n"; |
293
|
|
|
|
|
|
|
#warn "access-token: " . $self->access_token() . "\n"; |
294
|
|
|
|
|
|
|
#warn "access-token-secret: " . $self->access_token_secret() . "\n"; |
295
|
|
|
|
|
|
|
|
296
|
0
|
|
|
|
|
|
my %opt = ( |
297
|
|
|
|
|
|
|
step => 'protected_resource', |
298
|
|
|
|
|
|
|
request_method => 'GET', |
299
|
|
|
|
|
|
|
request_url => $status_update_url, |
300
|
|
|
|
|
|
|
token => $self->access_token(), |
301
|
|
|
|
|
|
|
token_secret => $self->access_token_secret(), |
302
|
|
|
|
|
|
|
new_status => $new_status, |
303
|
|
|
|
|
|
|
); |
304
|
|
|
|
|
|
|
|
305
|
0
|
|
|
|
|
|
my $request = $self->_prepare_request(%opt); |
306
|
0
|
0
|
|
|
|
|
if (! $request) { |
307
|
0
|
|
|
|
|
|
Carp::croak "Unable to initialize status-update request"; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
|
my $status_update_oauth_url = $request->to_url() . '&new_status=' . URI::Escape::uri_escape_utf8($new_status); |
311
|
0
|
|
|
|
|
|
my $response = $self->_do_oauth_request($status_update_oauth_url); |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
#warn "status-update-oauth-url: " . $status_update_oauth_url . "\n"; |
314
|
|
|
|
|
|
|
|
315
|
0
|
0
|
0
|
|
|
|
if (! $response || ref $response ne 'HASH' || $response->{ok} == 0) { |
|
|
|
0
|
|
|
|
|
316
|
0
|
|
|
|
|
|
Carp::croak "Status update request failed. Might be a temporary problem. Please retry later."; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
|
return $response->{ok}; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
1; |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
__END__ |