File Coverage

blib/lib/Net/MyOpera.pm
Criterion Covered Total %
statement 42 151 27.8
branch 1 34 2.9
condition 2 45 4.4
subroutine 12 28 42.8
pod 13 13 100.0
total 70 271 25.8


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__