File Coverage

blib/lib/Device/RFXCOM/Decoder/RFXMeter.pm
Criterion Covered Total %
statement 40 40 100.0
branch 8 8 100.0
condition n/a
subroutine 7 7 100.0
pod 1 1 100.0
total 56 56 100.0


line stmt bran cond sub pod time code
1 3     3   2896 use strict;
  3         8  
  3         100  
2 3     3   16 use warnings;
  3         6  
  3         135  
3             package Device::RFXCOM::Decoder::RFXMeter;
4             $Device::RFXCOM::Decoder::RFXMeter::VERSION = '1.142010';
5             # ABSTRACT: Device::RFXCOM::Decoder::RFXMeter decode RFXMeter RF messages
6              
7              
8 3     3   60 use 5.006;
  3         10  
  3         124  
9 3     3   13 use constant DEBUG => $ENV{DEVICE_RFXCOM_DECODER_RFXMETER_DEBUG};
  3         5  
  3         166  
10 3     3   18 use Carp qw/croak/;
  3         6  
  3         156  
11 3     3   16 use Device::RFXCOM::Decoder qw/nibble_sum/;
  3         6  
  3         1465  
12             our @ISA = qw(Device::RFXCOM::Decoder);
13              
14              
15             sub decode {
16 56     56 1 106 my ($self, $parent, $message, $bytes, $bits, $result) = @_;
17              
18 56 100       392 $bits == 48 or return;
19              
20 4 100       19 ($bytes->[0] == ($bytes->[1]^0xf0)) or return;
21              
22 3         16 my $device = sprintf "%02x%02x", $bytes->[0], $bytes->[1];
23 3         21 my @nib = map { hex $_ } split //, unpack "H*", $message;
  36         59  
24 3         10 my $type = $nib[10];
25 3         6 my $check = $nib[11];
26 3         14 my $nibble_sum = nibble_sum(11, \@nib);
27 3         7 my $parity = 0xf^($nibble_sum&0xf);
28 3 100       13 unless ($parity == $check) {
29 1         11 warn "RFXMeter parity error $parity != $check\n";
30 1         10 return;
31             }
32              
33 2         22 my $time =
34             { 0x01 => '30s',
35             0x02 => '1m',
36             0x04 => '5m',
37             0x08 => '10m',
38             0x10 => '15m',
39             0x20 => '30m',
40             0x40 => '45m',
41             0x80 => '60m',
42             };
43 2         14 my $type_str =
44             [
45             'normal data packet',
46             'new interval time set',
47             'calibrate value',
48             'new address set',
49             'counter value reset to zero',
50             'set 1st digit of counter value integer part',
51             'set 2nd digit of counter value integer part',
52             'set 3rd digit of counter value integer part',
53             'set 4th digit of counter value integer part',
54             'set 5th digit of counter value integer part',
55             'set 6th digit of counter value integer part',
56             'counter value set',
57             'set interval mode within 5 seconds',
58             'calibration mode within 5 seconds',
59             'set address mode within 5 seconds',
60             'identification packet',
61             ]->[$type];
62 2 100       10 unless ($type == 0) {
63 1         12 warn "Unsupported rfxmeter message $type_str\n",
64             "Hex: ", unpack("H*",$message), "\n";
65 1         15 return [];
66             }
67 1         3 my $count = ($bytes->[4]<<16) + ($bytes->[2]<<8) + ($bytes->[3]);
68             #print "rfxmeter: ", $count, "count\n";
69 1         3 push @{$result->{messages}},
  1         8  
70             Device::RFXCOM::Response::Sensor->new(device => 'rfxmeter.'.$device,
71             measurement => 'count',
72             value => $count);
73 1         8 return 1;
74             }
75              
76             1;
77              
78             __END__