File Coverage

blib/lib/RPi/ADC/ADS.pm
Criterion Covered Total %
statement 90 132 68.1
branch 33 52 63.4
condition n/a
subroutine 15 21 71.4
pod 9 9 100.0
total 147 214 68.6


line stmt bran cond sub pod time code
1             package RPi::ADC::ADS;
2              
3 16     16   38013 use strict;
  16         20  
  16         353  
4 16     16   52 use warnings;
  16         14  
  16         1102  
5              
6             our $VERSION = '1.00';
7              
8             require XSLoader;
9             XSLoader::load('RPi::ADC::ADS', $VERSION);
10              
11             use constant {
12              
13 16         3731 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   55 };
  16         22  
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             BEGIN {
110              
111 16     16   99 my $param_map = {
112             channel => \%mux,
113             queue => \%queue,
114             polarity => \%polarity,
115             rate => \%rate,
116             mode => \%mode,
117             gain => \%gain,
118             };
119              
120 16     16   62 no strict 'refs';
  16         15  
  16         2296  
121              
122 16         54 for my $sub (keys %$param_map) {
123              
124             *$sub = sub {
125              
126 191     191   24177 my ($self, $opt) = @_;
127              
128 191 100       290 if (defined $opt) {
129 42 100       109 if (!exists $param_map->{$sub}{$opt}) {
130 5         31 die "$sub param requires an integer\n";
131             }
132 37         51 $self->{$sub} = $param_map->{$sub}{$opt};
133             }
134              
135 186         283 my $default = "DEFAULT_" . uc $sub;
136 186         187 my $max = "MAX_" . uc $sub;
137              
138 186 100       558 $self->{$sub} = __PACKAGE__->$default if !defined $self->{$sub};
139 186         413 $self->_bit_set($self->{$sub}, __PACKAGE__->$max);
140 186         180 return $self->{$sub};
141             }
142 96         17540 }
143             }
144              
145             # object methods (public)
146              
147             sub new {
148 30     30 1 16423 my ($class, %args) = @_;
149              
150 30         60 my $self = bless {}, $class;
151              
152             # set up the initial default config register
153              
154 30         71 $self->register(0x80, 0x00);
155              
156             # primary C args
157              
158 30         96 $self->model($args{model});
159 30         95 $self->addr($args{addr});
160 30         86 $self->device($args{device});
161              
162             # control register switches
163              
164 30         79 $self->channel($args{channel});
165 30         84 $self->queue($args{queue});
166 30         105 $self->polarity($args{polarity});
167 30         87 $self->mode($args{mode});
168 30         77 $self->gain($args{mode});
169              
170 30         74 return $self;
171             }
172             sub addr {
173 42     42 1 1452 my ($self, $addr) = @_;
174              
175 42 100       79 if (defined $addr){
176 8 100       10 if (! grep {$addr eq $_} qw(72 73 74 75)){
  32         42  
177 3         13 die "invalid address. " .
178             "Use 0x48 (72), 0x49 (73), 0x4A (74) or 0x4B (75)\n";
179             }
180 5         7 $self->{addr} = $addr;
181             }
182              
183 39 100       100 $self->{addr} = 0x48 if ! defined $self->{addr};
184              
185 39         72 return $self->{addr};
186             }
187             sub device {
188 56     56 1 4801 my ($self, $dev) = @_;
189              
190 56 100       99 if (defined $dev){
191 16 100       55 if ($dev !~ m|/dev/i2c-\d|){
192 5         25 die "invalid device name: $dev. " .
193             "Must be /dev/i2c-N, where N is 0-9\n";
194             }
195 11         17 $self->{device} = $dev;
196             }
197              
198 51 100       248 $self->{device} = '/dev/i2c-1' if ! defined $self->{device};
199              
200 51         78 return $self->{device};
201             }
202             sub model {
203 54     54 1 8658 my ($self, $model) = @_;
204              
205 54 100       105 if (defined $model){
206 24 100       86 if ($model !~ /^ADS1[01]1[3458]/){
207 7         37 die "invalid model name: $model. " .
208             "Must be 'ADS1x1y' where x is 1 or 0, and y is 3, 4, 5 or 8\n";
209             }
210 17         20 $self->{model} = $model
211             }
212              
213 47 100       109 $self->{model} = 'ADS1015' if ! defined $self->{model};
214              
215 47         172 my ($model_num) = $self->{model} =~ /(\d+)/;
216              
217 47         98 $self->_resolution($model_num);
218              
219 47         58 return $self->{model};
220             }
221              
222             # operational methods (public)
223              
224             sub bits {
225 228     228 1 257 my $self = shift;
226              
227 228         220 my @bytes = $self->register;
228              
229 228         246 my $bits = ($bytes[0] << 8) | $bytes[1];
230              
231 228         305 return $bits;
232             }
233             sub register {
234 483     483 1 2349 my ($self, $msb, $lsb) = @_;
235              
236             # config register
237              
238 483 100       624 if (defined $msb){
239 216 50       265 if (! defined $lsb){
240 0         0 die "register() requires \$msb and \$lsb params\n";
241             }
242 216 50       304 if (! grep {$msb == $_} (0..255)){
  55296         39675  
243 0         0 die "msg param requires an int 0..255\n";
244             }
245 216 50       1004 if (! grep {$lsb == $_} (0..255)){
  55296         39788  
246 0         0 die "lsb param requires an int 0..255\n";
247             }
248              
249 216         1065 $self->{register_data} = [$msb, $lsb];
250             }
251              
252 483         340 return @{ $self->{register_data} };
  483         691  
253             }
254              
255             # private methods
256              
257             sub _bit_set {
258             # unset and set config register bits
259              
260 186     186   155 my ($self, $value, $max) = @_;
261              
262 186         212 my $bits = $self->bits;
263              
264             # unset
265 186         163 $bits &= ~$max;
266              
267             # set
268 186         137 $bits |= $value;
269              
270 186         122 my $lsb = $bits & 0xFF;
271 186         137 my $msb = $bits >> 8;
272              
273 186         191 $self->register($msb, $lsb);
274             }
275             sub _lsb {
276             # least significant byte of config register
277              
278 0     0   0 my ($self, $lsb) = @_;
279              
280 0 0       0 if (defined $lsb){
281 0 0       0 if (! grep {$lsb == $_} (0..255)){
  0         0  
282 0         0 die "_lsb() requires an int 0..255\n";
283             }
284 0         0 my $msb = $self->register->[0];
285 0         0 $self->register($msb, $lsb);
286             }
287 0         0 return $self->register->[1];
288             }
289             sub _msb {
290             # most significant byte of config register
291              
292 0     0   0 my ($self, $msb) = @_;
293              
294 0 0       0 if (defined $msb){
295 0 0       0 if (! grep {$msb == $_} (0..255)){
  0         0  
296 0         0 die "_msb() requires an int 0..255\n";
297             }
298 0         0 my $lsb = $self->register->[1];
299 0         0 $self->register($msb, $lsb);
300             }
301 0         0 return $self->register->[0];
302             }
303             sub _register_data {
304              
305             # for testing/validation purposes
306              
307 6     6   33 my $tables = {
308             mux => \%mux,
309             queue => \%queue,
310             polarity => \%polarity,
311             rate => \%rate,
312             mode => \%mode,
313             gain => \%gain,
314             };
315              
316 6         12 return $tables;
317             }
318             sub _resolution {
319             # decides/sets resolution to 12 or 16 bits
320              
321 56     56   70 my ($self, $model) = @_;
322              
323 56 100       109 if (defined $model){
324 47 100       106 if ($model =~ /11\d{2}/){
325 9         12 $self->{resolution} = 16;
326             }
327             else {
328 38         54 $self->{resolution} = 12;
329             }
330             }
331 56         81 return $self->{resolution};
332             }
333              
334             # device methods
335              
336             sub volts {
337 0     0 1   my ($self, $channel) = @_;
338              
339 0 0         if (defined $channel){
340 0           $self->channel($channel);
341             }
342              
343 0           my $addr = $self->addr;
344 0           my $dev = $self->device;
345 0           my @write_buf = $self->register;
346              
347 0           return voltage_c(
348             $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution
349             );
350             }
351             sub raw {
352 0     0 1   my ($self, $channel) = @_;
353              
354 0 0         if (defined $channel){
355 0           $self->channel($channel);
356             }
357              
358 0           my $addr = $self->addr;
359 0           my $dev = $self->device;
360 0           my @write_buf = $self->register;
361              
362 0           return raw_c($addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution);
363             }
364             sub percent {
365 0     0 1   my ($self, $channel) = @_;
366              
367 0 0         if (defined $channel){
368 0           $self->channel($channel);
369             }
370              
371 0           my $addr = $self->addr;
372 0           my $dev = $self->device;
373 0           my @write_buf = $self->register;
374              
375 0           my $percent = percent_c(
376             $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution
377             );
378              
379 0 0         $percent = 100 if $percent > 100;
380            
381 0           return sprintf("%.2f", $percent);
382             }
383              
384       0     sub _vim {}
385              
386             1;
387              
388             __END__