File Coverage

blib/lib/Device/RFXCOM/Encoder/HomeEasy.pm
Criterion Covered Total %
statement 54 58 93.1
branch 12 14 85.7
condition 2 6 33.3
subroutine 9 9 100.0
pod 2 2 100.0
total 79 89 88.7


line stmt bran cond sub pod time code
1 1     1   1944 use strict;
  1         3  
  1         50  
2 1     1   7 use warnings;
  1         2  
  1         89  
3             package Device::RFXCOM::Encoder::HomeEasy;
4             $Device::RFXCOM::Encoder::HomeEasy::VERSION = '1.163170';
5             # ABSTRACT: Device::RFXCOM::Encoder::HomeEasy encode HomeEasy RF messages
6              
7              
8 1     1   37 use 5.006;
  1         3  
9 1     1   6 use constant DEBUG => $ENV{DEVICE_RFXCOM_ENCODER_HOMEEASY_DEBUG};
  1         2  
  1         114  
10 1     1   7 use Carp qw/croak carp/;
  1         2  
  1         99  
11 1     1   6 use base 'Device::RFXCOM::Encoder';
  1         2  
  1         690  
12 1     1   870 use Device::RFXCOM::Response::HomeEasy;
  1         3  
  1         646  
13              
14              
15             sub encode {
16 4     4 1 8 my ($self, $parent, $p) = @_;
17 4         12 my @bytes = ( 0, 0, 0, 0, 0 );
18 4         8 my $length = 33;
19 4         7 my $command;
20              
21 4 50 33     38 unless (exists $p->{command} && exists $p->{unit} && exists $p->{address}) {
      33        
22 0         0 carp $self.'->encode: Invalid homeeasy message';
23 0         0 return [];
24             }
25 4 100       13 if ($p->{command} eq 'preset') {
26 1 50       7 unless (exists $p->{level}) {
27 0         0 carp $self.'->encode: Invalid homeeasy message';
28 0         0 return [];
29             }
30 1         4 $length = 36;
31 1         4 $bytes[4] = $p->{level} << 4;
32 1         3 $command = 0;
33             } else {
34 3 100       16 $command = $p->{command} eq 'on' ? 1 : 0;
35             }
36 4 100       17 if ($p->{unit} eq 'group') {
37 1         4 $p->{unit} = 0;
38 1         4 $command |= 0x2;
39             }
40 4         13 my $addr = encode_address($p->{address});
41 4         9 $bytes[0] = $addr >> 18;
42 4         9 $bytes[1] = ($addr >> 10) & 0xff;
43 4         7 $bytes[2] = ($addr >> 2) & 0xff;
44 4         7 $bytes[3] = (($addr & 0x3) << 6);
45 4         9 $bytes[3] |= $p->{unit};
46 4         7 $bytes[3] |= ($command << 4);
47             return {
48             raw => (pack 'C6', $length, @bytes),
49             desc =>
50             'homeeasy: '.(join '/',
51 12         51 grep { defined $_
52 4         20 } @{$p}{qw/command address unit/})
  4         13  
53             },
54             }
55              
56              
57             sub encode_address {
58 4     4 1 9 my $addr = shift;
59 4 100       27 return hex($addr) & 0x3ffffff if ($addr =~ /^0x[0-9a-f]{1,8}$/i);
60 3         6 my $val = 0;
61 3         5 my $offset = 0;
62 3         15 foreach my $b (map { ord $_ } split //, $addr) {
  15         28  
63 15         19 $val ^= ($b&0x7f) << $offset;
64 15         19 $offset += 4;
65 15 100       38 $offset = 0 if ($offset > 20);
66             }
67 3         12 return $val & 0x3ffffff;
68             }
69              
70             1;
71              
72             __END__