File Coverage

blib/lib/Net/FreshBooks/API/OAuth.pm
Criterion Covered Total %
statement 18 91 19.7
branch 0 34 0.0
condition 0 6 0.0
subroutine 6 11 54.5
pod 4 4 100.0
total 28 146 19.1


line stmt bran cond sub pod time code
1 1     1   1292 use strict;
  1         1  
  1         34  
2 1     1   5 use warnings;
  1         2  
  1         43  
3              
4             package Net::FreshBooks::API::OAuth;
5             $Net::FreshBooks::API::OAuth::VERSION = '0.24';
6 1     1   4 use base qw(Net::OAuth::Simple);
  1         1  
  1         884  
7              
8 1     1   173655 use Carp qw( croak );
  1         3  
  1         51  
9 1     1   888 use Data::Dump qw( dump );
  1         7255  
  1         85  
10 1     1   1083 use Params::Validate qw(:all);
  1         10235  
  1         1404  
11              
12             sub new {
13              
14 0     0 1   my $class = shift;
15 0           my %tokens = @_;
16              
17 0           foreach my $key ( 'consumer_secret', 'consumer_key', 'account_name' ) {
18 0 0 0       if ( !exists $tokens{$key} || !$tokens{$key} ) {
19 0           croak( "$key required as an argument to new()" );
20             }
21             }
22              
23 0           my $account_name = delete $tokens{account_name};
24              
25 0           my $url = 'https://' . $account_name . '.freshbooks.com/oauth';
26              
27 0           my %create = (
28             tokens => \%tokens,
29             protocol_version => '1.0a',
30             urls => {
31             authorization_url => $url . '/oauth_authorize.php',
32             request_token_url => $url . '/oauth_request.php',
33             access_token_url => $url . '/oauth_access.php',
34             },
35             signature_method => 'PLAINTEXT',
36             );
37              
38 0           return $class->SUPER::new( %create );
39              
40             }
41              
42             sub restricted_request {
43              
44 0     0 1   my $self = shift;
45 0           my $url = shift;
46 0           my $content = shift;
47              
48 0 0         if ( !$self->authorized ) {
49 0           return $self->_error( "This restricted request is not authorized" );
50             }
51              
52 0           my %request = (
53             consumer_key => $self->consumer_key,
54             consumer_secret => $self->consumer_secret,
55             request_url => $url,
56             request_method => 'POST',
57             signature_method => $self->signature_method,
58             protocol_version => Net::OAuth::PROTOCOL_VERSION_1_0A,
59             timestamp => time,
60             nonce => $self->_nonce,
61             token => $self->access_token,
62             token_secret => $self->access_token_secret,
63             );
64              
65 0           my $request = Net::OAuth::ProtectedResourceRequest->new( %request );
66              
67 0           $request->sign;
68              
69 0 0         if ( !$request->verify ) {
70 0           return $self->_error(
71             "Couldn't verify request! Check OAuth parameters." );
72             }
73              
74 0           my $params = $request->to_hash;
75 0           my @auth_header = ();
76              
77             # building the header here because the Net::OAuth::Simple stuff wasn't
78             # authenticating
79 0           foreach my $key ( keys %{ $request->to_hash } ) {
  0            
80 0           my $name = $key;
81 0           $name =~ s{-}{_}g;
82 0           push @auth_header, sprintf( '%s="%s"', $name, $params->{$key} );
83             }
84              
85 0           my $auth = 'OAuth realm="",' . join ",", @auth_header;
86 0           my $headers = HTTP::Headers->new( Authorization => $auth );
87              
88 0           my $req = HTTP::Request->new( 'POST' => $url, $headers, $content );
89              
90 0           my $response = $self->{browser}->request( $req );
91              
92 0 0         if ( !$response->is_success ) {
93 0           return $self->_error( "POST on "
94             . $request->normalized_request_url
95             . " failed: "
96             . $response->status_line . " - "
97             . $response->content );
98             }
99              
100 0           return $response;
101             }
102              
103             ##############################################################################
104             # the following methods can be deleted once a patched version of
105             # Net::OAuth::Simple has been released
106              
107             sub request_access_token {
108 0     0 1   my $self = shift;
109 0           my %params = @_;
110 0           my $url = $self->access_token_url;
111              
112 0 0         $params{token} = $self->request_token unless defined $params{token};
113 0 0         $params{token_secret} = $self->request_token_secret
114             unless defined $params{token_secret};
115              
116 0 0         if ( $self->oauth_1_0a ) {
117 0 0         $params{verifier} = $self->verifier unless defined $params{verifier};
118 0 0         return $self->_error(
119             "You must pass a verified parameter when using OAuth v1.0a" )
120             unless defined $params{verifier};
121              
122             }
123              
124 0           my $access_token_response
125             = $self->_make_request( 'Net::OAuth::AccessTokenRequest',
126             $url, 'POST', %params, );
127              
128 0           return $self->_decode_tokens( $url, $access_token_response );
129             }
130              
131             sub request_request_token {
132 0     0 1   my $self = shift;
133 0           my %params = @_;
134 0           my $url = $self->request_token_url;
135              
136 0 0         if ( $self->oauth_1_0a ) {
137 0 0         $params{callback} = $self->callback unless defined $params{callback};
138 0 0         return $self->_error(
139             "You must pass a callback parameter when using OAuth v1.0a" )
140             unless defined $params{callback};
141             }
142              
143 0           my $request_token_response
144             = $self->_make_request( 'Net::OAuth::RequestTokenRequest',
145             $url, 'POST', %params );
146              
147 0 0         return $self->_error(
148             "GET for $url failed: " . $request_token_response->status_line )
149             unless ( $request_token_response->is_success );
150              
151             # Cast response into CGI query for EZ parameter decoding
152 0           my $request_token_response_query
153             = new CGI( $request_token_response->content );
154              
155             # Split out token and secret parameters from the request token response
156 0           $self->request_token(
157             $request_token_response_query->param( 'oauth_token' ) );
158 0           $self->request_token_secret(
159             $request_token_response_query->param( 'oauth_token_secret' ) );
160 0           $self->callback_confirmed(
161             $request_token_response_query->param( 'oauth_callback_confirmed' ) );
162              
163 0 0 0       return $self->_error(
164             "Response does not confirm to OAuth1.0a. oauth_callback_confirmed not received"
165             ) if $self->oauth_1_0a && !$self->callback_confirmed;
166              
167             }
168              
169             sub _make_request {
170 0     0     my $self = shift;
171 0           my $class = shift;
172 0           my $url = shift;
173 0           my $method = uc( shift );
174 0           my @extra = @_;
175              
176 0           my $uri = URI->new( $url );
177 0           my %query = $uri->query_form;
178 0           $uri->query_form( {} );
179              
180 0 0         my $request = $class->new(
181             consumer_key => $self->consumer_key,
182             consumer_secret => $self->consumer_secret,
183             request_url => $uri,
184             request_method => $method,
185             signature_method => $self->signature_method,
186             protocol_version => $self->oauth_1_0a
187             ? Net::OAuth::PROTOCOL_VERSION_1_0A
188             : Net::OAuth::PROTOCOL_VERSION_1_0,
189             timestamp => time,
190             nonce => $self->_nonce,
191             extra_params => \%query,
192             @extra,
193             );
194 0           $request->sign;
195 0 0         return $self->_error( "Couldn't verify request! Check OAuth parameters." )
196             unless $request->verify;
197              
198 0           my $params = $request->to_hash;
199 0           $uri->query_form( %$params );
200 0           my $req = HTTP::Request->new( $method => "$uri" );
201 0           my $response = $self->{browser}->request( $req );
202 0 0         return $self->_error( "$method on "
203             . $request->normalized_request_url
204             . " failed: "
205             . $response->status_line . " - "
206             . $response->content )
207             unless ( $response->is_success );
208              
209 0           return $response;
210             }
211              
212             # ABSTRACT: FreshBooks OAuth implementation
213              
214              
215             1;
216              
217             __END__
218              
219             =pod
220              
221             =encoding UTF-8
222              
223             =head1 NAME
224              
225             Net::FreshBooks::API::OAuth - FreshBooks OAuth implementation
226              
227             =head1 VERSION
228              
229             version 0.24
230              
231             =head2 DESCRIPTION
232              
233             This package subclasses Net::OAuth::Simple, which is itself a wrapper around
234             L<Net::OAuth> You shouldn't need to deal with this class directly, but it's
235             available to you if you need it. Any of the methods which
236             L<Net::OAuth::Simple> uses are available to you. This subclass only overrides
237             the new() method.
238              
239             =head2 SYNOPSIS
240              
241             # these params are required
242             my $oauth = Net::FreshBooks::API::OAuth->new(
243             consumer_key => $consumer_key,
244             consumer_secret => $consumer_secret,
245             account_name => $account_name,
246             );
247              
248             # if you already have your access_token and access_token_secret:
249             my $oauth = Net::FreshBooks::API::OAuth->new(
250             consumer_key => $consumer_key,
251             consumer_secret => $consumer_secret,
252             access_tokey => $access_token,
253             access_token_secret => $access_token_secret,
254             account_name => $account_name,
255             );
256              
257             =head2 new()
258              
259             consumer_key, consumer_key_secret and account_name are all required params:
260              
261             my $oauth = Net::FreshBooks::API::OAuth->new(
262             consumer_key => $consumer_key,
263             consumer_secret => $consumer_secret,
264             account_name => $account_name,
265             );
266              
267             If you have already gotten your access tokens, you may create a new object
268             with them as well:
269              
270             my $oauth = Net::FreshBooks::API::OAuth->new(
271             consumer_key => $consumer_key,
272             consumer_secret => $consumer_secret,
273             access_token => $access_token,
274             access_token_secret => $access_token_secret,
275             account_name => $account_name,
276             );
277              
278             =head2 restricted_request( $url, $content )
279              
280             If you have provided your consumer and access tokens, you should be able to
281             make restricted requests.
282              
283             my $request = $oauth->restricted_request( $api_url, $xml )
284              
285             Returns an HTTP::Response object
286              
287             =head1 AUTHORS
288              
289             =over 4
290              
291             =item *
292              
293             Edmund von der Burg <evdb@ecclestoad.co.uk>
294              
295             =item *
296              
297             Olaf Alders <olaf@wundercounter.com>
298              
299             =back
300              
301             =head1 COPYRIGHT AND LICENSE
302              
303             This software is copyright (c) 2011 by Edmund von der Burg & Olaf Alders.
304              
305             This is free software; you can redistribute it and/or modify it under
306             the same terms as the Perl 5 programming language system itself.
307              
308             =cut