| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
4
|
|
|
4
|
|
2458
|
use strict; |
|
|
4
|
|
|
|
|
7
|
|
|
|
4
|
|
|
|
|
132
|
|
|
2
|
4
|
|
|
4
|
|
18
|
use warnings; |
|
|
4
|
|
|
|
|
10
|
|
|
|
4
|
|
|
|
|
197
|
|
|
3
|
|
|
|
|
|
|
package Device::RFXCOM::Decoder::X10; |
|
4
|
|
|
|
|
|
|
$Device::RFXCOM::Decoder::X10::VERSION = '1.163170'; |
|
5
|
|
|
|
|
|
|
# ABSTRACT: Device::RFXCOM::Decoder::X10 decode X10 RF messages |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
71
|
use 5.006; |
|
|
4
|
|
|
|
|
78
|
|
|
9
|
4
|
|
|
4
|
|
26
|
use constant DEBUG => $ENV{DEVICE_RFXCOM_DECODER_X10_DEBUG}; |
|
|
4
|
|
|
|
|
6
|
|
|
|
4
|
|
|
|
|
274
|
|
|
10
|
4
|
|
|
4
|
|
19
|
use Carp qw/croak/; |
|
|
4
|
|
|
|
|
4
|
|
|
|
4
|
|
|
|
|
189
|
|
|
11
|
4
|
|
|
4
|
|
16
|
use base 'Device::RFXCOM::Decoder'; |
|
|
4
|
|
|
|
|
4
|
|
|
|
4
|
|
|
|
|
310
|
|
|
12
|
4
|
|
|
4
|
|
1891
|
use Device::RFXCOM::Response::X10; |
|
|
4
|
|
|
|
|
8
|
|
|
|
4
|
|
|
|
|
2006
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
|
16
|
8
|
|
|
8
|
1
|
76
|
my $pkg = shift; |
|
17
|
8
|
|
|
|
|
50
|
$pkg->SUPER::new(unit_cache => {}, default_x10_level => 10, @_); |
|
18
|
|
|
|
|
|
|
} |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub decode { |
|
22
|
41
|
|
|
41
|
1
|
92
|
my ($self, $parent, $message, $bytes, $bits, $result) = @_; |
|
23
|
41
|
100
|
|
|
|
117
|
my $res = from_rf($bytes) or return; |
|
24
|
7
|
|
|
|
|
19
|
my $h = $res->{house}; |
|
25
|
7
|
|
|
|
|
16
|
my $f = $res->{command}; |
|
26
|
7
|
100
|
|
|
|
57
|
$self->{unit_cache}->{$h} = $res->{unit} if (exists $res->{unit}); |
|
27
|
7
|
|
|
|
|
25
|
my %r = |
|
28
|
|
|
|
|
|
|
( |
|
29
|
|
|
|
|
|
|
command => $f, |
|
30
|
|
|
|
|
|
|
); |
|
31
|
7
|
|
|
|
|
19
|
my $u = $self->{unit_cache}->{$h}; |
|
32
|
7
|
|
|
|
|
11
|
my $dont_cache; |
|
33
|
7
|
100
|
|
|
|
31
|
if (defined $u) { |
|
34
|
6
|
|
|
|
|
29
|
$r{device} = $h.$u; |
|
35
|
|
|
|
|
|
|
} else { |
|
36
|
1
|
|
|
|
|
13
|
warn "Don't have unit code for: $h $f\n"; |
|
37
|
1
|
|
|
|
|
8
|
$result->{dont_cache} = 1; |
|
38
|
1
|
|
|
|
|
4
|
$r{house} = $h; |
|
39
|
|
|
|
|
|
|
} |
|
40
|
7
|
100
|
100
|
|
|
57
|
if ($f eq 'bright' or $f eq 'dim') { |
|
41
|
3
|
|
|
|
|
6
|
$r{level} = $self->{default_x10_level}; |
|
42
|
|
|
|
|
|
|
} |
|
43
|
7
|
|
|
|
|
13
|
push @{$result->{messages}}, Device::RFXCOM::Response::X10->new(%r); |
|
|
7
|
|
|
|
|
92
|
|
|
44
|
7
|
|
|
|
|
52
|
return 1; |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
my %byte_to_house = |
|
48
|
|
|
|
|
|
|
( |
|
49
|
|
|
|
|
|
|
'6' => 'a', '7' => 'b', '4' => 'c', '5' => 'd', '8' => 'e', '9' => 'f', |
|
50
|
|
|
|
|
|
|
'10' => 'g', '11' => 'h', '14' => 'i', '15' => 'j', '12' => 'k', |
|
51
|
|
|
|
|
|
|
'13' => 'l', '0' => 'm', '1' => 'n', '2' => 'o', '3' => 'p', |
|
52
|
|
|
|
|
|
|
); |
|
53
|
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
my %byte_to_unit = |
|
55
|
|
|
|
|
|
|
( |
|
56
|
|
|
|
|
|
|
0x00 => 1, 0x10 => 2, 0x08 => 3, 0x18 => 4, 0x40 => 5, 0x50 => 6, |
|
57
|
|
|
|
|
|
|
0x48 => 7, 0x58 => 8 |
|
58
|
|
|
|
|
|
|
); |
|
59
|
|
|
|
|
|
|
my $unit_mask= 0x58; |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
my %byte_to_command = |
|
62
|
|
|
|
|
|
|
( |
|
63
|
|
|
|
|
|
|
0x0 => 'on', |
|
64
|
|
|
|
|
|
|
0x20 => 'off', |
|
65
|
|
|
|
|
|
|
0x80 => 'all_lights_off', |
|
66
|
|
|
|
|
|
|
0x88 => 'bright', |
|
67
|
|
|
|
|
|
|
0x90 => 'all_lights_on', |
|
68
|
|
|
|
|
|
|
0x98 => 'dim', |
|
69
|
|
|
|
|
|
|
); |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub from_rf { |
|
73
|
41
|
|
|
41
|
1
|
58
|
my $bytes = shift; |
|
74
|
|
|
|
|
|
|
|
|
75
|
41
|
100
|
|
|
|
96
|
return unless (is_x10($bytes)); |
|
76
|
7
|
|
|
|
|
23
|
my %r = (); |
|
77
|
7
|
|
|
|
|
19
|
my $mask = 0x98; |
|
78
|
7
|
100
|
|
|
|
31
|
unless ($bytes->[2]&0x80) { |
|
79
|
4
|
|
|
|
|
33
|
$r{unit} = $byte_to_unit{$bytes->[2]&$unit_mask}; |
|
80
|
4
|
100
|
|
|
|
21
|
$r{unit} += 8 if ($bytes->[0]&0x4); |
|
81
|
4
|
|
|
|
|
9
|
$mask = 0x20; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
7
|
|
|
|
|
48
|
$r{house} = $byte_to_house{($bytes->[0]&0xf0)>>4}; |
|
84
|
7
|
|
|
|
|
26
|
$r{command} = $byte_to_command{$bytes->[2]&$mask}; |
|
85
|
7
|
|
|
|
|
28
|
return \%r; |
|
86
|
|
|
|
|
|
|
} |
|
87
|
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub is_x10 { |
|
90
|
41
|
|
|
41
|
1
|
69
|
my $bytes = shift; |
|
91
|
|
|
|
|
|
|
|
|
92
|
41
|
100
|
|
|
|
240
|
return unless (scalar @$bytes == 4); |
|
93
|
|
|
|
|
|
|
|
|
94
|
15
|
100
|
100
|
|
|
209
|
(($bytes->[2]^0xff) == $bytes->[3] && |
|
95
|
|
|
|
|
|
|
($bytes->[0]^0xff) == $bytes->[1] && |
|
96
|
|
|
|
|
|
|
!($bytes->[2]&0x7)); |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
1; |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
__END__ |