File Coverage

blib/lib/HTTP/Response/JSON.pm
Criterion Covered Total %
statement 23 24 95.8
branch 3 4 75.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 34 36 94.4


line stmt bran cond sub pod time code
1             package HTTP::Response::JSON;
2              
3 4     4   56855 use strict;
  4         17  
  4         107  
4 4     4   20 use warnings;
  4         8  
  4         99  
5 4     4   17 no warnings 'uninitialized';
  4         9  
  4         119  
6              
7 4     4   357 use LWP::JSON::Tiny;
  4         10  
  4         152  
8 4     4   32 use parent 'HTTP::Message::JSON', 'HTTP::Response';
  4         8  
  4         21  
9              
10 4     4   25936 use Encode;
  4         13  
  4         821  
11              
12             our $VERSION = $LWP::JSON::Tiny::VERSION;
13              
14             =head1 NAME
15              
16             HTTP::Response::JSON - a subclass of HTTP::Response that understands JSON
17              
18             =head1 SYNOPSIS
19              
20             if ($response->isa('HTTP::Response::JSON')) {
21             Your::Own::Code::do_something($response->json_content);
22             }
23              
24             =head1 DESCRIPTION
25              
26             This is a simple subclass of HTTP::Response that implements a method
27             L which returns the JSON-decoded contents of the response.
28              
29             =head2 json_content
30              
31             Out: $perl_data
32              
33             Returns the Perl data structure corresponding to the contents of this
34             response.
35              
36             Will throw an exception if the contents look like JSON but cannot be converted
37             to JSON. Will return undef if the contents don't look like JSON.
38              
39             =cut
40              
41             sub json_content {
42 4     4 1 6742 my ($self) = @_;
43              
44 4 100       15 return if $self->content_type !~ m{^ application/json }x;
45 3 50       127 if ($self->decoded_content !~ /\S/) {
46 0         0 return;
47             } else {
48 3         955 my $json = LWP::JSON::Tiny->json_object;
49 3         13 return $json->decode($self->decoded_content);
50             }
51             }
52              
53             =head1 AUTHOR
54              
55             Sam Kington
56              
57             The source code for this module is hosted on GitHub
58             L - this is probably the
59             best place to look for suggestions and feedback.
60              
61             =head1 COPYRIGHT
62              
63             Copyright (c) 2015 Sam Kington.
64              
65             =head1 LICENSE
66              
67             This library is free software and may be distributed under the same terms as
68             perl itself.
69              
70             =cut
71              
72             1;