File Coverage

blib/lib/Device/RFXCOM/Decoder/X10Security.pm
Criterion Covered Total %
statement 56 58 96.5
branch 18 18 100.0
condition 6 6 100.0
subroutine 10 10 100.0
pod 2 2 100.0
total 92 94 97.8


line stmt bran cond sub pod time code
1 4     4   3611 use strict;
  4         15  
  4         160  
2 4     4   21 use warnings;
  4         9  
  4         205  
3             package Device::RFXCOM::Decoder::X10Security;
4             $Device::RFXCOM::Decoder::X10Security::VERSION = '1.142010';
5             # ABSTRACT: Device::RFXCOM::Decoder::X10Security decode X10 Security RF messages
6              
7              
8 4     4   85 use 5.006;
  4         13  
  4         167  
9 4     4   21 use constant DEBUG => $ENV{DEVICE_RFXCOM_DECODER_X10_SECURITY_DEBUG};
  4         6  
  4         245  
10 4     4   22 use Carp qw/croak/;
  4         7  
  4         405  
11 4     4   25 use base 'Device::RFXCOM::Decoder';
  4         14  
  4         397  
12 4     4   2857 use Device::RFXCOM::Response::Security;
  4         12  
  4         119  
13 4     4   2468 use Device::RFXCOM::Response::Sensor;
  4         10  
  4         1830  
14              
15              
16             sub decode {
17 34     34 1 70 my ($self, $parent, $message, $bytes, $bits, $result) = @_;
18 34 100 100     208 ($bits == 32 || $bits == 41) or return;
19              
20             # bits are not reversed yet!
21 13 100 100     96 (($bytes->[0]^0x0f) == $bytes->[1] && ($bytes->[2]^0xff) == $bytes->[3])
22             or return;
23              
24 6         17 $self->reverse_bits($bytes); # TOFIX: corrupts the input data?
25              
26 6         21 my $device = sprintf 'x10sec%02x', $bytes->[0];
27 6         13 my $short_device = $bytes->[0];
28 6         8 my $data = $bytes->[2];
29              
30 6         47 my %not_supported_yet =
31             (
32             # See: http://www.wgldesigns.com/protocols/w800rf32_protocol.txt
33             0x70 => 'SH624 arm home (min)',
34             #0x60 => 'SH624 arm away (min)',
35             0x50 => 'SH624 arm home (max)',
36             0x40 => 'SH624 arm away (max)',
37             0x41 => 'SH624 disarm',
38             0x42 => 'SH624 sec light on',
39             0x43 => 'SH624 sec light off',
40             0x44 => 'SH624 panic',
41             );
42              
43 6         33 my %x10_security =
44             (
45             0x60 => ['arm-away', 'min'],
46             0x61 => 'disarm',
47             0x62 => 'lights-on',
48             0x63 => 'lights-off',
49             );
50              
51 6         12 my $command;
52             my $tamper;
53 0         0 my $min_delay;
54 0         0 my $low_battery;
55              
56 6 100       26 if (exists $x10_security{$data}) {
    100          
57 2         3 my $rec = $x10_security{$data};
58 2 100       7 if (ref $rec) {
59 1         5 ($command, $min_delay) = @$rec;
60             } else {
61 1         3 $command = $rec;
62             }
63             } elsif (exists $not_supported_yet{$data}) {
64 1         14 warn sprintf "Not supported: %02x %s\n", $data, $not_supported_yet{$data};
65 1         12 return 1;
66             } else {
67              
68 3         4 my $alert = !($data&0x1);
69 3 100       10 $command = $alert ? 'alert' : 'normal',
70             $tamper = $data&0x2;
71 3         5 $min_delay = $data&0x20;
72 3         6 $low_battery = $data&0x80;
73             }
74              
75 5         17 my %args =
76             (
77             event => $command,
78             device => $device,
79             );
80 5 100       14 $args{tamper} = 1 if ($tamper);
81 5 100       16 $args{min_delay} = 1 if ($min_delay);
82 5 100       9 push @{$result->{messages}},
  5         35  
83             Device::RFXCOM::Response::Security->new(%args),
84             Device::RFXCOM::Response::Sensor->new(device => $device,
85             measurement => 'battery',
86             value => $low_battery ? 10 : 90,
87             units => '%');
88 5         43 return 1;
89             }
90              
91              
92             sub reverse_bits {
93 6     6 1 9 my $self = shift;
94 6         9 my $bytes = shift;
95 6         15 foreach (@$bytes) {
96 32         108 $_ = unpack 'C',(pack 'B8', (unpack 'b8', (pack 'C',$_)));
97             }
98 6         12 return 1;
99             }
100              
101             1;
102              
103             __END__