File Coverage

blib/lib/RPi/ADC/ADS.pm
Criterion Covered Total %
statement 90 124 72.5
branch 33 50 66.0
condition 0 9 0.0
subroutine 15 19 78.9
pod 9 9 100.0
total 147 211 69.6


line stmt bran cond sub pod time code
1             package RPi::ADC::ADS;
2              
3 16     16   35714 use strict;
  16         35  
  16         387  
4 16     16   77 use warnings;
  16         30  
  16         1115  
5              
6             our $VERSION = '1.02';
7              
8             require XSLoader;
9             XSLoader::load('RPi::ADC::ADS', $VERSION);
10              
11             use constant {
12              
13 16         4069 DEFAULT_QUEUE => 0x03, # bits 1-0 (0-3)
14             MAX_QUEUE => 0x03,
15              
16             DEFAULT_POLARITY => 0x00, # bit 3
17             MAX_POLARITY => 0x08,
18              
19             DEFAULT_RATE => 0x00, # bits 7-5
20             MAX_RATE => 0xE0,
21              
22             DEFAULT_MODE => 0x100, # bit 8
23             MAX_MODE => 0x100,
24              
25             DEFAULT_GAIN => 0x200, # bits 11-9
26             MAX_GAIN => 0xE00,
27              
28             DEFAULT_CHANNEL => 0x4000, # bits 14-12
29             MAX_CHANNEL => 0x7000,
30 16     16   89 };
  16         32  
31              
32             # channel multiplexer
33              
34             my %mux = (
35             # bit 14-12 (most significant bit shown)
36              
37             # single-ended
38             0 => 0x4000, # 01000000, 16384
39             1 => 0x5000, # 01010000, 20480
40             2 => 0x6000, # 01100000, 24576
41             3 => 0x7000, # 01110000, 28672
42              
43             # differential
44             4 => 0x0, # 00000000, 0
45             5 => 0x1000, # 00100000, 4096
46             6 => 0x2000, # 00100000, 8192
47             7 => 0x3000, # 00110000, 12288
48             );
49              
50             # comparitor queue
51              
52             my %queue = (
53             # bit 1-0 (least significant bit shown)
54              
55             0 => 0x00, # 00000000, 0
56             1 => 0x01, # 00000001, 1
57             2 => 0x02, # 00000010, 2
58             3 => 0x03, # 00000011, 3
59             );
60              
61             # comparator polarity
62              
63             my %polarity = (
64             # bit 3 (least significant bit shown)
65              
66             0 => 0x00, # 00000000, 0
67             1 => 0x08, # 00000001, 8
68             );
69              
70             # data rate
71              
72             my %rate = (
73             # bit 7-5 (least significant bit shown)
74              
75             0 => 0x00, # 00000000, 0
76             1 => 0x20, # 00100000, 32
77             2 => 0x40, # 01000000, 64
78             3 => 0x60, # 01100000, 96
79             4 => 0x80, # 10000000, 128
80             5 => 0xA0, # 10100000, 160
81             6 => 0xC0, # 00000001, 192
82             7 => 0xE0, # 00000001, 224
83             );
84              
85             # operating mode
86              
87             my %mode = (
88             # bit 8 (both bits shown)
89              
90             0 => 0x00, # 0|00000000, 0
91             1 => 0x100, # 1|00000000, 256
92             );
93              
94             # amplifier gain
95              
96             my %gain = (
97             # bit 11-9 (most significant bit shown)
98              
99             0 => 0x00, # 00000000, 0
100             1 => 0x200, # 00000010, 512
101             2 => 0x400, # 00000100, 1024
102             3 => 0x600, # 00000110, 1536
103             4 => 0x800, # 00001000, 2048
104             5 => 0xA00, # 00001010, 2560
105             6 => 0xC00, # 00001100, 3072
106             7 => 0xE00, # 00001110, 3584
107             );
108              
109             # map of all the above config register maps
110              
111             my $param_map;
112              
113             BEGIN {
114              
115 16     16   106 $param_map = {
116             channel => \%mux,
117             queue => \%queue,
118             polarity => \%polarity,
119             rate => \%rate,
120             mode => \%mode,
121             gain => \%gain,
122             };
123              
124 16     16   104 no strict 'refs';
  16         30  
  16         2367  
125              
126 16         72 for my $sub (keys %$param_map) {
127              
128             *$sub = sub {
129              
130 191     191   36810 my ($self, $opt) = @_;
131              
132 191 100       498 if (defined $opt) {
133 42 100       152 if (! exists $param_map->{$sub}{$opt}) {
134 5         48 die "$sub param requires an integer\n";
135             }
136 37         85 $self->{$sub} = $param_map->{$sub}{$opt};
137             }
138              
139 186         471 my $default = "DEFAULT_" . uc $sub;
140 186         349 my $max = "MAX_" . uc $sub;
141              
142 186 100       793 $self->{$sub} = __PACKAGE__->$default if ! defined $self->{$sub};
143 186         726 $self->_bit_set($self->{$sub}, __PACKAGE__->$max);
144 186         406 return $self->{$sub};
145             }
146 96         15738 }
147             }
148              
149             # object methods (public)
150              
151             sub new {
152 30     30 1 18615 my ($class, %args) = @_;
153              
154 30         79 my $self = bless {}, $class;
155              
156             # set up the initial default config register
157              
158 30         95 $self->register(0x80, 0x00);
159              
160             # primary C args
161              
162 30         129 $self->model($args{model});
163 30         115 $self->addr($args{addr});
164 30         105 $self->device($args{device});
165              
166             # control register switches
167              
168 30         103 $self->channel($args{channel});
169 30         140 $self->queue($args{queue});
170 30         171 $self->polarity($args{polarity});
171 30         139 $self->mode($args{mode});
172 30         127 $self->gain($args{mode});
173              
174 30         122 return $self;
175             }
176             sub addr {
177 42     42 1 2311 my ($self, $addr) = @_;
178              
179 42 100       104 if (defined $addr){
180 8 100       15 if (! grep {$addr eq $_} qw(72 73 74 75)){
  32         65  
181 3         16 die "invalid address. " .
182             "Use 0x48 (72), 0x49 (73), 0x4A (74) or 0x4B (75)\n";
183             }
184 5         11 $self->{addr} = $addr;
185             }
186              
187 39 100       107 $self->{addr} = 0x48 if ! defined $self->{addr};
188              
189 39         74 return $self->{addr};
190             }
191             sub device {
192 56     56 1 5797 my ($self, $dev) = @_;
193              
194 56 100       147 if (defined $dev){
195 16 100       61 if ($dev !~ m|/dev/i2c-\d|){
196 5         30 die "invalid device name: $dev. " .
197             "Must be /dev/i2c-N, where N is 0-9\n";
198             }
199 11         23 $self->{device} = $dev;
200             }
201              
202 51 100       146 $self->{device} = '/dev/i2c-1' if ! defined $self->{device};
203              
204 51         109 return $self->{device};
205             }
206             sub model {
207 54     54 1 11865 my ($self, $model) = @_;
208              
209 54 100       171 if (defined $model){
210 24 100       99 if ($model !~ /^ADS1[01]1[3458]/){
211 7         43 die "invalid model name: $model. " .
212             "Must be 'ADS1x1y' where x is 1 or 0, and y is 3, 4, 5 or 8\n";
213             }
214 17         34 $self->{model} = $model
215             }
216              
217 47 100       146 $self->{model} = 'ADS1015' if ! defined $self->{model};
218              
219 47         257 my ($model_num) = $self->{model} =~ /(\d+)/;
220              
221 47         142 $self->_resolution($model_num);
222              
223 47         96 return $self->{model};
224             }
225              
226             # operational methods (public)
227              
228             sub bits {
229 228     228 1 427 my $self = shift;
230              
231 228         437 my @bytes = $self->register;
232              
233 228         475 my $bits = ($bytes[0] << 8) | $bytes[1];
234              
235 228         530 return $bits;
236             }
237             sub register {
238 483     483 1 3231 my ($self, $msb, $lsb) = @_;
239              
240             # config register
241              
242 483 100       1080 if (defined $msb){
243 216 50       471 if (! defined $lsb){
244 0         0 die "register() requires \$msb and \$lsb params\n";
245             }
246 216 50       504 if (! grep {$msb == $_} (0..255)){
  55296         86962  
247 0         0 die "msg param requires an int 0..255\n";
248             }
249 216 50       1331 if (! grep {$lsb == $_} (0..255)){
  55296         85692  
250 0         0 die "lsb param requires an int 0..255\n";
251             }
252              
253 216         1397 $self->{register_data} = [$msb, $lsb];
254             }
255              
256 483         733 return @{ $self->{register_data} };
  483         1148  
257             }
258              
259             # private methods
260              
261             sub _bit_set {
262             # unset and set config register bits
263              
264 186     186   337 my ($self, $value, $max) = @_;
265              
266 186         379 my $bits = $self->bits;
267              
268             # unset
269 186         332 $bits &= ~$max;
270              
271             # set
272 186         283 $bits |= $value;
273              
274 186         286 my $lsb = $bits & 0xFF;
275 186         300 my $msb = $bits >> 8;
276              
277 186         376 $self->register($msb, $lsb);
278             }
279             sub _register_data {
280              
281             # for testing/validation purposes
282              
283 6     6   49 my $tables = {
284             mux => \%mux,
285             queue => \%queue,
286             polarity => \%polarity,
287             rate => \%rate,
288             mode => \%mode,
289             gain => \%gain,
290             };
291              
292 6         19 return $tables;
293             }
294             sub _resolution {
295             # decides/sets resolution to 12 or 16 bits
296              
297 56     56   129 my ($self, $model) = @_;
298              
299 56 100       125 if (defined $model){
300 47 100       148 if ($model =~ /11\d{2}/){
301 9         18 $self->{resolution} = 16;
302             }
303             else {
304 38         75 $self->{resolution} = 12;
305             }
306             }
307 56         111 return $self->{resolution};
308             }
309              
310             # device methods
311              
312             sub volts {
313 0     0 1   my ($self, $channel) = @_;
314              
315 0 0         if (defined $channel){
316 0           $self->channel($channel);
317             }
318              
319 0           my $addr = $self->addr;
320 0           my $dev = $self->device;
321 0           my @write_buf = $self->register;
322              
323 0           my $v = voltage_c(
324             $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution
325             );
326              
327 0 0 0       if ($self->channel > 3 && $v < 0){
328 0           return 0;
329             }
330              
331 0           return $v;
332             }
333             sub raw {
334 0     0 1   my ($self, $channel) = @_;
335              
336 0 0         if (defined $channel){
337 0           $self->channel($channel);
338             }
339              
340 0           my $addr = $self->addr;
341 0           my $dev = $self->device;
342 0           my @write_buf = $self->register;
343              
344 0           my $r = raw_c($addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution);
345              
346 0 0 0       if ($self->channel > 3 && $r < 0){
347 0           return 0;
348             }
349              
350 0           return $r;
351              
352             }
353             sub percent {
354 0     0 1   my ($self, $channel) = @_;
355              
356 0 0         if (defined $channel){
357 0           $self->channel($channel);
358             }
359              
360 0           my $addr = $self->addr;
361 0           my $dev = $self->device;
362 0           my @write_buf = $self->register;
363              
364 0           my $percent = percent_c(
365             $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution
366             );
367              
368 0 0         $percent = 100 if $percent > 100;
369            
370 0 0 0       if ($self->channel > 3 && $percent < 0){
371 0           return 0;
372             }
373              
374 0           return sprintf("%.2f", $percent);
375             }
376              
377       0     sub _vim {}
378              
379             1;
380              
381             __END__