File Coverage

blib/lib/Lab/Moose/Instrument/AH2700A.pm
Criterion Covered Total %
statement 35 93 37.6
branch 0 2 0.0
condition n/a
subroutine 12 26 46.1
pod 12 14 85.7
total 59 135 43.7


line stmt bran cond sub pod time code
1             package Lab::Moose::Instrument::AH2700A;
2             $Lab::Moose::Instrument::AH2700A::VERSION = '3.880';
3             #ABSTRACT: Andeen-Hagerling AH2700A ultra-precision capacitance bridge
4              
5 1     1   2390 use v5.20;
  1         4  
6              
7 1     1   6 use strict;
  1         7  
  1         32  
8 1     1   6 use Time::HiRes qw (usleep);
  1         2  
  1         9  
9 1     1   149 use Moose;
  1         3  
  1         7  
10 1     1   7143 use Moose::Util::TypeConstraints qw/enum/;
  1         3  
  1         9  
11 1     1   577 use MooseX::Params::Validate;
  1         2  
  1         7  
12 1         71 use Lab::Moose::Instrument qw/
13             validated_getter
14             validated_setter
15             validated_no_param_setter
16             setter_params
17 1     1   561 /;
  1         3  
18 1     1   9 use Lab::Moose::Instrument::Cache;
  1         2  
  1         8  
19 1     1   688 use Carp;
  1         4  
  1         55  
20 1     1   6 use namespace::autoclean;
  1         9  
  1         8  
21 1     1   122 use Time::HiRes qw/time usleep/;
  1         2  
  1         5  
22 1     1   112 use Lab::Moose 'linspace';
  1         4  
  1         10  
23              
24             extends 'Lab::Moose::Instrument';
25              
26              
27             sub BUILD {
28 0     0 0   my $self = shift;
29             # $self->get_id();
30             }
31              
32              
33             sub set_frq {
34 0     0 1   my ( $self, $value, %args ) = validated_setter( \@_,
35             value => { isa => enum( [ ( 50..20000 ) ] ) },
36             );
37              
38 0           $self->write( command => sprintf("FREQ %d", $value), %args );
39             }
40              
41              
42             sub get_frq {
43 0     0 1   my $self = shift;
44              
45 0           my $result = $self->query( command => sprintf("SH FR") );
46              
47 0           $result =~ /(\D+)(\d+\.\d+)(\D+)/;
48              
49 0           return $2;
50             }
51              
52              
53             sub set_aver {
54 0     0 1   my ( $self, $value, %args ) = validated_setter( \@_,
55             value => { isa => enum( [ ( 0..15 ) ] ) },
56             );
57              
58 0           $self->write( command => sprintf( "AV %d", $value ), %args );
59             }
60              
61              
62             sub get_aver {
63 0     0 1   my $self = shift;
64              
65 0           my $result = $self->query( command => sprintf("SH AV") );
66              
67 0           $result =~ /(\D+)(\D+\=)(\d+)/;
68              
69 0           return $3;
70             }
71              
72              
73             sub set_bias {
74 0     0 1   my ( $self, $value, %args ) = validated_setter( \@_,
75             value => { isa => enum([qw/ OFF IHIGH ILOW /]) },
76             );
77            
78 0           $self->write( command => sprintf( "BI %s", $value ), %args );
79             }
80              
81              
82             sub get_bias {
83 0     0 1   my $self = shift;
84              
85 0           my $result = $self->query( command => sprintf("SH BI") );
86              
87 0           $result =~ /(\D+\s)(\D+)/;
88              
89 0           return $result;
90             }
91              
92              
93             sub set_cable {
94 0     0 1   my ( $self, $cab1, $cab2, %args ) = validated_setter( \@_,
95             cab1 => { isa => enum([qw/ L RES I C /]) },
96             cab2 => { isa => 'Str' },
97             );
98              
99 0           $self->write( command => sprintf( "CAB %s %d", $cab1, $cab2 ), %args );
100             }
101              
102              
103             sub get_cable {
104 0     0 1   my $self = shift;
105              
106 0           my $result = $self->write( command => sprintf("SH CAB") );
107              
108 0           my @results;
109              
110 0           for ( my $i = 0; $i < 4; $i++ ) {
111 0           my $result = $self->read();
112 0           push( @results, $result );
113             }
114              
115 0           print " @results ";
116              
117 0           return @results;
118             }
119              
120             # used internally for get_value
121             sub get_single {
122 0     0 0   my ( $self, %args ) = validated_getter( \@_,
123             );
124              
125             # Implement cache; just use Lab::Moose::Instrument::Cache
126             # and write cache id => (getter => 'get_id') for all get
127             # functions?
128 0           my $average = $self->get_aver();
129 0           my $frequency = $self->get_frq();
130              
131             # Rewrite with hash
132 0           my $time_table_highf = {
133             0 => [ 0.28, 80 ],
134             1 => [ 0.29, 110 ],
135             2 => [ 0.30, 150 ],
136             3 => [ 0.33, 200 ],
137             4 => [ 0.37, 260 ],
138             5 => [ 0.44, 350 ],
139             6 => [ 0.58, 520 ],
140             7 => [ 3.2, 3200 ],
141             8 => [ 4.8, 5200 ],
142             9 => [ 7.2, 8800 ],
143             10 => [ 12.0, 16000 ],
144             11 => [ 20.0, 28000 ],
145             12 => [ 36.0, 56000 ],
146             13 => [ 68.0, 108000 ],
147             14 => [ 140.0, 220000 ],
148             15 => [ 280.0, 480000 ],
149             };
150              
151 0           my $timeout = @{ $time_table_highf->{$average} }[0]
152 0           + @{ $time_table_highf->{$average} }[1] / $frequency;
  0            
153              
154 0 0         if ( not exists($args{'timeout'}) ) {
155 0           $args{'timeout'} = 100;
156             }
157              
158 0           my $result = $self->query( command => sprintf("SI"), %args );
159             #print "$result";
160             # Rewrite with hash
161             #if ($result eq "") { croak "AH2700A: Low to Ground\n"; }
162 0           my $values;
163 0           while ( $result =~ /([A-Z])=\s?(-?\d+\.\d+)/g ) {
164 0           $values->{$1} = $2;
165             }
166 0           $values->{E} = 00;
167             # Didn't work in my last test
168             #if ( $result =~ /^(\d+)/ and $result != /00/ ) {
169             # $values->{E} = $1;
170             #}
171            
172             # TODO
173             # S was always empty in my last test and caused the script
174             # to crash, so i'll just document the first three values
175             # for the moment.
176             return (
177             $values->{C} * 1e-12,
178             $values->{L} * 1e-9,
179             $values->{V}
180             #,$values->{S}, $values->{E}
181 0           );
182             }
183              
184              
185             sub get_value {
186 0     0 1   my $self = shift;
187              
188 0           return $self->get_single(@_);
189             }
190              
191             sub set_wait {
192 0     0 1   my ( $self, $wait, %args )
193             = validated_setter( \@_, wait => { isa => 'Num' }, );
194              
195 0           $self->write( command => sprintf( "WAIT DELAY %d", $wait ), %args );
196             }
197              
198              
199             # controls which fields are sent to GPIB port
200             sub set_field {
201 0     0 1   my ( $self, %args ) = validated_getter( \@_,
202             fi1 => { isa => 'Str' },
203             fi2 => { isa => 'Str' },
204             fi3 => { isa => 'Num' },
205             fi4 => { isa => 'Num' },
206             fi5 => { isa => 'Str' },
207             fi6 => { isa => 'Str' },
208             );
209            
210 0           my $fi1 = delete $args{fi1};
211 0           my $fi2 = delete $args{fi2};
212 0           my $fi3 = delete $args{fi3};
213 0           my $fi4 = delete $args{fi4};
214 0           my $fi5 = delete $args{fi5};
215 0           my $fi6 = delete $args{fi6};
216              
217 0           $self->write( command =>
218             sprintf(
219             "FIELD %s,%s,%d,%d,%s,%s", $fi1, $fi2, $fi3, $fi4, $fi5, $fi6
220             ), %args
221             );
222             }
223              
224              
225             sub set_volt {
226 0     0 1   my ( $self, $value, %args ) = validated_setter( \@_,
227             value => { isa => 'Num' },
228             );
229              
230 0           $self->write( command => sprintf( "V %2.2f", $value ), %args );
231             }
232              
233             __END__
234              
235             =pod
236              
237             =encoding UTF-8
238              
239             =head1 NAME
240              
241             Lab::Moose::Instrument::AH2700A - Andeen-Hagerling AH2700A ultra-precision capacitance bridge
242              
243             =head1 VERSION
244              
245             version 3.880
246              
247             =head1 SYNOPSIS
248              
249             use Lab::Moose;
250              
251             # Constructor
252             my $AH = instrument(
253             type => 'AH2700A',
254             connection_type => 'VISA_GPIB',
255             connection_options => {
256             pad => 28,
257             },
258             );
259              
260             =head1 METHODS
261              
262             =head2 set_frq
263              
264             $AH->set_frq( value => (50..20000) );
265              
266             The frequency can be chosen between 50 Hz and 20 kHz.
267             Since the AH2700A is a discrete frequency bridge it will select
268             the nearest supported frequency when entering a value.
269              
270             =head2 get_frq
271              
272             $AH->get_frq();
273              
274             =head2 set_aver
275              
276             $AH->set_aver( value => (0..15) );
277              
278             Sets the approximate time used to make a measurement.
279             This command sets the "average time exponent" controlling
280             the measurement times for cold and warm-start measurements.
281              
282             The actual time taken can be calculated using the table from
283             the manual on this function.
284              
285             =head2 get_aver
286              
287             $AH->get_aver();
288              
289             =head2 set_bias
290              
291             $AH->set_bias( value = (OFF / IHIGH / ILOW) );
292              
293             Controls the user-supplied DC bias voltage and selects the
294             value of an internal resistor placed in series with this
295             voltage.
296              
297             OFF: Disabled
298             ILOW: 100 megaohm resistor
299             IHIGH: 1 megaohm resistor
300              
301             =head2 get_bias
302              
303             $AH->get_bias();
304              
305             =head2 set_cable
306              
307             =head2 get_cable
308              
309             =head2 get_value
310              
311             ($frequency, $capacity, $loss) = $AH->get_value();
312              
313             Causes the bridge to take a single measurement.
314              
315             =head2 set_wait
316              
317             =head2 set_field
318              
319             $AH->set_field(fi1 => "OFF", fi2 => "OFF", fi3 => 9, fi4 => 9, fi5 => "ON", fi6 => "OFF");
320              
321             Controls the fields sent and the number of significant digits
322             reported for capacitance and/or loss measurements.
323              
324             fi1: send the sample field ON/OFF
325             fi2: send the frequency field ON/OFF
326             fi3: send the capacitance field and control number of digits
327             0..9
328             fi4: send the loss field and control number of digits
329             0..9
330             fi5: send the voltage field ON/OFF
331             fi6: send the error field ON/OFF
332              
333             =head2 set_volt
334              
335             =head1 COPYRIGHT AND LICENSE
336              
337             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
338              
339             Copyright 2013 Christian Butschkow
340             2016 Andreas K. Huettel, Simon Reinhardt
341             2017 Andreas K. Huettel
342             2020 Andreas K. Huettel
343             2022-2023 Mia Schambeck
344              
345              
346             This is free software; you can redistribute it and/or modify it under
347             the same terms as the Perl 5 programming language system itself.
348              
349             =cut