File Coverage

blib/lib/Device/Chip/HTU21D.pm
Criterion Covered Total %
statement 87 87 100.0
branch 4 6 66.6
condition 4 6 66.6
subroutine 20 20 100.0
pod 4 5 80.0
total 119 124 95.9


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016-2021 -- leonerd@leonerd.org.uk
5              
6 4     4   305057 use v5.26;
  4         45  
7 4     4   519 use Object::Pad 0.57;
  4         8778  
  4         16  
8              
9             package Device::Chip::HTU21D 0.08;
10             class Device::Chip::HTU21D
11 1     1   509 :isa(Device::Chip);
  1         22127  
  1         35  
12              
13 4     4   1453 use utf8;
  4         18  
  4         23  
14              
15 4     4   141 use Carp;
  4         6  
  4         245  
16              
17 4     4   1628 use Data::Bitfield 0.02 qw( bitfield boolfield );
  4         7620  
  4         251  
18 4     4   26 use List::Util qw( first );
  4         7  
  4         244  
19              
20 4     4   26 use Future::AsyncAwait 0.38; # async method
  4         46  
  4         17  
21 4     4   1731 use Future::Mutex;
  4         1758  
  4         158  
22              
23 4     4   1622 use Device::Chip::Sensor -declare;
  4         7342  
  4         19  
24              
25 4     4   406 use constant PROTOCOL => "I2C";
  4         8  
  4         462  
26              
27             =encoding UTF-8
28              
29             =head1 NAME
30              
31             C - chip driver for F
32              
33             =head1 SYNOPSIS
34              
35             use Device::Chip::HTU21D;
36             use Future::AsyncAwait;
37              
38             my $chip = Device::Chip::HTU21D->new;
39             await $chip->mount( Device::Chip::Adapter::...->new );
40              
41             printf "Current temperature is is %.2f C\n",
42             await $chip->read_temperature;
43              
44             =head1 DESCRIPTION
45              
46             This L subclass provides specific communication to a
47             F F attached to a computer via an I²C adapter.
48              
49             The reader is presumed to be familiar with the general operation of this chip;
50             the documentation here will not attempt to explain or define chip-specific
51             concepts or features, only the use of this module to access them.
52              
53             =cut
54              
55             sub I2C_options
56             {
57 3     3 0 876 my $self = shift;
58              
59             return (
60 3         14 addr => 0x40,
61             max_bitrate => 400E3,
62             );
63             }
64              
65             =head1 ACCESSORS
66              
67             The following methods documented in an C expression return L
68             instances.
69              
70             =cut
71              
72             use constant {
73             # First-byte commands
74 4         5429 CMD_TRIGGER_TEMP_HOLD => 0xE3,
75             CMD_TRIGGER_HUMID_HOLD => 0xE5,
76             CMD_TRIGGER_TEMP_NOHOLD => 0xF3,
77             CMD_TRIGGER_HUMID_NOHOLD => 0xF5,
78             CMD_WRITE_REG => 0xE6,
79             CMD_READ_REG => 0xE7,
80             CMD_SOFT_RESET => 0xFE,
81 4     4   23 };
  4         7  
82              
83             bitfield { format => "bytes-LE" }, REG_USER =>
84             RES0 => boolfield( 0 ),
85             OTPDISABLE => boolfield( 1 ),
86             HEATER => boolfield( 2 ),
87             ENDOFBATT => boolfield( 6 ),
88             RES1 => boolfield( 7 );
89              
90             =head2 read_config
91              
92             $config = await $chip->read_config;
93              
94             Returns a C reference of the contents of the user register.
95              
96             RES => "12/14" | "11/11" | "10/13" | "8/12"
97             OTPDISABLE => 0 | 1
98             HEATER => 0 | 1
99             ENDOFBATT => 0 | 1
100              
101             =head2 change_config
102              
103             await $chip->change_config( %changes );
104              
105             Writes updates to the user register.
106              
107             =cut
108              
109             my @RES_VALUES = ( "12/14", "8/12", "10/13", "11/11" );
110              
111 3         4 async method read_config ()
  3         3  
112 3         6 {
113 3         8 my %config = unpack_REG_USER(
114             await $self->protocol->write_then_read( pack( "C", CMD_READ_REG ), 1 )
115             );
116              
117 3         9721 my $res = ( delete $config{RES0} ) | ( delete $config{RES1} ) << 1;
118 3         6 $config{RES} = $RES_VALUES[$res];
119              
120 3         13 return \%config;
121 3     3 1 193 }
122              
123 2         3 async method change_config ( %changes )
  2         4  
  2         3  
124 2         5 {
125 2         5 my $config = await $self->read_config;
126              
127 2         105 $config->{$_} = $changes{$_} for keys %changes;
128              
129 2         5 my $res = delete $config->{RES};
130              
131 3     3   6 $res = first { $RES_VALUES[$_] eq $res } 0 .. 3;
  2         10  
132 2 50       9 defined $res or
133             croak "Unrecognised new value for RES - '$changes{RES}'";
134              
135 2         9 my $val = pack_REG_USER(
136             RES0 => $res & ( 1<<0 ),
137             RES1 => $res & ( 1<<1 ),
138             %$config,
139             );
140              
141 2         183 await $self->protocol->write( pack "C a", CMD_WRITE_REG, $val );
142 2     2 1 6259 }
143              
144             has $_mutex;
145              
146 7         10 async method _trigger_nohold ( $cmd )
  7         10  
  7         8  
147 7         11 {
148 7         18 my $protocol = $self->protocol;
149              
150 7   66     51 $_mutex //= Future::Mutex->new;
151              
152 7     7   587 return await $_mutex->enter( async sub {
153 7         16 await $self->protocol->write( pack "C", $cmd );
154              
155 7         18790 my $attempts = 10;
156 7         20 while( $attempts ) {
157 8         1003 my $f = $protocol->read( 2 );
158 8 50       7133 $attempts-- and $f = $f->else_done( undef );
159              
160 8         509 my $bytes = await $f;
161             # TODO: Is this a tinyUSSB bug? We're successfully reading two 0xFF
162             # bytes before it's ready
163 8 100 66     1159 defined $bytes and $bytes ne "\xFF\xFF" and
164             return unpack "S>", $bytes;
165              
166 1         4 await $protocol->sleep( 0.01 );
167             }
168 7         61 });
169 7     7   11 }
170              
171             =head1 METHODS
172              
173             =cut
174              
175             =head2 read_temperature
176              
177             $temperature = await $chip->read_temperature;
178              
179             Triggers a reading of the temperature sensor, returning a number in degrees C.
180              
181             =cut
182              
183             declare_sensor temperature =>
184             units => "°C",
185             precision => 2;
186              
187 4         6 async method read_temperature ()
  4         5  
188 4         12 {
189 4         11 my $val = await $self->_trigger_nohold( CMD_TRIGGER_TEMP_NOHOLD );
190              
191 4         1506 return -46.85 + 175.72 * ( $val / 2**16 );
192 4     4 1 8154 }
193              
194             =head2 read_humidity
195              
196             $humidity = await $chip->read_humidity;
197              
198             Triggers a reading of the humidity sensor, returning a number in % RH.
199              
200             =cut
201              
202             declare_sensor humidity =>
203             units => "%RH",
204             precision => 1;
205              
206 3         5 async method read_humidity ()
  3         4  
207 3         8 {
208 3         9 my $val = await $self->_trigger_nohold( CMD_TRIGGER_HUMID_NOHOLD );
209              
210 3         392 return -6 + 125 * ( $val / 2**16 );
211 3     3 1 8121 }
212              
213             =head1 AUTHOR
214              
215             Paul Evans
216              
217             =cut
218              
219             0x55AA;