File Coverage

blib/lib/Power/Outlet/Hue.pm
Criterion Covered Total %
statement 12 75 16.0
branch 0 50 0.0
condition n/a
subroutine 4 18 22.2
pod 6 6 100.0
total 22 149 14.7


line stmt bran cond sub pod time code
1             package Power::Outlet::Hue;
2 2     2   103312 use strict;
  2         13  
  2         95  
3 2     2   12 use warnings;
  2         2  
  2         57  
4 2     2   1204 use Data::Dumper qw{Dumper};
  2         13060  
  2         134  
5 2     2   13 use base qw{Power::Outlet::Common::IP::HTTP::JSON};
  2         6  
  2         1420  
6              
7             our $VERSION = '0.50';
8              
9             =head1 NAME
10              
11             Power::Outlet::Hue - Control and query a Philips Hue light
12              
13             =head1 SYNOPSIS
14              
15             my $outlet=Power::Outlet::Hue->new(host => "mybridge", id=>1, username=>"myuser");
16             print $outlet->query, "\n";
17             print $outlet->on, "\n";
18             print $outlet->off, "\n";
19              
20             =head1 DESCRIPTION
21              
22             Power::Outlet::Hue is a package for controlling and querying a light on a Philips Hue network attached bridge.
23              
24             =head1 USAGE
25              
26             use Power::Outlet::Hue;
27             my $lamp=Power::Outlet::Hue->new(host=>"mybridge", id=>1, username=>"myuser");
28             print $lamp->on, "\n";
29              
30             =head1 CONSTRUCTOR
31              
32             =head2 new
33              
34             my $outlet=Power::Outlet->new(type=>"Hue", host=>"mybridge", id=>1);
35             my $outlet=Power::Outlet::Hue->new(host=>"mybridge", id=>1);
36              
37             =head1 PROPERTIES
38              
39             =head2 id
40              
41             ID for the particular light as configured in the Philips Hue Bridge
42              
43             Default: 1
44              
45             =cut
46              
47             sub id {
48 0     0 1   my $self = shift;
49 0 0         $self->{"id"} = shift if @_;
50 0 0         $self->{"id"} = $self->_id_default unless defined $self->{"id"};
51 0           return $self->{"id"};
52             }
53              
54 0     0     sub _id_default {1};
55              
56             =head2 resource
57              
58             Resource for the particular object as presented on the Philips Hue Bridge
59              
60             Default: lights
61              
62             Currently supported Resources from L
63              
64             lights - resource which contains all the light resources
65             groups - resource which contains all the groups
66             config - resource which contains all the configuration items
67             schedules - which contains all the schedules
68             scenes - which contains all the scenes
69             sensors - which contains all the sensors
70             rules - which contains all the rules
71              
72             =cut
73              
74             sub resource {
75 0     0 1   my $self = shift;
76 0 0         $self->{"resource"} = shift if @_;
77 0 0         $self->{"resource"} = $self->_resource_default unless defined $self->{"resource"};
78 0           return $self->{"resource"};
79             }
80              
81 0     0     sub _resource_default {'lights'};
82              
83             =head2 host
84              
85             Sets and returns the hostname or IP address.
86              
87             Default: mybridge
88              
89             =cut
90              
91 0     0     sub _host_default {"mybridge"};
92              
93             =head2 port
94              
95             Sets and returns the port number.
96              
97             Default: 80
98              
99             =cut
100              
101 0     0     sub _port_default {"80"};
102              
103             =head2 username
104              
105             Sets and returns the username used for authentication with the Hue Bridge
106              
107             Default: newdeveloper (Hue Emulator default)
108              
109             =cut
110              
111             sub username {
112 0     0 1   my $self = shift;
113 0 0         $self->{"username"} = shift if @_;
114 0 0         $self->{"username"} = $self->_username_default unless defined $self->{"username"};
115 0           return $self->{"username"};
116             }
117              
118 0     0     sub _username_default {"newdeveloper"};
119              
120             =head2 name
121              
122             Returns the configured friendly name for the device
123              
124             =cut
125              
126             sub _name_default { #overloaded _name_default so the name will be cached for the life of this object
127 0     0     my $self = shift;
128 0           my $url = $self->url; #isa URI from Power::Outlet::Common::IP::HTTP
129 0           $url->path($self->_path);
130 0           my $res = $self->json_request(GET => $url); #isa perl structure
131 0           return $res->{"name"}; #isa string
132             }
133              
134             =head1 METHODS
135              
136             =cut
137              
138             #head2 _path
139              
140             #Builds the URL path
141              
142             #cut
143              
144             sub _path {
145 0     0     my $self = shift;
146 0           my $state = shift;
147 0 0         my @state = defined($state) ? ($state) : ();
148 0 0         my @resource = defined($self->resource) ? ($self->resource) : (); #support undef resource just in case needed
149 0           return join('/', '', 'api', $self->username, @resource, $self->id, @state);
150             }
151              
152             =head2 query
153              
154             Sends an HTTP message to the device to query the current state
155              
156             =cut
157              
158             #Response: {"identifier":null,"state":{"on":true,"bri":254,"hue":4444,"sat":254,"xy":[0.0,0.0],"ct":0,"alert":"none","effect":"none","colormode":"hs","reachable":true,"transitionTime":null},"type":"Extended color light","name":"Hue Lamp 1","modelid":"LCT001","swversion":"65003148","pointsymbol":{"1":"none","2":"none","3":"none","4":"none","5":"none","6":"none","7":"none","8":"none"}}
159             #Response: [{"error":{"address":"/","description":"unauthorized user","type":"1"}}]
160             #Response: [{"error":{"address":"/lights/333","description":"resource, /lights/333, not available","type":"3"}}]
161              
162              
163             sub query {
164 0     0 1   my $self = shift;
165 0 0         if (defined wantarray) { #scalar and list context
166              
167             #url configuration
168 0           my $url = $self->url; #isa URI from Power::Outlet::Common::IP::HTTP
169 0           $url->path($self->_path);
170              
171             #web request
172 0           my $res = $self->json_request(GET => $url); #isa perl structure
173              
174             #Response is an ARRAY on error and a HASH on success
175 0 0         if (ref($res) eq "HASH") {
    0          
176 0 0         die("Error: (query) state does not exists") unless exists $res->{"state"};
177 0 0         die("Error: (query) state is not a hash") unless ref($res->{"state"}) eq "HASH";
178 0 0         die("Error: (query) state does not provide on property") unless exists $res->{"state"}->{"on"};
179 0           my $state = $res->{"state"}->{"on"}; #isa boolean true/false
180 0 0         return $state ? "ON" : "OFF";
181             } elsif (ref($res) eq "ARRAY") {
182 0           my $hash = shift(@$res);
183 0 0         die(sprintf(qq{Error: (query) "%s"}, $hash->{"error"}->{"description"})) if exists $hash->{"error"};
184 0           die(sprintf("Error: (query) Unkown Error: URL: %s\n\n%s", $url, Dumper($res)));
185             } else {
186 0           die(sprintf("Error: (query) Unkown Error: URL: %s\n\n%s", $url, Dumper($res)));
187             }
188             } else { #void context
189 0           return;
190             }
191             }
192              
193             =head2 on
194              
195             Sends a message to the device to Turn Power ON
196              
197             =cut
198              
199             #Response: [{"success":{"/lights/1/state/on":true}}]
200             #Response: [{"error":{"address":"/","description":"unauthorized user","type":"1"}}]
201             #Response: [{"error":{"address":"/lights/333","description":"resource, /lights/333, not available","type":"3"}}]
202              
203             sub on {
204 0     0 1   my $self = shift;
205 0           return $self->_call("on");
206             }
207              
208             =head2 off
209              
210             Sends a message to the device to Turn Power OFF
211              
212             =cut
213              
214             sub off {
215 0     0 1   my $self = shift;
216 0           return $self->_call("off");
217             }
218              
219             sub _call {
220 0     0     my $self = shift;
221 0 0         my $input = shift or die;
222 0 0         my $boolean = $input eq "on" ? \1 : #JSON true
    0          
223             $input eq "off" ? \0 : #JSON false
224             die("Error: (_call) syntax _call('on'||'off')");
225              
226             #url configuration
227 0           my $url = $self->url; #isa URI from Power::Outlet::Common::IP::HTTP
228 0           $url->path($self->_path('state'));
229              
230             #web request
231 0           my $array = $self->json_request(PUT => $url, {on=>$boolean}); #isa perl structure
232              
233             #error handling
234 0 0         die("Error: ($input) failed to return expected JSON format") unless ref($array) eq "ARRAY";
235 0           my $hash = shift(@$array);
236 0 0         die("Error: ($input) Failed to return expected JSON format") unless ref($hash) eq "HASH";
237 0 0         die(sprintf(qq{Error: ($input) "%s"}, $hash->{"error"}->{"description"})) if exists $hash->{"error"};
238 0 0         die(sprintf("Error: ($input) Unkown Error: URL: %s\n\n%s", $url, Dumper($array))) unless exists $hash->{"success"};
239 0           my $success = $hash->{"success"};
240             #state normalization
241 0           my $key = sprintf("/lights/%s/state/on", $self->id);
242 0 0         die("Error: ($input) Unkown success state") unless exists $success->{$key};
243 0           my $state = $success->{$key};
244 0 0         return $state ? "ON" : "OFF";
245             }
246              
247             =head2 switch
248              
249             Queries the device for the current status and then requests the opposite.
250              
251             =cut
252              
253             #see Power::Outlet::Common->switch
254              
255             =head2 cycle
256              
257             Sends messages to the device to Cycle Power (ON-OFF-ON or OFF-ON-OFF).
258              
259             =cut
260              
261             #see Power::Outlet::Common->cycle
262              
263             =head1 BUGS
264              
265             Please log on RT and send an email to the author.
266              
267             =head1 SUPPORT
268              
269             DavisNetworks.com supports all Perl applications including this package.
270              
271             =head1 AUTHOR
272              
273             Michael R. Davis
274             CPAN ID: MRDVT
275             DavisNetworks.com
276              
277             Thanks to Mathias Neerup manee12 at student.sdu.dk - L
278              
279             =head1 COPYRIGHT
280              
281             Copyright (c) 2018 Michael R. Davis
282              
283             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
284              
285             The full text of the license can be found in the LICENSE file included with this module.
286              
287             =head1 SEE ALSO
288              
289             L, L, L
290              
291             =cut
292              
293             1;