File Coverage

blib/lib/OAuth/Lite/Response.pm
Criterion Covered Total %
statement 37 37 100.0
branch 10 10 100.0
condition 2 3 66.6
subroutine 8 8 100.0
pod 3 3 100.0
total 60 61 98.3


line stmt bran cond sub pod time code
1             package OAuth::Lite::Response;
2              
3 5     5   1113 use strict;
  5         7  
  5         206  
4 5     5   23 use warnings;
  5         9  
  5         180  
5              
6 5     5   22 use base 'Class::Accessor::Fast';
  5         6  
  5         1308  
7              
8 5     5   3531 use OAuth::Lite::Util qw(decode_param);
  5         18  
  5         372  
9              
10             __PACKAGE__->mk_accessors(qw/token/);
11              
12 5     5   569 use OAuth::Lite::Token;
  5         12  
  5         35  
13              
14             =head1 NAME
15              
16             OAuth::Lite::Response - response class
17              
18             =head1 SYNOPSIS
19              
20             my $res = $consumer->obtain_access_token(
21             ...
22             );
23              
24             my $token = $res->token;
25             say $token->token;
26             say $token->secret;
27              
28             my $other_param = $res->param('xauth_expires');
29              
30             =head1 DESCRIPTION
31              
32             Response class
33              
34             =head1 METHODS
35              
36             =head2 new
37              
38             =cut
39              
40             sub new {
41 6     6 1 8 my $class = shift;
42 6         86 bless {
43             _params => {},
44             token => undef,
45             }, $class;
46             }
47              
48             =head2 from_encoded
49              
50             Generate response from encoded line (that service provider provides as response of request token.).
51              
52             my $line = "oauth_token=foo&oauth_token_secret=bar&xauth_expires=0";
53             my $res = OAuth::Lite::Response->from_encoded($encoded);
54              
55             my $token = $res->token;
56             say $token->token;
57             say $token->secret;
58              
59             say $res->param('xauth_expires');
60              
61             =cut
62              
63             sub from_encoded {
64 6     6 1 2076 my ($class, $encoded) = @_;
65 6         21 $encoded =~ s/\r\n$//;
66 6         14 $encoded =~ s/\n$//;
67 6         19 my $res = $class->new;
68 6         27 my $token = OAuth::Lite::Token->new;
69 6         32 for my $pair (split /&/, $encoded) {
70 16         168 my ($key, $val) = split /=/, $pair;
71 16 100       56 if ($key eq 'oauth_token') {
    100          
    100          
72 6         23 $token->token(decode_param($val));
73             } elsif ($key eq 'oauth_token_secret') {
74 6         17 $token->secret(decode_param($val));
75             } elsif ($key eq 'oauth_callback_confirmed') {
76 3         8 my $p = decode_param($val);
77 3 100 66     44 if ($p && $p eq 'true') {
78 1         6 $token->callback_confirmed(1);
79             }
80             } else {
81 1         4 $res->param($key, decode_param($val));
82             }
83             }
84 6         56 $res->token($token);
85 6         41 $res;
86             }
87              
88             =head2 param
89              
90             Get parameter.
91              
92             say $res->param('xauth_expires');
93              
94             =cut
95              
96             sub param {
97 3     3 1 14 my ($self, $key, $value) = @_;
98 3 100       8 if (defined $value) {
99 1         5 $self->{_params}{$key} = $value;
100             }
101 3         18 $self->{_params}{$key};
102             }
103              
104             =head1 AUTHOR
105              
106             Lyo Kato, C
107              
108             =head1 COPYRIGHT AND LICENSE
109              
110             This library is free software; you can redistribute it and/or modify
111             it under the same terms as Perl itself, either Perl version 5.8.6 or,
112             at your option, any later version of Perl 5 you may have available.
113              
114             =cut
115              
116              
117             1;
118