File Coverage

blib/lib/Power/Outlet/WeMo.pm
Criterion Covered Total %
statement 9 31 29.0
branch 0 8 0.0
condition n/a
subroutine 3 11 27.2
pod 3 3 100.0
total 15 53 28.3


line stmt bran cond sub pod time code
1             package Power::Outlet::WeMo;
2 2     2   108348 use strict;
  2         24  
  2         60  
3 2     2   10 use warnings;
  2         4  
  2         56  
4 2     2   11 use base qw{Power::Outlet::Common::IP::HTTP::UPnP};
  2         4  
  2         919  
5              
6             our $VERSION = '0.47';
7              
8             =head1 NAME
9              
10             Power::Outlet::WeMo - Control and query a Belkin WeMo power outlet
11              
12             =head1 SYNOPSIS
13              
14             my $outlet=Power::Outlet::WeMo->new(host => "mywemo");
15             print $outlet->query, "\n";
16             print $outlet->on, "\n";
17             print $outlet->off, "\n";
18              
19             =head1 DESCRIPTION
20              
21             Power::Outlet::WeMo is a package for controlling and querying an outlet on a Belkin WeMo network attached power outlet.
22              
23             =head1 USAGE
24              
25             use Power::Outlet::WeMo;
26             use DateTime;
27             my $lamp=Power::Outlet::WeMo->new(host=>"mywemo");
28             my $hour=DateTime->now->hour;
29             my $night=$hour > 20 ? 1 : $hour < 06 ? 1 : 0;
30             if ($night) {
31             print $lamp->on, "\n";
32             } else {
33             print $lamp->off, "\n";
34             }
35              
36             =head1 CONSTRUCTOR
37              
38             =head2 new
39              
40             my $outlet=Power::Outlet->new(type=>"WeMo", "host=>"mywemo");
41             my $outlet=Power::Outlet::WeMo->new(host=>"mywemo");
42              
43             =head1 PROPERTIES
44              
45             =head2 host
46              
47             Sets and returns the hostname or IP address.
48              
49             Note: Set IP address via DHCP static mapping
50              
51             =cut
52              
53 0     0     sub _host_default {"wemo"};
54              
55             =head2 port
56              
57             Sets and returns the port number.
58              
59             =cut
60              
61 0     0     sub _port_default {"49153"};
62              
63             =head2 name
64              
65             Returns the configured FriendlyName from the WeMo device
66              
67             =cut
68              
69             sub _name_default {
70 0     0     my $self=shift;
71 0           my $res=$self->upnp_request("Get", "FriendlyName"); #isa Net::UPnP::ActionResponse
72 0           my $name=$res->getargumentlist->{'FriendlyName'};
73 0           return $name;
74             }
75              
76 0     0     sub _http_path_default {"/upnp/control/basicevent1"}; #WeMo
77              
78 0     0     sub _upnp_service_type_default {"urn:Belkin:service:basicevent:1"}; #WeMo default
79              
80             =head1 METHODS
81              
82             =head2 query
83              
84             Sends a UPnP message to the WeMo device to query the current state
85              
86             =cut
87              
88             sub query {
89 0     0 1   my $self=shift;
90 0 0         if (defined wantarray) { #scalar and list context
91 0           my $res=$self->upnp_request("Get", "BinaryState"); #isa Net::UPnP::ActionResponse
92 0           my $state=$res->getargumentlist->{'BinaryState'};
93 0 0         return $state ? "ON" : "OFF";
94             } else { #void context
95 0           return;
96             }
97             }
98              
99             =head2 on
100              
101             Sends a UPnP message to the WeMo device to Turn Power ON
102              
103             =cut
104              
105             sub on {
106 0     0 1   my $self=shift;
107 0           my $res=$self->upnp_request("Set", "BinaryState", "1"); #isa Net::UPnP::ActionResponse
108 0           my $state=$res->getargumentlist->{'BinaryState'};
109 0 0         return $state ? "ON" : "OFF";
110             }
111              
112             =head2 off
113              
114             Sends a UPnP message to the WeMo device to Turn Power OFF
115              
116             =cut
117              
118             sub off {
119 0     0 1   my $self=shift;
120 0           my $res=$self->upnp_request("Set", "BinaryState", "0"); #isa Net::UPnP::ActionResponse
121 0           my $state=$res->getargumentlist->{'BinaryState'};
122 0 0         return $state ? "ON" : "OFF";
123             }
124              
125              
126             =head2 switch
127              
128             Queries the device for the current status and then requests the opposite.
129              
130             =cut
131              
132             #see Power::Outlet::Common->switch
133              
134             =head2 cycle
135              
136             Sends UPnP messages to the WeMo device to Cycle Power (ON-OFF-ON or OFF-ON-OFF).
137              
138             =cut
139              
140             #see Power::Outlet::Common->cycle
141              
142             =head1 BUGS
143              
144             Please log on RT and send an email to the author.
145              
146             =head1 SUPPORT
147              
148             DavisNetworks.com supports all Perl applications including this package.
149              
150             =head1 AUTHOR
151              
152             Michael R. Davis
153             CPAN ID: MRDVT
154             DavisNetworks.com
155              
156             =head1 COPYRIGHT
157              
158             Copyright (c) 2013 Michael R. Davis
159              
160             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
161              
162             The full text of the license can be found in the LICENSE file included with this module.
163              
164             Portions of the WeMo Implementation Copyright (c) 2013 Eric Blue
165              
166             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
167              
168             =head1 SEE ALSO
169              
170             L, L
171              
172             =cut
173              
174             1;