File Coverage

blib/lib/Facebook/OpenGraph/Response.pm
Criterion Covered Total %
statement 68 69 98.5
branch 7 12 58.3
condition 25 33 75.7
subroutine 23 23 100.0
pod 18 18 100.0
total 141 155 90.9


line stmt bran cond sub pod time code
1             package Facebook::OpenGraph::Response;
2 34     34   56768 use strict;
  34         62  
  34         783  
3 34     34   140 use warnings;
  34         59  
  34         634  
4 34     34   419 use 5.008001;
  34         105  
5              
6 34     34   156 use Carp qw(croak);
  34         51  
  34         1647  
7 34     34   9916 use JSON 2 ();
  34         187372  
  34         22508  
8              
9             sub new {
10 59     59 1 8666 my $class = shift;
11 59   100     171 my $args = shift || +{};
12              
13             return bless +{
14             json => $args->{json} || JSON->new->utf8,
15             headers => $args->{headers},
16             code => $args->{code},
17             message => $args->{message},
18             content => $args->{content},
19             req_headers => $args->{req_headers} || q{},
20 59   66     742 req_content => $args->{req_content} || q{},
      100        
      50        
21             }, $class;
22             }
23              
24             # accessors
25 62     62 1 534 sub code { shift->{code} }
26 36     36 1 124 sub headers { shift->{headers} }
27 2     2 1 9 sub message { shift->{message} }
28 55     55 1 150 sub content { shift->{content} }
29 5     5 1 26 sub req_headers { shift->{req_headers} }
30 1     1 1 4 sub req_content { shift->{req_content} }
31 51     51 1 557 sub json { shift->{json} }
32 1     1 1 5 sub etag { shift->header('etag') }
33              
34             sub api_version {
35 23     23 1 37 my $self = shift;
36 23         49 return $self->header('facebook-api-version');
37             }
38              
39             sub is_api_version_eq_or_later_than {
40 14     14 1 35 my ($self, $comparing_version) = @_;
41 14 50       32 croak 'comparing version is not given.' unless $comparing_version;
42              
43 14         89 (my $comp_major, my $comp_minor)
44             = $comparing_version =~ m/ (\d+) \. (\d+ )/x;
45              
46 14         40 (my $response_major, my $response_minor)
47             = $self->api_version =~ m/ (\d+) \. (\d+ )/x;
48              
49 14   66     131 return $comp_major < $response_major || ($comp_major == $response_major && $comp_minor <= $response_minor);
50             }
51              
52             sub is_api_version_eq_or_older_than {
53 8     8 1 21 my ($self, $comparing_version) = @_;
54 8 50       18 croak 'comparing version is not given.' unless $comparing_version;
55              
56 8         41 (my $comp_major, my $comp_minor)
57             = $comparing_version =~ m/ (\d+) \. (\d+ )/x;
58              
59 8         18 (my $response_major, my $response_minor)
60             = $self->api_version =~ m/ (\d+) \. (\d+ )/x;
61              
62 8   66     49 return $response_major < $comp_major || ($response_major == $comp_major && $response_minor <= $comp_minor);
63             }
64              
65             sub header {
66 24     24 1 40 my ($self, $key) = @_;
67              
68 24 50       58 croak 'header field name is not given' unless $key;
69              
70 24   66     65 $self->{header} ||= do {
71 9         18 my $ref = +{};
72              
73 9         35 while (my ($k, $v) = splice @{ $self->headers }, 0, 2) {
  35         92  
74 26         59 $ref->{$k} = $v;
75             }
76              
77 9         29 $ref;
78             };
79              
80 24         100 return $self->{header}->{$key};
81             }
82              
83             sub is_success {
84 54     54 1 93 my $self = shift;
85             # code 2XX or 304
86             # 304 is returned when you use ETag and the data is not changed
87 54   100     117 return substr($self->code, 0, 1) == 2 || $self->code == 304;
88             }
89              
90             # Using the Graph API > Handling Errors
91             # https://developers.facebook.com/docs/graph-api/using-graph-api/
92             sub error_string {
93 5     5 1 30 my $self = shift;
94              
95             # When an error occurs, the response should be given in a form below:
96             #{
97             # "error": {
98             # "message": "Message describing the error",
99             # "type": "OAuthException",
100             # "code": 190,
101             # "error_subcode": 460,
102             # "error_user_title": "A title",
103             # "error_user_msg": "A message",
104             # "fbtrace_id": "EJplcsCHuLu"
105             # }
106             #}
107 5         9 my $error = eval { $self->as_hashref->{error}; };
  5         19  
108              
109 5         11 my $err_str = q{};
110 5 50 33     27 if ($@ || !$error) {
111 0         0 $err_str = $self->message;
112             }
113             else {
114             # sometimes error_subcode is not given
115             $err_str = sprintf(
116             qq{%s:%s\t%s:%s\t%s\t%s:%s},
117             $error->{code},
118             $error->{error_subcode} || '-',
119             $error->{type},
120             $error->{message},
121             $error->{fbtrace_id},
122             $error->{error_user_title} || '-',
123 5   100     87 $error->{error_user_msg} || '-',
      100        
      100        
124             );
125             }
126              
127 5         20 return $err_str;
128             }
129              
130             sub as_json {
131 49     49 1 76 my $self = shift;
132              
133 49         121 my $content = $self->content;
134 49 100       244 if ($content =~ m{\A (true|false) \z}xms) {
135             # On v2.0 and older version, some endpoints return plain text saying
136             # 'true' or 'false' to indicate result, so make it JSON formatted for
137             # our convinience. The key is named "success" so its format matches with
138             # other endpoints that return {"success": "(true|false)"}.
139             # From v2.1 they always return in form of {"success": "(true|false)"}.
140             # See https://developers.facebook.com/docs/apps/changelog#v2_1_changes
141 1         7 $content = sprintf('{"success" : "%s"}', $1);
142             };
143              
144 49         783 return $content; # content is JSON formatted
145             }
146              
147             sub as_hashref {
148 49     49 1 87 my $self = shift;
149             # just in case content is not properly formatted
150 49         78 my $hash_ref = eval { $self->json->decode( $self->as_json ); };
  49         129  
151 49 50       148 croak $@ if $@;
152 49         359 return $hash_ref;
153             }
154              
155             # Indicates whether the data is modified.
156             # It should be used when you request with ETag.
157             # https://developers.facebook.com/docs/reference/ads-api/etags-reference/
158             sub is_modified {
159 2     2 1 4 my $self = shift;
160 2   66     5 my $not_modified = $self->code == 304 && $self->message eq 'Not Modified';
161 2         15 return !$not_modified;
162             }
163              
164             1;
165             __END__