File Coverage

blib/lib/OAuth/Lite2/Client/StateResponseParser.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package OAuth::Lite2::Client::StateResponseParser;
2              
3 1     1   958 use strict;
  1         2  
  1         27  
4 1     1   4 use warnings;
  1         1  
  1         21  
5              
6 1     1   5 use Try::Tiny qw/try catch/;
  1         1  
  1         39  
7 1     1   42 use OAuth::Lite2::Formatters;
  0            
  0            
8             use OAuth::Lite2::Client::Error;
9             use OAuth::Lite2::Client::ServerState;
10              
11             =head1 NAME
12              
13             OAuth::Lite2::Client::StateResponseParser - Server state response parser
14              
15             =head1 DESCRIPTION
16              
17             Server state response parser
18              
19             =cut
20              
21             sub new {
22             bless {}, $_[0];
23             }
24              
25             sub parse {
26             my ($self, $http_res) = @_;
27              
28             my $formatter =
29             OAuth::Lite2::Formatters->get_formatter_by_type(
30             $http_res->content_type);
31              
32             my $state;
33              
34             if ($http_res->is_success) {
35              
36             OAuth::Lite2::Client::Error::InvalidResponse->throw(
37             message => sprintf(q{Invalid response content-type: %s},
38             $http_res->content_type||'')
39             ) unless $formatter;
40              
41             my $result = try {
42             return $formatter->parse($http_res->content);
43             } catch {
44             OAuth::Lite2::Client::Error::InvalidResponse->throw(
45             message => sprintf(q{Invalid response format: %s}, $_),
46             );
47             };
48              
49             OAuth::Lite2::Client::Error::InvalidResponse->throw(
50             message => sprintf("Response doesn't include 'server_state'")
51             ) unless exists $result->{server_state};
52              
53             OAuth::Lite2::Client::Error::InvalidResponse->throw(
54             message => sprintf("Response doesn't include 'expires_in'")
55             ) unless exists $result->{expires_in};
56              
57             $state = OAuth::Lite2::Client::ServerState->new($result);
58              
59             } else {
60              
61             my $errmsg = $http_res->content || $http_res->status_line;
62              
63             if ($formatter && $http_res->content) {
64             try {
65             my $result = $formatter->parse($http_res->content);
66             $errmsg = $result->{error}
67             if exists $result->{error};
68             } catch { return };
69             }
70             OAuth::Lite2::Client::Error::InvalidResponse->throw( message => $errmsg );
71             }
72             return $state;
73             }
74              
75             =head1 AUTHOR
76              
77             Ryo Ito, Eritou.06@gmail.comE
78              
79             Lyo Kato, Elyo.kato@gmail.comE
80              
81             =head1 COPYRIGHT AND LICENSE
82              
83             Copyright (C) 2010 by Lyo Kato
84              
85             This library is free software; you can redistribute it and/or modify
86             it under the same terms as Perl itself, either Perl version 5.8.8 or,
87             at your option, any later version of Perl 5 you may have available.
88              
89             =cut
90              
91             1;