File Coverage

blib/lib/Net/API/RPX.pm
Criterion Covered Total %
statement 5 7 71.4
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 8 10 80.0


line stmt bran cond sub pod time code
1 3     3   64357 use strict;
  3         7  
  3         192  
2             package Net::API::RPX;
3             BEGIN {
4 3     3   96 $Net::API::RPX::AUTHORITY = 'cpan:KONOBI';
5             }
6             {
7             $Net::API::RPX::VERSION = '0.04';
8             }
9              
10             # ABSTRACT: Perl interface to Janrain's RPX service
11              
12 3     3   2996 use Moose;
  0            
  0            
13             use LWP::UserAgent;
14             use URI;
15             use JSON::Any;
16             use Net::API::RPX::Exception::Usage;
17             use Net::API::RPX::Exception::Network;
18             use Net::API::RPX::Exception::Service;
19              
20             has api_key => (
21             is => 'rw',
22             isa => 'Str',
23             required => 1,
24             );
25              
26             has base_url => (
27             is => 'rw',
28             isa => 'Str',
29             required => 1,
30             lazy => 1,
31             default => 'https://rpxnow.com/api/v2/',
32             );
33              
34             has ua => (
35             is => 'rw',
36             isa => 'Object',
37             required => 1,
38             lazy => 1,
39             builder => '_build_ua',
40             );
41              
42             sub _build_ua {
43             my ($self) = @_;
44             return LWP::UserAgent->new( agent => $self->_agent_string );
45             }
46              
47             has _agent_string => (
48             is => 'rw',
49             isa => 'Str',
50             required => 1,
51             lazy => 1,
52             default => sub { 'net-api-rpx-perl/' . $Net::API::RPX::VERSION },
53             );
54              
55              
56             sub auth_info {
57             my ( $self, $opts ) = @_;
58             Net::API::RPX::Exception::Usage->throw(
59             ident => 'auth_info_usage_needs_token',
60             message => "Token is required",
61             required_parameter => 'token',
62             method_name => '->auth_info',
63             package => __PACKAGE__,
64             signature => '{ token => $authtoken }',
65             ) if !exists $opts->{token};
66             return $self->_fetch( 'auth_info', $opts );
67             }
68              
69              
70             sub map {
71             my ( $self, $opts ) = @_;
72             Net::API::RPX::Exception::Usage->throw(
73             ident => 'map_usage_needs_identifier',
74             message => "Identifier is required",
75             required_parameter => 'identifier',
76             method_name => '->map',
77             package => __PACKAGE__,
78             signature => '{ identifier => \'some.open.id\', primary_key => 12 }',
79             ) if !exists $opts->{identifier};
80              
81             Net::API::RPX::Exception::Usage->throw(
82             ident => 'map_usage_needs_primary_key',
83             message => "Primary Key is required",
84             required_parameter => 'primary_key',
85             method_name => '->map',
86             package => __PACKAGE__,
87             signature => '{ identifier => \'some.open.id\', primary_key => 12 }',
88             ) if !exists $opts->{primary_key};
89             $opts->{primaryKey} = delete $opts->{primary_key};
90              
91             return $self->_fetch( 'map', $opts );
92             }
93              
94              
95             sub unmap {
96             my ( $self, $opts ) = @_;
97             Net::API::RPX::Exception::Usage->throw(
98             ident => 'unmap_usage_needs_identifier',
99             message => "Identifier is required",
100             required_parameter => 'identifier',
101             method_name => '->unmap',
102             package => __PACKAGE__,
103             signature => '{ identifier => \'some.open.id\', primary_key => 12 }',
104             ) if !exists $opts->{identifier};
105              
106             Net::API::RPX::Exception::Usage->throw(
107             ident => 'unmap_usage_needs_primay_key',
108             message => "Primary Key is required",
109             required_parameter => 'primary_key',
110             method_name => '->unmap',
111             package => __PACKAGE__,
112             signature => '{ identifier => \'some.open.id\', primary_key => 12 }',
113             ) if !exists $opts->{primary_key};
114              
115             $opts->{primaryKey} = delete $opts->{primary_key};
116              
117             return $self->_fetch( 'unmap', $opts );
118             }
119              
120              
121             sub mappings {
122             my ( $self, $opts ) = @_;
123             Net::API::RPX::Exception::Usage->throw(
124             ident => 'mappings_usage_needs_primary_key',
125             message => "Primary Key is required",
126             required_parameter => 'primary_key',
127             method_name => '->mappings',
128             package => __PACKAGE__,
129             signature => '{ primary_key => 12 }',
130             ) if !exists $opts->{primary_key};
131              
132             $opts->{primaryKey} = delete $opts->{primary_key};
133              
134             return $self->_fetch( 'mappings', $opts );
135             }
136              
137             my $rpx_errors = {
138             -1 => 'Service Temporarily Unavailable',
139             0 => 'Missing parameter',
140             1 => 'Invalid parameter',
141             2 => 'Data not found',
142             3 => 'Authentication error',
143             4 => 'Facebook Error',
144             5 => 'Mapping exists',
145             };
146              
147             sub _fetch {
148             my ( $self, $uri_part, $opts ) = @_;
149              
150             my $uri = URI->new( $self->base_url . $uri_part );
151             my $res = $self->ua->post(
152             $uri,
153             {
154             %$opts,
155             apiKey => $self->api_key,
156             format => 'json',
157             }
158             );
159              
160             if ( !$res->is_success ) {
161             Net::API::RPX::Exception::Network->throw(
162             ident => '_fetch_network_failure',
163             message => "Could not contact RPX: " . $res->status_line(),
164             ua_result => $res,
165             status_line => $res->status_line,
166             );
167             }
168              
169             my $data = JSON::Any->from_json( $res->content );
170             if ( $data->{'stat'} ne 'ok' ) {
171             my $err = $data->{'err'};
172             Net::API::RPX::Exception::Service->throw(
173             ident => '_fetch_service_error',
174             data => $data,
175             status => $data->{'stat'},
176             rpx_error => $data->{'err'},
177             rpx_error_code => $data->{err}->{code},
178             rpx_error_message => $data->{err}->{msg},
179             message => "RPX returned error of type '"
180             . $rpx_errors->{ $err->{code} }
181             . "' with message: "
182             . $err->{msg},
183             );
184             }
185             delete $data->{'stat'};
186             return $data;
187             }
188              
189             1; # End of Net::API::RPX
190              
191             __END__
192             =pod
193              
194             =head1 NAME
195              
196             Net::API::RPX - Perl interface to Janrain's RPX service
197              
198             =head1 VERSION
199              
200             version 0.04
201              
202             =head1 SYNOPSIS
203              
204             use Net::API::RPX;
205              
206             my $rpx = Net::API::RPX->new({ api_key => '<your_api_key_here>' });
207              
208             $rpx->auth_info({ token => $token });
209              
210             =head1 DESCRIPTION
211              
212             This module is a simple wrapper around Janrain's RPX service. RPX provides a single method for
213             dealing with third-party authentication.
214              
215             See L<http://www.rpxnow.com> for more details.
216              
217             For specific information regarding the RPX API and method arguments, please refer to
218             L<https://rpxnow.com/docs>.
219              
220             =head1 ATTRIBUTES
221              
222             This is a Moose based module, this classes attribtues are as so:
223              
224             =head2 api_key
225              
226             This is the api_key provided by Janrain to interface with RPX. You will need to signup to RPX
227             to get one of these.
228              
229             =head2 base_url
230              
231             This is the base URL that is used to make API calls against. It defaults to the RPX v2 API.
232              
233             =head2 ua
234              
235             This is a LWP::UserAgent object. You may override it if you require more fine grain control
236             over remote queries.
237              
238             =head1 METHODS
239              
240             =head2 auth_info
241              
242             my $user_data = $rpx->auth_info({ token => $params{token} });
243              
244             Upon redirection back from RPX, you will be supplied a token to use for verification. Call
245             auth_info to verify the authenticity of the token and gain user details.
246              
247             'token' argument is required, 'extended' argument is optional.
248              
249             =head2 map
250              
251             $rpx->map({ identifier => 'yet.another.open.id', primary_key => 12 });
252              
253             This method allows you to map more than one 'identifier' to a user.
254              
255             'identifier' argument is required, 'primary_key' argument is required, 'overwrite' is optional.
256              
257             =head2 unmap
258              
259             $rpx->unmap({ identifier => 'yet.another.open.id', primary_key => 12 });
260              
261             This is the inverse of 'map'.
262              
263             'identifier' argument is required, 'primary_key' argument is required.
264              
265             =head2 mappings
266              
267             my $data = $rpx->mappings({ primary_key => 12 });
268              
269             This method returns information about the identifiers associated with a user.
270              
271             'primary_key' argument is required.
272              
273             =head1 TEST COVERAGE
274              
275             This distribution is heavily unit and system tested for compatability with
276             L<Test::Builder>. If you come across any bugs, please send me or submit failing
277             tests to Net-API-RPX RT queue. Please see the 'SUPPORT' section below on
278             how to supply these.
279              
280             ---------------------------- ------ ------ ------ ------ ------ ------ ------
281             File stmt bran cond sub pod time total
282             ---------------------------- ------ ------ ------ ------ ------ ------ ------
283             blib/lib/Net/API/RPX.pm 100.0 100.0 n/a 100.0 100.0 100.0 100.0
284             Total 100.0 100.0 n/a 100.0 100.0 100.0 100.0
285             ---------------------------- ------ ------ ------ ------ ------ ------ ------
286              
287             =head1 BUGS
288              
289             Please report any bugs or feature requests to C<bug-net-api-rpx at rt.cpan.org>, or through
290             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-API-RPX>. I will be notified, and then you'll
291             automatically be notified of progress on your bug as I make changes.
292              
293             =head1 SUPPORT
294              
295             You can find documentation for this module with the perldoc command.
296              
297             perldoc Net::API::RPX
298              
299             You can also look for information at:
300              
301             =over 4
302              
303             =item * RT: CPAN's request tracker
304              
305             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-API-RPX>
306              
307             =item * AnnoCPAN: Annotated CPAN documentation
308              
309             L<http://annocpan.org/dist/Net-API-RPX>
310              
311             =item * CPAN Ratings
312              
313             L<http://cpanratings.perl.org/d/Net-API-RPX>
314              
315             =item * Search CPAN
316              
317             L<http://search.cpan.org/dist/Net-API-RPX>
318              
319             =back
320              
321             =head1 SEE ALSO
322              
323             L<http://www.janrain.com/>, L<http://www.rpxnow.com/>
324              
325             =head1 AUTHORS
326              
327             =over 4
328              
329             =item *
330              
331             Scott McWhirter <konobi@cpan.org>
332              
333             =item *
334              
335             Kent Fredric <kentnl@cpan.org>
336              
337             =back
338              
339             =head1 COPYRIGHT AND LICENSE
340              
341             This software is Copyright (c) 2012 by Cloudtone Studios.
342              
343             This is free software, licensed under:
344              
345             The (three-clause) BSD License
346              
347             =cut
348