| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Facebook::OpenGraph::Response; |
|
2
|
34
|
|
|
34
|
|
55402
|
use strict; |
|
|
34
|
|
|
|
|
68
|
|
|
|
34
|
|
|
|
|
842
|
|
|
3
|
34
|
|
|
34
|
|
154
|
use warnings; |
|
|
34
|
|
|
|
|
55
|
|
|
|
34
|
|
|
|
|
643
|
|
|
4
|
34
|
|
|
34
|
|
444
|
use 5.008001; |
|
|
34
|
|
|
|
|
105
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
34
|
|
|
34
|
|
164
|
use Carp qw(croak); |
|
|
34
|
|
|
|
|
60
|
|
|
|
34
|
|
|
|
|
1667
|
|
|
7
|
34
|
|
|
34
|
|
10021
|
use JSON 2 (); |
|
|
34
|
|
|
|
|
195760
|
|
|
|
34
|
|
|
|
|
23196
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub new { |
|
10
|
55
|
|
|
55
|
1
|
8188
|
my $class = shift; |
|
11
|
55
|
|
100
|
|
|
173
|
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
|
55
|
|
66
|
|
|
725
|
req_content => $args->{req_content} || q{}, |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
21
|
|
|
|
|
|
|
}, $class; |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# accessors |
|
25
|
59
|
|
|
59
|
1
|
536
|
sub code { shift->{code} } |
|
26
|
36
|
|
|
36
|
1
|
117
|
sub headers { shift->{headers} } |
|
27
|
2
|
|
|
2
|
1
|
9
|
sub message { shift->{message} } |
|
28
|
51
|
|
|
51
|
1
|
125
|
sub content { shift->{content} } |
|
29
|
5
|
|
|
5
|
1
|
26
|
sub req_headers { shift->{req_headers} } |
|
30
|
1
|
|
|
1
|
1
|
5
|
sub req_content { shift->{req_content} } |
|
31
|
47
|
|
|
47
|
1
|
691
|
sub json { shift->{json} } |
|
32
|
1
|
|
|
1
|
1
|
4
|
sub etag { shift->header('etag') } |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub api_version { |
|
35
|
23
|
|
|
23
|
1
|
33
|
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
|
|
|
|
33
|
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
|
|
|
144
|
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
|
|
|
|
|
42
|
(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
|
|
|
53
|
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
|
|
|
79
|
$self->{header} ||= do { |
|
71
|
9
|
|
|
|
|
17
|
my $ref = +{}; |
|
72
|
|
|
|
|
|
|
|
|
73
|
9
|
|
|
|
|
18
|
while (my ($k, $v) = splice @{ $self->headers }, 0, 2) { |
|
|
35
|
|
|
|
|
81
|
|
|
74
|
26
|
|
|
|
|
66
|
$ref->{$k} = $v; |
|
75
|
|
|
|
|
|
|
} |
|
76
|
|
|
|
|
|
|
|
|
77
|
9
|
|
|
|
|
29
|
$ref; |
|
78
|
|
|
|
|
|
|
}; |
|
79
|
|
|
|
|
|
|
|
|
80
|
24
|
|
|
|
|
98
|
return $self->{header}->{$key}; |
|
81
|
|
|
|
|
|
|
} |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub is_success { |
|
84
|
51
|
|
|
51
|
1
|
102
|
my $self = shift; |
|
85
|
|
|
|
|
|
|
# code 2XX or 304 |
|
86
|
|
|
|
|
|
|
# 304 is returned when you use ETag and the data is not changed |
|
87
|
51
|
|
100
|
|
|
136
|
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
|
4
|
|
|
4
|
1
|
9
|
my $self = shift; |
|
94
|
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# When error occurs, response should be given in a form of below: |
|
96
|
|
|
|
|
|
|
#{ |
|
97
|
|
|
|
|
|
|
# "error": { |
|
98
|
|
|
|
|
|
|
# "message": "Message describing the error", |
|
99
|
|
|
|
|
|
|
# "type": "OAuthException", |
|
100
|
|
|
|
|
|
|
# "code": 190 , |
|
101
|
|
|
|
|
|
|
# "error_subcode": 460 |
|
102
|
|
|
|
|
|
|
# } |
|
103
|
|
|
|
|
|
|
#} |
|
104
|
4
|
|
|
|
|
8
|
my $error = eval { $self->as_hashref->{error}; }; |
|
|
4
|
|
|
|
|
13
|
|
|
105
|
|
|
|
|
|
|
|
|
106
|
4
|
|
|
|
|
10
|
my $err_str = q{}; |
|
107
|
4
|
50
|
33
|
|
|
29
|
if ($@ || !$error) { |
|
108
|
0
|
|
|
|
|
0
|
$err_str = $self->message; |
|
109
|
|
|
|
|
|
|
} |
|
110
|
|
|
|
|
|
|
else { |
|
111
|
|
|
|
|
|
|
# sometimes error_subcode is not given |
|
112
|
|
|
|
|
|
|
$err_str = sprintf( |
|
113
|
|
|
|
|
|
|
'%s:%s %s:%s', |
|
114
|
|
|
|
|
|
|
$error->{code}, |
|
115
|
|
|
|
|
|
|
$error->{error_subcode} || '-', |
|
116
|
|
|
|
|
|
|
$error->{type}, |
|
117
|
|
|
|
|
|
|
$error->{message}, |
|
118
|
4
|
|
50
|
|
|
40
|
); |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
4
|
|
|
|
|
16
|
return $err_str; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub as_json { |
|
125
|
45
|
|
|
45
|
1
|
86
|
my $self = shift; |
|
126
|
|
|
|
|
|
|
|
|
127
|
45
|
|
|
|
|
151
|
my $content = $self->content; |
|
128
|
45
|
100
|
|
|
|
243
|
if ($content =~ m{\A (true|false) \z}xms) { |
|
129
|
|
|
|
|
|
|
# On v2.0 and older version, some endpoints return plain text saying |
|
130
|
|
|
|
|
|
|
# 'true' or 'false' to indicate result, so make it JSON formatted for |
|
131
|
|
|
|
|
|
|
# our convinience. The key is named "success" so its format matches with |
|
132
|
|
|
|
|
|
|
# other endpoints that return {"success": "(true|false)"}. |
|
133
|
|
|
|
|
|
|
# From v2.1 they always return in form of {"success": "(true|false)"}. |
|
134
|
|
|
|
|
|
|
# See https://developers.facebook.com/docs/apps/changelog#v2_1_changes |
|
135
|
1
|
|
|
|
|
7
|
$content = sprintf('{"success" : "%s"}', $1); |
|
136
|
|
|
|
|
|
|
}; |
|
137
|
|
|
|
|
|
|
|
|
138
|
45
|
|
|
|
|
799
|
return $content; # content is JSON formatted |
|
139
|
|
|
|
|
|
|
} |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
sub as_hashref { |
|
142
|
45
|
|
|
45
|
1
|
92
|
my $self = shift; |
|
143
|
|
|
|
|
|
|
# just in case content is not properly formatted |
|
144
|
45
|
|
|
|
|
81
|
my $hash_ref = eval { $self->json->decode( $self->as_json ); }; |
|
|
45
|
|
|
|
|
125
|
|
|
145
|
45
|
50
|
|
|
|
155
|
croak $@ if $@; |
|
146
|
45
|
|
|
|
|
276
|
return $hash_ref; |
|
147
|
|
|
|
|
|
|
} |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# Indicates whether the data is modified. |
|
150
|
|
|
|
|
|
|
# It should be used when you request with ETag. |
|
151
|
|
|
|
|
|
|
# https://developers.facebook.com/docs/reference/ads-api/etags-reference/ |
|
152
|
|
|
|
|
|
|
sub is_modified { |
|
153
|
2
|
|
|
2
|
1
|
5
|
my $self = shift; |
|
154
|
2
|
|
66
|
|
|
5
|
my $not_modified = $self->code == 304 && $self->message eq 'Not Modified'; |
|
155
|
2
|
|
|
|
|
26
|
return !$not_modified; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
1; |
|
159
|
|
|
|
|
|
|
__END__ |