File Coverage

blib/lib/HiPi/Interface/TMP102.pm
Criterion Covered Total %
statement 21 159 13.2
branch 0 66 0.0
condition 0 12 0.0
subroutine 7 24 29.1
pod 0 14 0.0
total 28 275 10.1


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::TMP102
3             # Description : Interface to TMP102 temperature sensor
4             # Copyright : Copyright (c) 2013-2017 Mark Dootson
5             # License : This is free software; you can redistribute it and/or modify it under
6             # the same terms as the Perl 5 programming language system itself.
7             #########################################################################################
8              
9             package HiPi::Interface::TMP102;
10              
11             #########################################################################################
12              
13 1     1   1027 use strict;
  1         2  
  1         31  
14 1     1   6 use warnings;
  1         2  
  1         28  
15 1     1   5 use parent qw( HiPi::Interface );
  1         2  
  1         5  
16 1     1   60 use HiPi qw( :i2c :rpi :tmp102 );
  1         2  
  1         381  
17 1     1   9 use HiPi::RaspberryPi;
  1         2  
  1         7  
18 1     1   35 use Carp;
  1         7  
  1         128  
19              
20             our $VERSION ='0.81';
21              
22             __PACKAGE__->create_accessors( qw( backend config_bytes ) );
23              
24             use constant {
25 1         2034 REGISTER_TEMPERATURE => 0x00,
26             REGISTER_CONFIG => 0x01,
27             REGISTER_T_LOW => 0x02,
28             REGISTER_T_HIGH => 0x03,
29            
30             EXTENTED_MODE_BIT => 0x10,
31             ALERT_BIT => 0x20,
32             CR0_BIT => 0x40,
33             CR1_BIT => 0x80,
34            
35             SD_BIT => 0x01,
36             TM_BIT => 0x02,
37             POL_BIT => 0x04,
38             F0_BIT => 0x08,
39             F1_BIT => 0x10,
40             R0_BIT => 0x20,
41             R1_BIT => 0x40,
42             OS_BIT => 0x80,
43 1     1   8 };
  1         2  
44              
45             sub new {
46 0     0 0   my ($class, %userparams) = @_;
47 0           my $pi = HiPi::RaspberryPi->new();
48            
49 0 0         my %params = (
50             devicename => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
51             address => 0x48,
52             device => undef,
53             backend => 'smbus',
54             );
55            
56             # get user params
57 0           foreach my $key( keys (%userparams) ) {
58 0           $params{$key} = $userparams{$key};
59             }
60            
61 0 0         if( $params{busmode} ) {
62 0           $params{backend} = $params{busmode};
63             }
64            
65 0 0         unless( defined($params{device}) ) {
66 0 0         if ( $params{backend} eq 'bcm2835' ) {
67 0           require HiPi::BCM2835::I2C;
68             $params{device} = HiPi::BCM2835::I2C->new(
69             address => $params{address},
70 0 0         peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(),
71             );
72             } else {
73 0           require HiPi::Device::I2C;
74             $params{device} = HiPi::Device::I2C->new(
75             devicename => $params{devicename},
76             address => $params{address},
77             busmode => $params{backend},
78 0           );
79             }
80             }
81            
82 0           my $self = $class->SUPER::new(%params);
83            
84 0           $self->_init;
85            
86 0           return $self;
87             }
88              
89             sub _init {
90 0     0     my $self = shift;
91 0           my @cnf = $self->device->bus_read( REGISTER_CONFIG, 2 );
92 0           $self->config_bytes( \@cnf );
93             }
94              
95             sub read_config {
96 0     0 0   my $self = shift;
97 0           my @cnf = $self->device->bus_read( REGISTER_CONFIG, 2 );
98 0           return @cnf;
99             }
100              
101             sub shutdown_mode {
102 0     0 0   my ($self, $newmode) = @_;
103 0           my @cnf = $self->read_config;
104 0 0         if(defined( $newmode )) {
105 0 0         $newmode = ( $newmode ) ? 1 : 0;
106 0           my $mask = SD_BIT;
107 0           my $val = $newmode ;
108 0           $cnf[0] = ($cnf[0] & ~$mask) | $val;
109 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
110             }
111 0           $self->config_bytes( \@cnf );
112 0 0         return ( $cnf[0] & SD_BIT ) ? 1 : 0 ;
113             }
114              
115             sub thermostat_mode {
116 0     0 0   my ($self, $newmode) = @_;
117 0           my @cnf = $self->read_config;
118 0 0         if(defined( $newmode )) {
119 0 0         $newmode = ( $newmode ) ? 1 : 0;
120 0           my $mask = TM_BIT;
121 0           my $val = $newmode << 1 ;
122 0           $cnf[0] = ($cnf[0] & ~$mask) | $val;
123 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
124             }
125 0           $self->config_bytes( \@cnf );
126 0 0         return ( $cnf[0] & TM_BIT ) ? 1 : 0 ;
127             }
128              
129             sub polarity {
130 0     0 0   my ($self, $newpol) = @_;
131 0           my @cnf = $self->read_config;
132 0 0         if(defined( $newpol )) {
133 0 0         $newpol = ( $newpol ) ? 1 : 0;
134 0           my $mask = POL_BIT;
135 0           my $val = $newpol << 2;
136 0           $cnf[0] = ($cnf[0] & ~$mask) | $val;
137 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
138             }
139 0           $self->config_bytes( \@cnf );
140 0 0         return ( $cnf[0] & POL_BIT ) ? 1 : 0 ;
141             }
142              
143             sub fault_queue {
144 0     0 0   my( $self, $newrate ) = @_;
145 0           my @cnf = $self->read_config;
146            
147 0           my $mask = F1_BIT | F0_BIT;
148            
149 0 0 0       if( defined( $newrate ) && $newrate >= 0 && $newrate <= 3) {
      0        
150            
151 0           my $val = $newrate << 3;
152 0           $cnf[0] = ($cnf[0] & ~$mask) | $val;
153 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
154             }
155 0           $self->config_bytes( \@cnf );
156 0           return ( $cnf[0] & $mask ) >> 3;
157             }
158              
159             # Pointless = always 0b11 / 3
160             #sub conversion_resolution {
161             # my( $self ) = @_;
162             # my @cnf = $self->read_config;
163             #
164             # my $mask = R1_BIT | R0_BIT;
165             #
166             # return ( $cnf[0] & $mask ) >> 5;
167             #}
168              
169             sub one_shot {
170 0     0 0   my ($self, $newmode) = @_;
171 0           my @cnf = $self->read_config;
172 0 0         if( $newmode ) { # for this, new mode must be 1
173 0           $newmode = 1;
174 0           my $mask = OS_BIT;
175 0           my $val = $newmode << 7;
176 0           $cnf[0] = ($cnf[0] & ~$mask) | $val;
177 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
178             }
179 0           $self->config_bytes( \@cnf );
180 0 0         return ( $cnf[0] & OS_BIT ) ? 1 : 0 ;
181             }
182              
183             sub extended_mode {
184 0     0 0   my ($self, $newmode) = @_;
185 0           my @cnf = $self->read_config;
186 0 0         if(defined( $newmode )) {
187 0 0         $newmode = ( $newmode ) ? 1 : 0;
188 0           my $mask = EXTENTED_MODE_BIT;
189 0           my $val = $newmode << 4;
190 0           $cnf[1] = ($cnf[1] & ~$mask) | $val;
191 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
192            
193             # we've changed the mode - we need to wait
194             # for a conversion to happen at the new bit rate
195             # get the current conv rate
196            
197 0           my $rate = ( $cnf[1] & ( CR1_BIT | CR0_BIT ) ) >> 6;
198 0           my $delay_ms = 250;
199 0 0         if( $rate == TMP102_CR_0_25HZ ) {
    0          
    0          
    0          
200 0           $delay_ms = 4000;
201             } elsif( $rate == TMP102_CR_1HZ ) {
202 0           $delay_ms = 1000;
203             } elsif( $rate == TMP102_CR_4HZ ) {
204 0           $delay_ms = 250;
205             } elsif( $rate == TMP102_CR_4HZ ) {
206 0           $delay_ms = 125;
207             } else {
208 0           warn q(using default delay - current conversion rate returns bad value);
209             }
210            
211 0           $self->delay( $delay_ms );
212            
213             }
214 0           $self->config_bytes( \@cnf );
215 0 0         return ( $cnf[1] & EXTENTED_MODE_BIT ) ? 1 : 0 ;
216             }
217              
218             sub alert {
219 0     0 0   my ($self) = @_;
220 0           my @cnf = $self->read_config;
221 0           $self->config_bytes( \@cnf );
222 0 0         return ( $cnf[1] & ALERT_BIT ) ? 1 : 0 ;
223             }
224              
225             sub conversion_rate {
226 0     0 0   my( $self, $newrate ) = @_;
227 0           my @cnf = $self->read_config;
228            
229 0           my $mask = CR1_BIT | CR0_BIT;
230            
231 0 0 0       if( defined( $newrate ) && $newrate >= 0 && $newrate <= 3) {
      0        
232            
233 0           my $val = $newrate << 6;
234 0           $cnf[1] = ($cnf[1] & ~$mask) | $val;
235 0           $self->device->bus_write( REGISTER_CONFIG, @cnf );
236             }
237 0           $self->config_bytes( \@cnf );
238 0           return ( $cnf[1] & $mask ) >> 6;
239             }
240              
241             sub _read_temperature_value {
242 0     0     my($self, $register) = @_;
243 0           my @bytes = $self->device->bus_read( $register, 2 );
244            
245 0 0         my $shiftbits = ( $self->config_bytes->[1] & EXTENTED_MODE_BIT ) ? 3 : 4;
246            
247 0           my $val = ($bytes[0] << 8 ) + $bytes[1];
248              
249 0 0         if( $bytes[0] & 0x80 ) { # is negative ?
250 0           $val = HiPi->twos_compliment( $val, 2 );
251 0           return - ( ( $val >> $shiftbits ) * 0.0625 );
252             } else {
253 0           return ( $val >> $shiftbits ) * 0.0625;
254             }
255             }
256              
257             sub _write_temperature_value {
258 0     0     my($self, $register, $newval ) = @_;
259            
260 0 0         my $shiftbits = ( $self->config_bytes->[1] & EXTENTED_MODE_BIT ) ? 3 : 4;
261 0           my $negative = ( $newval < 0 );
262 0           $newval = abs($newval);
263 0           $newval = int( 0.5 + ( $newval / 0.0625 ) );
264 0           $newval <<= $shiftbits;
265            
266             # limit range
267 0           my $limitmask = ( 0x7fff >> $shiftbits ) << $shiftbits;
268 0           $newval &= $limitmask;
269            
270 0 0         if( $negative ) {
271 0           $newval = HiPi->twos_compliment( $newval, 2 );
272             }
273            
274 0           $self->device->bus_write( $register, ( $newval >> 8 ) & 0xff, $newval & 0xff );
275             }
276              
277             sub read_temperature {
278 0     0 0   my $self = shift;
279 0           return $self->_read_temperature_value( REGISTER_TEMPERATURE );
280             }
281              
282             sub high_limit {
283 0     0 0   my ($self, $newlimit) = @_;
284 0 0         if(defined($newlimit)) {
285 0           $self->_write_temperature_value( REGISTER_T_HIGH, $newlimit );
286             }
287 0           return $self->_read_temperature_value( REGISTER_T_HIGH );
288             }
289              
290             sub low_limit {
291 0     0 0   my ($self, $newlimit) = @_;
292 0 0         if(defined($newlimit)) {
293 0           $self->_write_temperature_value( REGISTER_T_LOW, $newlimit );
294             }
295 0           return $self->_read_temperature_value( REGISTER_T_LOW );
296             }
297              
298             sub one_shot_temperature {
299 0     0 0   my $self = shift;
300            
301             # check if we are in shutdown_mode
302 0 0         if( $self->shutdown_mode ) {
303 0           $self->one_shot(1);
304 0           while(!$self->one_shot) {
305 0           $self->delay(30);
306             }
307             }
308            
309 0           return $self->read_temperature;
310             }
311              
312              
313              
314             1;
315              
316             __END__