File Coverage

blib/lib/Power/Outlet/Common/IP/HTTP/JSON.pm
Criterion Covered Total %
statement 12 24 50.0
branch 0 10 0.0
condition n/a
subroutine 4 5 80.0
pod 1 1 100.0
total 17 40 42.5


line stmt bran cond sub pod time code
1             package Power::Outlet::Common::IP::HTTP::JSON;
2 5     5   1112 use strict;
  5         10  
  5         114  
3 5     5   19 use warnings;
  5         9  
  5         103  
4 5     5   21 use base qw{Power::Outlet::Common::IP::HTTP};
  5         7  
  5         1642  
5             #use Data::Dumper qw{Dumper};
6 5     5   2559 use JSON qw{encode_json decode_json};
  5         45577  
  5         25  
7              
8             our $VERSION = '0.48';
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);
35              
36             Example:
37              
38             my $response_data_structure=$outlet->json_request(PUT=>"http://localhost/service", {foo=>"bar"});
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           my %options = ();
48 0 0         $options{"content"} = encode_json($input) if defined $input;
49             #print "$method $url\n";
50             #print Dumper(\%options);
51 0           my $response = $self->http_client->request($method, $url, \%options);
52 0 0         if ($response->{"status"} eq "599") {
    0          
53 0           die(sprintf(qq{HTTP Error: "%s %s", URL: "$url", Content: %s}, $response->{"status"}, $response->{"reason"}, $response->{"content"}));
54             } elsif ($response->{"status"} ne "200") {
55 0           die(sprintf(qq{HTTP Error: "%s %s", URL: "$url"}, $response->{"status"}, $response->{"reason"}));
56             }
57 0           my $json = $response->{"content"};
58             #print "Response: $json\n";
59 0           return decode_json($json);
60             }
61              
62             =head1 BUGS
63              
64             Please log on RT and send an email to the author.
65              
66             =head1 SUPPORT
67              
68             DavisNetworks.com supports all Perl applications including this package.
69              
70             =head1 AUTHOR
71              
72             Michael R. Davis
73             CPAN ID: MRDVT
74             DavisNetworks.com
75              
76             =head1 COPYRIGHT
77              
78             Copyright (c) 2013 Michael R. Davis
79              
80             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
81              
82             The full text of the license can be found in the LICENSE file included with this module.
83              
84             =head1 SEE ALSO
85              
86             L
87              
88             =cut
89              
90             1;