File Coverage

blib/lib/Device/RFXCOM/Decoder/RFXSensor.pm
Criterion Covered Total %
statement 77 77 100.0
branch 28 28 100.0
condition 5 5 100.0
subroutine 10 10 100.0
pod 4 4 100.0
total 124 124 100.0


line stmt bran cond sub pod time code
1 4     4   2155 use strict;
  4         8  
  4         115  
2 4     4   14 use warnings;
  4         7  
  4         192  
3             package Device::RFXCOM::Decoder::RFXSensor;
4             $Device::RFXCOM::Decoder::RFXSensor::VERSION = '1.163170';
5             # ABSTRACT: Device::RFXCOM::Decoder::RFXSensor decode RFXSensor RF messages
6              
7              
8 4     4   74 use 5.006;
  4         11  
9 4     4   16 use constant DEBUG => $ENV{DEVICE_RFXCOM_DECODER_RFXSENSOR_DEBUG};
  4         8  
  4         253  
10 4     4   80 use Carp qw/croak/;
  4         6  
  4         208  
11 4     4   490 use Device::RFXCOM::Decoder qw/nibble_sum/;
  4         6  
  4         3532  
12             our @ISA = qw(Device::RFXCOM::Decoder);
13              
14             my %info =
15             (
16             0x01 => "sensor addresses incremented",
17             0x02 => "battery low detected",
18             0x03 => "conversion not ready",
19             );
20              
21             my %error =
22             (
23             0x81 => "no 1-wire device connected",
24             0x82 => "1-wire ROM CRC error",
25             0x83 => "1-wire device connected is not a DS18B20 or DS2438",
26             0x84 => "no end of read signal received from 1-wire device",
27             0x85 => "1-wire scratchpad CRC error",
28             0x86 => "temperature conversion not ready in time",
29             0x87 => "A/D conversion not ready in time",
30             );
31              
32             my %types = (
33             'RFX' => { fun => \&decode_init, len => 32 },
34             'RF2' => { fun => \&decode_init, len => 32 },
35             'RF3' => { fun => \&decode_init, len => 32 },
36             'SEN' => { fun => \&decode_sen, len => 40 },
37             );
38              
39              
40             sub new {
41 8     8 1 87 my $pkg = shift;
42 8         49 $pkg->SUPER::new(rfxsensor_cache => {}, @_);
43             }
44              
45              
46             sub decode {
47 55     55 1 101 my ($self, $parent, $message, $bytes, $bits, $result) = @_;
48 55         115 my $str = substr $message, 0, 3;
49 55 100 100     204 if (exists $types{$str} && $bits == $types{$str}->{len}) {
50 4         17 return $types{$str}->{fun}->($self, $parent,
51             $message, $bytes, $bits, $result, $str);
52             }
53 51 100       202 $bits == 32 or return;
54 21 100       108 (($bytes->[0]^0xf0) == $bytes->[1]) or return;
55 11         263 my @nib = map { hex $_ } split //, unpack "H*", $message;
  88         164  
56 11 100       77 ((nibble_sum(7, \@nib)&0xf)^0xf) == $nib[7] or return;
57 10         87 my $device = sprintf("rfxsensor%02x%02x", $bytes->[0], $bytes->[1]);
58 10         128 my $base = sprintf("%02x%02x", $bytes->[0]&0xfc, $bytes->[1]&0xfc);
59 10         18 my $cache = $self->{rfxsensor_cache};
60 10         26 my $supply_voltage = $cache->{$base}->{supply};
61 10         17 my $last_temp = $cache->{$base}->{temp};
62 10         21 my $flag = $bytes->[3]&0x10;
63 10 100       30 if ($flag) {
64 3 100       32 if (exists $info{$bytes->[2]}) {
    100          
65 1         13 warn "RFXSensor info $device: ".$info{$bytes->[2]}."\n";
66             } elsif (exists $error{$bytes->[2]}) {
67 1         15 warn "RFXSensor error $device: ".$error{$bytes->[2]}."\n";
68             } else {
69 1         16 warn sprintf "RFXSensor unknown status messages: %02x\n", $bytes->[2];
70             }
71 3         36 return;
72             }
73              
74 7         24 my $type = ($bytes->[0]&0x3);
75 7 100       44 if ($type == 0) {
    100          
    100          
76             # temp
77 2         11 my $temp = $bytes->[2] + (($bytes->[3]&0xe0)/0x100);
78 2 100       10 if ($temp > 150) {
79 1         6 $temp = -1*(256-$temp);
80             }
81 2         8 $cache->{$base}->{temp} = $temp;
82 2         5 push @{$result->{messages}},
  2         21  
83             Device::RFXCOM::Response::Sensor->new(device => $device,
84             measurement => 'temp',
85             value => $temp,
86             base_device => $base);
87 2         16 return 1;
88             } elsif ($type == 1) {
89 3         13 my $v = ( ($bytes->[2]<<3) + ($bytes->[3]>>5) ) / 100;
90 3         4 push @{$result->{messages}},
  3         47  
91             Device::RFXCOM::Response::Sensor->new(device => $device,
92             measurement => 'voltage',
93             value => $v,
94             base_device => $base);
95 3 100       14 unless (defined $supply_voltage) {
96 1         21 warn "Don't have supply voltage for $device/$base yet\n";
97 1         12 $result->{dont_cache} = 1;
98 1         8 return 1;
99             }
100             # See http://archives.sensorsmag.com/articles/0800/62/main.shtml
101 2         34 my $hum = sprintf "%.2f", (($v/$supply_voltage) - 0.16)/0.0062;
102             #print STDERR "Sensor Hum: $hum\n";
103 2 100       11 if (defined $last_temp) {
104             #print STDERR "Last temp: $last_temp\n";
105 1         14 $hum = sprintf "%.2f", $hum / (1.0546 - 0.00216*$last_temp);
106             #print STDERR "True Hum: $hum\n";
107             } else {
108 1         4 $result->{dont_cache} = 1;
109 1         15 warn "Don't have temperature for $device/$base yet - assuming 25'C\n";
110             }
111 2         11 push @{$result->{messages}},
  2         15  
112             Device::RFXCOM::Response::Sensor->new(device => $device,
113             measurement => 'humidity',
114             value => $hum,
115             base_device => $base);
116 2         17 return 1;
117             } elsif ($type == 2) {
118 1         5 my $v = ( ($bytes->[2]<<3) + ($bytes->[3]>>5) ) / 100;
119 1         4 $cache->{$base}->{supply} = $v;
120 1         4 push @{$result->{messages}},
  1         10  
121             Device::RFXCOM::Response::Sensor->new(device => $device,
122             measurement => 'voltage',
123             value => $v,
124             base_device => $base);
125 1         8 return 1;
126             }
127              
128 1         15 warn "Unsupported RFXSensor: type=$type\n";
129 1         14 return;
130             }
131              
132              
133             sub decode_init {
134 2     2 1 7 my ($self, $parent, $message, $bytes, $bits, $result, $type) = @_;
135              
136             warn sprintf "RFXSensor %s, version %02x, transmit mode %s, initialized\n",
137 2 100       138 { 0x58 => 'Type-1', 0x32 => 'Type-2', 0x33 => 'Type-3' }->{$bytes->[2]},
138             $bytes->[3]&0x7f, $bytes->[3]&0x80 ? 'slow' : 'fast';
139 2         26 return 1;
140             }
141              
142              
143             sub decode_sen {
144 2     2 1 6 my ($self, $parent, $message, $bytes, $bits, $result, $str) = @_;
145              
146             warn sprintf "RFXSensor SEN%d, type %02x (%s)\n", $bytes->[3], $bytes->[4],
147 2   100     57 { 0x26 => 'DS2438', 0x28 => 'DS18B20' }->{$bytes->[4]} || 'unknown';
148 2         25 return 1;
149             }
150              
151             1;
152              
153             __END__