File Coverage

blib/lib/Power/Outlet/Common/IP/HTTP.pm
Criterion Covered Total %
statement 35 41 85.3
branch 8 18 44.4
condition n/a
subroutine 9 12 75.0
pod 4 4 100.0
total 56 75 74.6


line stmt bran cond sub pod time code
1             package Power::Outlet::Common::IP::HTTP;
2 7     7   86075 use strict;
  7         20  
  7         156  
3 7     7   28 use warnings;
  7         13  
  7         133  
4 7     7   3098 use URI qw{};
  7         36342  
  7         132  
5 7     7   3914 use HTTP::Tiny qw{};
  7         241927  
  7         205  
6 7     7   49 use base qw{Power::Outlet::Common::IP};
  7         12  
  7         2646  
7              
8             our $VERSION = '0.48';
9              
10             =head1 NAME
11              
12             Power::Outlet::Common::IP::HTTP - Power::Outlet base class for HTTP power outlet
13              
14             =head1 SYNOPSIS
15              
16             use base qw{Power::Outlet::Common::IP::HTTP};
17              
18             =head1 DESCRIPTION
19            
20             Power::Outlet::Common::IP::HTTP is a package for controlling and querying an HTTP-based network attached power outlet.
21              
22             =head1 USAGE
23              
24             use base qw{Power::Outlet::Common::IP::HTTP};
25              
26             =head1 METHODS
27              
28             =head2 url
29              
30             Returns a configured L object
31              
32             =cut
33              
34             sub url {
35 1     1 1 3 my $self = shift;
36 1 50       5 $self->{'url'} = shift if @_;
37 1 50       3 unless (defined $self->{'url'}) {
38 1         7 my $url = URI->new;
39 1         4137 $url->scheme($self->http_scheme);
40 1         2607 $url->host($self->host); #from Power::Outlet::Common::IP
41 1         109 $url->port($self->port); #from Power::Outlet::Common::IP
42 1         51 $url->path($self->http_path); #from Power::Outlet::Common::IP::HTTP
43 1         37 $self->{'url'} = $url;
44             }
45 1 50       8 die unless $self->{'url'}->isa('URI');
46 1         7 return $self->{'url'}->clone;
47             }
48              
49             =head1 PROPERTIES
50              
51             =head2 http_scheme
52              
53             Set and returns the http_scheme property
54              
55             Default: http
56              
57             =cut
58              
59             sub http_scheme {
60 1     1 1 2 my $self = shift;
61 1 50       4 $self->{'http_scheme'} = shift if @_;
62 1 50       5 $self->{'http_scheme'} = $self->_http_scheme_default unless defined $self->{'http_scheme'};
63 1         7 return $self->{'http_scheme'};
64             }
65              
66 1     1   2 sub _http_scheme_default {'http'};
67              
68 0     0   0 sub _port_default {'80'}; #HTTP
69              
70             =head2 http_path
71              
72             Set and returns the http_path property
73              
74             Default: /
75              
76             =cut
77              
78             sub http_path {
79 2     2 1 4 my $self = shift;
80 2 100       6 $self->{'http_path'} = shift if @_;
81 2 50       5 $self->{'http_path'} = $self->_http_path_default unless defined $self->{'http_path'};
82 2         9 return $self->{'http_path'};
83             }
84              
85 0     0     sub _http_path_default {'/upnp/control/basicevent1'}; #WeMo
86              
87             =head1 OBJECT ACCESSORS
88              
89             =head2 http_client
90              
91             Returns a cached L web client
92              
93             =cut
94              
95             sub http_client {
96 0     0 1   my $self = shift;
97 0 0         $self->{'http_client'} = shift if @_;
98             $self->{'http_client'} = HTTP::Tiny->new
99 0 0         unless ref($self->{'http_client'}) eq 'HTTP::Tiny';
100 0           return $self->{'http_client'};
101             }
102              
103             =head1 BUGS
104              
105             Please log on RT and send an email to the author.
106              
107             =head1 SUPPORT
108              
109             DavisNetworks.com supports all Perl applications including this package.
110              
111             =head1 AUTHOR
112              
113             Michael R. Davis
114             CPAN ID: MRDVT
115             DavisNetworks.com
116              
117             =head1 COPYRIGHT
118              
119             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
120              
121             The full text of the license can be found in the LICENSE file included with this module.
122              
123             =head1 SEE ALSO
124              
125             L, L
126              
127             =cut
128              
129             1;