File Coverage

blib/lib/Power/Outlet/Common/IP/HTTP/JSON.pm
Criterion Covered Total %
statement 12 25 48.0
branch 0 12 0.0
condition 0 2 0.0
subroutine 4 5 80.0
pod 1 1 100.0
total 17 45 37.7


line stmt bran cond sub pod time code
1             package Power::Outlet::Common::IP::HTTP::JSON;
2 6     6   1285 use strict;
  6         20  
  6         233  
3 6     6   29 use warnings;
  6         10  
  6         316  
4 6     6   33 use base qw{Power::Outlet::Common::IP::HTTP};
  6         10  
  6         3007  
5             #use Data::Dumper qw{Dumper};
6 6     6   4269 use JSON qw{encode_json decode_json};
  6         76178  
  6         36  
7              
8             our $VERSION = '0.54';
9              
10             =head1 NAME
11              
12             Power::Outlet::Common::IP::HTTP::JSON - Power::Outlet base class for JSON power outlets
13              
14             =head1 SYNOPSIS
15              
16             use base qw{Power::Outlet::Common::IP::HTTP::JSON};
17              
18             =head1 DESCRIPTION
19              
20             Power::Outlet::Common::IP::HTTP::JSON is a package for controlling and querying an JSON-based network attached power outlet.
21              
22             =head1 USAGE
23              
24             use base qw{Power::Outlet::Common::IP::HTTP::JSON};
25              
26             =head1 PROPERTIES
27              
28             =head1 METHODS
29              
30             =head2 json_request
31              
32             JSON HTTP request response call
33              
34             my $response_data_structure=$outlet->json_request($method, $url, $request_data_structure, \%options);
35              
36             Example:
37              
38             my $response_data_structure=$outlet->json_request(PUT=>"http://localhost/service", {foo=>"bar"}, {headers=>{'Content-Type' => 'application/json'}});
39              
40             =cut
41              
42             sub json_request {
43 0     0 1   my $self = shift;
44 0 0         my $method = shift or die;
45 0 0         my $url = shift or die;
46 0           my $input = shift;
47 0   0       my $options = shift // {};
48 0 0         die("Error: options must be a hash reference") unless ref($options) eq 'HASH';
49 0 0         $options->{"content"} = encode_json($input) if defined $input;
50             #print "$method $url\n";
51             #print Dumper(\%options);
52 0           my $response = $self->http_client->request($method, $url, $options);
53 0 0         if ($response->{"status"} eq "599") {
    0          
54 0           die(sprintf(qq{HTTP Error: "%s %s", URL: "$url", Content: %s}, $response->{"status"}, $response->{"reason"}, $response->{"content"}));
55             } elsif ($response->{"status"} ne "200") {
56 0           die(sprintf(qq{HTTP Error: "%s %s", URL: "$url"}, $response->{"status"}, $response->{"reason"}));
57             }
58 0           my $json = $response->{"content"};
59             #print "Response: $json\n";
60 0           return decode_json($json);
61             }
62              
63             =head1 BUGS
64              
65             Please log on RT and send an email to the author.
66              
67             =head1 SUPPORT
68              
69             DavisNetworks.com supports all Perl applications including this package.
70              
71             =head1 AUTHOR
72              
73             Michael R. Davis
74             CPAN ID: MRDVT
75             DavisNetworks.com
76              
77             =head1 COPYRIGHT
78              
79             Copyright (c) 2013 Michael R. Davis
80              
81             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
82              
83             The full text of the license can be found in the LICENSE file included with this module.
84              
85             =head1 SEE ALSO
86              
87             L
88              
89             =cut
90              
91             1;