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; |