File Coverage

blib/lib/RPi/ADC/ADS.pm
Criterion Covered Total %
statement 90 116 77.5
branch 33 44 75.0
condition n/a
subroutine 15 19 78.9
pod 9 9 100.0
total 147 188 78.1


line stmt bran cond sub pod time code
1             package RPi::ADC::ADS;
2              
3 16     16   34871 use strict;
  16         19  
  16         376  
4 16     16   49 use warnings;
  16         16  
  16         1093  
5              
6             our $VERSION = '1.01';
7              
8             require XSLoader;
9             XSLoader::load('RPi::ADC::ADS', $VERSION);
10              
11             use constant {
12              
13 16         3989 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   62 };
  16         21  
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   95 $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   66 no strict 'refs';
  16         19  
  16         2563  
125              
126 16         55 for my $sub (keys %$param_map) {
127              
128             *$sub = sub {
129              
130 191     191   23399 my ($self, $opt) = @_;
131              
132 191 100       297 if (defined $opt) {
133 42 100       99 if (! exists $param_map->{$sub}{$opt}) {
134 5         37 die "$sub param requires an integer\n";
135             }
136 37         56 $self->{$sub} = $param_map->{$sub}{$opt};
137             }
138              
139 186         312 my $default = "DEFAULT_" . uc $sub;
140 186         207 my $max = "MAX_" . uc $sub;
141              
142 186 100       602 $self->{$sub} = __PACKAGE__->$default if ! defined $self->{$sub};
143 186         485 $self->_bit_set($self->{$sub}, __PACKAGE__->$max);
144 186         297 return $self->{$sub};
145             }
146 96         16179 }
147             }
148              
149             # object methods (public)
150              
151             sub new {
152 30     30 1 18052 my ($class, %args) = @_;
153              
154 30         67 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         111 $self->model($args{model});
163 30         103 $self->addr($args{addr});
164 30         91 $self->device($args{device});
165              
166             # control register switches
167              
168 30         93 $self->channel($args{channel});
169 30         109 $self->queue($args{queue});
170 30         140 $self->polarity($args{polarity});
171 30         104 $self->mode($args{mode});
172 30         109 $self->gain($args{mode});
173              
174 30         95 return $self;
175             }
176             sub addr {
177 42     42 1 2226 my ($self, $addr) = @_;
178              
179 42 100       87 if (defined $addr){
180 8 100       13 if (! grep {$addr eq $_} qw(72 73 74 75)){
  32         42  
181 3         13 die "invalid address. " .
182             "Use 0x48 (72), 0x49 (73), 0x4A (74) or 0x4B (75)\n";
183             }
184 5         8 $self->{addr} = $addr;
185             }
186              
187 39 100       107 $self->{addr} = 0x48 if ! defined $self->{addr};
188              
189 39         66 return $self->{addr};
190             }
191             sub device {
192 56     56 1 5527 my ($self, $dev) = @_;
193              
194 56 100       309 if (defined $dev){
195 16 100       57 if ($dev !~ m|/dev/i2c-\d|){
196 5         27 die "invalid device name: $dev. " .
197             "Must be /dev/i2c-N, where N is 0-9\n";
198             }
199 11         16 $self->{device} = $dev;
200             }
201              
202 51 100       120 $self->{device} = '/dev/i2c-1' if ! defined $self->{device};
203              
204 51         83 return $self->{device};
205             }
206             sub model {
207 54     54 1 11736 my ($self, $model) = @_;
208              
209 54 100       139 if (defined $model){
210 24 100       102 if ($model !~ /^ADS1[01]1[3458]/){
211 7         48 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         26 $self->{model} = $model
215             }
216              
217 47 100       137 $self->{model} = 'ADS1015' if ! defined $self->{model};
218              
219 47         215 my ($model_num) = $self->{model} =~ /(\d+)/;
220              
221 47         109 $self->_resolution($model_num);
222              
223 47         69 return $self->{model};
224             }
225              
226             # operational methods (public)
227              
228             sub bits {
229 228     228 1 277 my $self = shift;
230              
231 228         264 my @bytes = $self->register;
232              
233 228         259 my $bits = ($bytes[0] << 8) | $bytes[1];
234              
235 228         333 return $bits;
236             }
237             sub register {
238 483     483 1 2046 my ($self, $msb, $lsb) = @_;
239              
240             # config register
241              
242 483 100       679 if (defined $msb){
243 216 50       293 if (! defined $lsb){
244 0         0 die "register() requires \$msb and \$lsb params\n";
245             }
246 216 50       330 if (! grep {$msb == $_} (0..255)){
  55296         41955  
247 0         0 die "msg param requires an int 0..255\n";
248             }
249 216 50       1093 if (! grep {$lsb == $_} (0..255)){
  55296         41342  
250 0         0 die "lsb param requires an int 0..255\n";
251             }
252              
253 216         1156 $self->{register_data} = [$msb, $lsb];
254             }
255              
256 483         357 return @{ $self->{register_data} };
  483         763  
257             }
258              
259             # private methods
260              
261             sub _bit_set {
262             # unset and set config register bits
263              
264 186     186   174 my ($self, $value, $max) = @_;
265              
266 186         227 my $bits = $self->bits;
267              
268             # unset
269 186         166 $bits &= ~$max;
270              
271             # set
272 186         135 $bits |= $value;
273              
274 186         135 my $lsb = $bits & 0xFF;
275 186         140 my $msb = $bits >> 8;
276              
277 186         204 $self->register($msb, $lsb);
278             }
279             sub _register_data {
280              
281             # for testing/validation purposes
282              
283 6     6   35 my $tables = {
284             mux => \%mux,
285             queue => \%queue,
286             polarity => \%polarity,
287             rate => \%rate,
288             mode => \%mode,
289             gain => \%gain,
290             };
291              
292 6         13 return $tables;
293             }
294             sub _resolution {
295             # decides/sets resolution to 12 or 16 bits
296              
297 56     56   88 my ($self, $model) = @_;
298              
299 56 100       104 if (defined $model){
300 47 100       132 if ($model =~ /11\d{2}/){
301 9         16 $self->{resolution} = 16;
302             }
303             else {
304 38         57 $self->{resolution} = 12;
305             }
306             }
307 56         101 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           return voltage_c(
324             $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution
325             );
326             }
327             sub raw {
328 0     0 1   my ($self, $channel) = @_;
329              
330 0 0         if (defined $channel){
331 0           $self->channel($channel);
332             }
333              
334 0           my $addr = $self->addr;
335 0           my $dev = $self->device;
336 0           my @write_buf = $self->register;
337              
338 0           return raw_c($addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution);
339             }
340             sub percent {
341 0     0 1   my ($self, $channel) = @_;
342              
343 0 0         if (defined $channel){
344 0           $self->channel($channel);
345             }
346              
347 0           my $addr = $self->addr;
348 0           my $dev = $self->device;
349 0           my @write_buf = $self->register;
350              
351 0           my $percent = percent_c(
352             $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution
353             );
354              
355 0 0         $percent = 100 if $percent > 100;
356            
357 0           return sprintf("%.2f", $percent);
358             }
359              
360       0     sub _vim {}
361              
362             1;
363              
364             __END__