File Coverage

blib/lib/Lab/Instrument/Keithley2000.pm
Criterion Covered Total %
statement 11 284 3.8
branch 0 132 0.0
condition 0 57 0.0
subroutine 4 36 11.1
pod 17 24 70.8
total 32 533 6.0


line stmt bran cond sub pod time code
1             package Lab::Instrument::Keithley2000;
2             #ABSTRACT: Keithley 2000 digital multimeter
3             $Lab::Instrument::Keithley2000::VERSION = '3.881';
4 1     1   2136 use v5.20;
  1         4  
5              
6 1     1   6 use strict;
  1         3  
  1         23  
7 1     1   5 use Lab::Instrument;
  1         2  
  1         21  
8 1     1   5 use Time::HiRes qw (usleep);
  1         2  
  1         7  
9              
10             our @ISA = ('Lab::Instrument');
11              
12             our %fields = (
13             supported_connections =>
14             [ 'VISA', 'VISA_GPIB', 'GPIB', 'RS232', 'VISA_RS232', 'DEBUG' ],
15              
16             # default settings for the supported connections
17             connection_settings => {
18             gpib_board => undef,
19             gpib_address => undef,
20             timeout => 2,
21             },
22              
23             device_settings => {},
24              
25             device_cache => {
26              
27             }
28              
29             );
30              
31             # ---------------------- Init DMM --------------------------------------------------------
32             sub new {
33 0     0 1   my $proto = shift;
34 0   0       my $class = ref($proto) || $proto;
35 0           my $self = $class->SUPER::new(@_);
36 0           $self->${ \( __PACKAGE__ . '::_construct' ) }(__PACKAGE__);
  0            
37 0           $self->write('INIT:CONT OFF');
38 0           return $self;
39             }
40              
41             sub reset { # basic
42 0     0 1   my $self = shift;
43 0           $self->write("*RST");
44 0           return;
45             }
46              
47             # ----------------------- Config DMM ------------------------------------------------------
48              
49             sub set_function { # basic
50 0     0 1   my $self = shift;
51 0           my ($function) = $self->_check_args( \@_, ['function'] );
52              
53 0 0         if ( $function
54             =~ /\b(PERIOD|period|PER|per|FREQUENCY|frequency|FREQ|freq|TEMPERATURE|temperature|TEMP|temp|DIODE|diode|DIOD|diod","CURRENT|current|CURR|curr|CURRENT:AC|current:ac|CURR:AC|curr:ac","CURRENT:DC|current:dc|CURR:DC|curr:dc|VOLTAGE|voltage|VOLT|volt|VOLTAGE:AC|voltage:ac|VOLT:AC|volt:ac|VOLTAGE:DC|voltage:dc|VOLT:DC|volt:dc|RESISTANCE|resisitance|RES|res|FRESISTANCE|fresistance|FRES|fres)\b/
55             ) {
56 0           return $self->query(
57             sprintf( ":SENSE:FUNCTION '%s'; FUNCTION?", $function ) );
58             }
59             else {
60 0           Lab::Exception::CorruptParameter->throw( error =>
61             "unexpected value in sub config_function. Function can be CURRENT:AC, CURRENT:DC, VOLTAGE:AC, VOLTAGE:DC, RESISTANCE, FRESISTANCE, PERIOD, FREQUENCY, TEMPERATURE, DIODE"
62             );
63             }
64             }
65              
66             sub get_function {
67 0     0 0   my $self = shift;
68 0           my $function = $self->query(":SENSE:FUNCTION?");
69 0           return substr( $function, 1, -1 ); # cut off quotes ""
70             }
71              
72             sub set_range { # basic
73 0     0 1   my $self = shift;
74 0           my ( $range, $function )
75             = $self->_check_args( \@_, [ 'range', 'function' ] );
76              
77             # return settings
78              
79 0 0         if ( not defined $function ) {
80 0           $function = $self->get_function();
81             }
82              
83             #set range
84 0 0         if ( $function
    0          
    0          
    0          
    0          
85             =~ /\b(CURRENT|current|CURR|curr|CURRENT:AC|current:ac|CURR:AC|curr:ac","CURRENT:DC|current:dc|CURR:DC|curr:dc)\b/
86             ) {
87 0 0 0       if ( $range =~ /\b(AUTO|auto|MIN|min|MAX|max|DEF|def)\b/ ) {
    0          
88              
89             #pass
90             }
91             elsif ( ( $range >= 0 && $range <= 3.03 ) ) {
92 0           $range = sprintf( "%.2f", $range );
93             }
94             else {
95 0           Lab::Exception::CorruptParameter->throw( error =>
96             "unexpected value in sub config_range for 'RANGE'. Must be between 0 and 3.03."
97             );
98             }
99             }
100              
101             elsif ( $function =~ /\b(VOLTAGE:AC|voltage:ac|VOLT:AC|volt:ac)\b/ ) {
102 0 0 0       if ( $range =~ /\b(AUTO|auto|MIN|min|MAX|max|DEF|def)\b/ ) {
    0          
103              
104             #pass
105             }
106             elsif ( ( $range >= 0 && $range <= 757.5 ) ) {
107 0           $range = sprintf( "%.1f", $range );
108             }
109             else {
110 0           Lab::Exception::CorruptParameter->throw( error =>
111             "unexpected value in sub config_range for 'RANGE'. Must be between 0 and 757.5."
112             );
113             }
114             }
115             elsif ( $function
116             =~ /\b(VOLTAGE|voltage|VOLT|volt|VOLTAGE:DC|voltage:dc|VOLT:DC|volt:dc)\b/
117             ) {
118 0 0 0       if ( $range =~ /\b(AUTO|auto|MIN|min|MAX|max|DEF|def)\b/ ) {
    0          
119              
120             #pass
121             }
122             elsif ( ( $range >= 0 && $range <= 1010 ) ) {
123 0           $range = sprintf( "%.1f", $range );
124             }
125             else {
126 0           Lab::Exception::CorruptParameter->throw( error =>
127             "unexpected value in sub config_range for 'RANGE'. Must be between 0 and 1010."
128             );
129             }
130             }
131             elsif ( $function
132             =~ /\b(RESISTANCE|resisitance|RES|res|FRESISTANCE|fresistance|FRES|fres)\b/
133             ) {
134 0 0 0       if ( $range =~ /\b(AUTO|auto|MIN|min|MAX|max|DEF|def)\b/ ) {
    0          
135              
136             #pass
137             }
138             elsif ( ( $range >= 0 && $range <= 101e6 ) ) {
139 0           $range = sprintf( "%d", $range );
140             }
141             else {
142 0           Lab::Exception::CorruptParameter->throw( error =>
143             "unexpected value in sub config_range for 'RANGE'. Must be between 0 and 101E6."
144             );
145             }
146             }
147             elsif ( $function =~ /\b(DIODE|DIOD|diode|diod)\b/ ) {
148 0           $function = "DIOD:CURRENT";
149 0 0 0       if ( $range < 0 || $range > 1e-3 ) {
150 0           Lab::Exception::CorruptParameter->throw( error =>
151             "unexpected value in sub config_range for 'RANGE'. Must be between 0 and 1E-3."
152             );
153             }
154             }
155             else {
156 0           Lab::Exception::CorruptParameter->throw( error =>
157             "unexpected value in sub set_range. Function can be CURRENT:AC, CURRENT:DC, VOLTAGE:AC, VOLTAGE:DC, RESISTANCE, FRESISTANCE"
158             );
159             }
160              
161             # set range
162 0 0         if ( $range =~ /\b(AUTO|auto)\b/ ) {
    0          
163 0           $self->write( sprintf( ":SENSE:%s:RANGE:AUTO ON", $function ) );
164             }
165             elsif ( $range =~ /\b(MIN|min|MAX|max|DEF|def)\b/ ) {
166 0           $self->write( sprintf( ":SENSE:%s:RANGE %s", $function, $range ) );
167             }
168             else {
169 0           $self->write( sprintf( ":SENSE:%s:RANGE %.2f", $function, $range ) );
170             }
171 0           return;
172              
173             }
174              
175             sub get_range {
176 0     0 0   my $self = shift;
177 0           my ($function) = $self->_check_args( \@_, ['function'] );
178              
179 0 0         if ( not defined $function ) {
180 0           $function = $self->get_function();
181             }
182 0 0         if (
183             not $function
184             =~ /\b(PERIOD|period|PER|per|FREQUENCY|frequency|FREQ|freq|TEMPERATURE|temperature|TEMP|temp|DIODE|diode|DIOD|diod","CURRENT|current|CURR|curr|CURRENT:AC|current:ac|CURR:AC|curr:ac","CURRENT:DC|current:dc|CURR:DC|curr:dc|VOLTAGE|voltage|VOLT|volt|VOLTAGE:AC|voltage:ac|VOLT:AC|volt:ac|VOLTAGE:DC|voltage:dc|VOLT:DC|volt:dc|RESISTANCE|resisitance|RES|res|FRESISTANCE|fresistance|FRES|fres)\b/
185             ) {
186 0           Lab::Exception::CorruptParameter->throw(
187             error => "unexpected value for FUNCTION in sub get_range." );
188             }
189              
190 0           my $range = $self->query(":SENSE:$function:RANGE?");
191 0           return $range;
192             }
193              
194             sub set_nplc { # basic
195 0     0 1   my $self = shift;
196 0           my ( $nplc, $function )
197             = $self->_check_args( \@_, [ 'nplc', 'function' ] );
198              
199             # return settings if no new values are given
200 0 0         if ( not defined $function ) {
201 0           $function = $self->get_function();
202             }
203              
204 0 0 0       if ( ( $nplc < 0.01 && $nplc > 10 )
      0        
205             and not $nplc =~ /\b(MAX|max|MIN|min|DEF|def)\b/ ) {
206 0           Lab::Exception::CorruptParameter->throw( error =>
207             "unexpected value for NPLC in sub set_sense_nplc. Expected values are between 0.01 and 1000 POWER LINE CYCLES or MIN/MAX/DEF."
208             );
209             }
210              
211 0 0         if ( $function
212             =~ /\b(CURRENT|CURR|current|curr|VOLTAGE|VOLT|voltage|volt|RESISTANCE|RES|resistance|res)\b/
213             ) {
214 0 0         if ( $nplc =~ /\b(MAX|max|MIN|min|DEF|def)\b/ ) {
    0          
215 0           return $self->query(
216             sprintf( ":SENSE:%s:NPLC %s; NPLC?", $function, $nplc ) );
217             }
218             elsif ( $nplc =~ /\b\d+(e\d+|E\d+|exp\d+|EXP\d+)?\b/ ) {
219 0           return $self->query(
220             sprintf( ":SENSE:%s:NPLC %e; NPLC?", $function, $nplc ) );
221             }
222             else {
223 0           Lab::Exception::CorruptParameter->throw( error =>
224             "unexpected value for NPLC in sub set_sense_nplc. Expected values are between 0.01 and 10 POWER LINE CYCLES or MIN/MAX/DEF."
225             );
226             }
227             }
228             else {
229 0           Lab::Exception::CorruptParameter->throw( error =>
230             "unexpected value for FUNCTION in sub set_sense_nplc. Expected values are CURRENT:AC, CURRENT:DC, VOLTAGE:AC, VOLTAGE:DC, RESISTANCE, FRESISTANCE, TEMPERATURE"
231             );
232             }
233             }
234              
235             sub get_nplc {
236 0     0 0   my $self = shift;
237 0           my ($function) = $self->_check_args( \@_, ['function'] );
238              
239 0 0         if ( not defined $function ) {
240 0           $function = $self->get_function();
241             }
242 0 0         if (
243             not $function
244             =~ /\b(PERIOD|period|PER|per|FREQUENCY|frequency|FREQ|freq|TEMPERATURE|temperature|TEMP|temp|DIODE|diode|DIOD|diod","CURRENT|current|CURR|curr|CURRENT:AC|current:ac|CURR:AC|curr:ac","CURRENT:DC|current:dc|CURR:DC|curr:dc|VOLTAGE|voltage|VOLT|volt|VOLTAGE:AC|voltage:ac|VOLT:AC|volt:ac|VOLTAGE:DC|voltage:dc|VOLT:DC|volt:dc|RESISTANCE|resisitance|RES|res|FRESISTANCE|fresistance|FRES|fres)\b/
245             ) {
246 0           Lab::Exception::CorruptParameter->throw(
247             error => "unexpected value for FUNCTION in sub get_nplc." );
248             }
249              
250 0           my $nplc = $self->query(":SENSE:$function:NPLC?");
251              
252 0           return $nplc;
253             }
254              
255             sub set_averaging { # advanced
256 0     0 1   my $self = shift;
257 0           my ( $count, $mode, $function )
258             = $self->_check_args( \@_, [ 'count', 'mode', 'function' ] );
259              
260 0 0         if ( not defined $function ) {
261 0           $function = $self->get_function(); # get selected function
262             }
263              
264 0 0         if ( not defined $mode ) {
265 0           $mode = "REPEAT";
266             } # set REPeating as standard value; MOVing would be 2nd option
267              
268 0 0         if ( $mode =~ /\b(REPEAT|repeat|MOVING|moving)\b/ ) {
269 0 0 0       if ( $count >= 0.5 and $count <= 100.5 ) {
    0 0        
270              
271             # set averaging
272 0           $self->write(":SENSE:$function:AVERAGE:STATE ON");
273 0           $self->write(":SENSE:$function:AVERAGE:TCONTROL $mode");
274              
275 0 0 0       if ( $count =~ /\b(MIN|min|MAX|max|DEF|def)\b/
276             or $count =~ /\b\d+(e\d+|E\d+|exp\d+|EXP\d+)?\b/ ) {
277 0           $count
278             = $self->query(
279             ":SENSE:$function:AVERAGE:COUNT $count; STATE?; COUNT?; TCONTROL?"
280             );
281 0           my $result;
282             (
283             $result->{'state'}, $result->{'count'},
284 0           $result->{'tcontrol'}
285             ) = split( /;/, $count );
286 0           return $result;
287             }
288             }
289             elsif ( $count =~ /\b(OFF|off)\b/ or $count == 0 ) {
290 0           $self->write(":SENSE:$function:AVERAGE:STATE OFF")
291             ; # switch OFF Averaging
292 0           $count = $self->query(
293             ":SENSE:$function:AVERAGE:STATE?; COUNT?; TCONTROL?");
294 0           my $result;
295 0           ( $result->{'state'}, $result->{'count'}, $result->{'tcontrol'} )
296             = split( /;/, $count );
297 0           return $result;
298             }
299             else {
300 0           Lab::Exception::CorruptParameter->throw( error =>
301             "unexpected value for COUNT in sub set_averaging. Expected values are between 1 ... 100 or MIN/MAX/DEF/OFF."
302             );
303             }
304              
305             }
306             else {
307 0           Lab::Exception::CorruptParameter->throw( error =>
308             "unexpected value for FILTERMODE in sub set_averaging. Expected values are REPEAT and MOVING."
309             );
310             }
311              
312             }
313              
314             sub get_averaging {
315 0     0 0   my $self = shift;
316 0           my ($function) = $self->_check_args( \@_, ['function'] );
317              
318 0 0         if ( not defined $function ) {
319 0           $function = $self->get_function();
320             }
321              
322 0           my $count
323             = $self->query(":SENSE:$function:AVERAGE:STATE?; COUNT?; TCONTROL?");
324 0           my $result;
325 0           ( $result->{'state'}, $result->{'count'}, $result->{'tcontrol'} )
326             = split( /;/, $count );
327 0           return $result;
328              
329             }
330              
331             # ----------------------------------------- MEASUREMENT ----------------------------------
332              
333             sub get_value { # basic
334 0     0 1   my $self = shift;
335 0           my ($function) = $self->_check_args( \@_, ['function'] );
336              
337 0 0         if ( not defined $function ) {
    0          
338 0           $self->device_cache()->{value} = $self->query(':READ?');
339 0           return $self->device_cache()->{value};
340              
341             }
342             elsif ( $function
343             =~ /\b(PERIOD|period|PER|per|FREQUENCY|frequency|FREQ|freq|TEMPERATURE|temperature|TEMP|temp|DIODE|diode|DIOD|diod|CURRENT|current|CURR|curr|CURRENT:AC|current:ac|CURR:AC|curr:ac|CURRENT:DC|current:dc|CURR:DC|curr:dc|VOLTAGE|voltage|VOLT|volt|VOLTAGE:AC|voltage:ac|VOLT:AC|volt:ac|VOLTAGE:DC|voltage:dc|VOLT:DC|volt:dc|RESISTANCE|resisitance|RES|res|FRESISTANCE|fresistance|FRES|fres)\b/
344             ) {
345 0           my $cmd = sprintf( ":MEASURE:%s?", $function );
346 0           $self->device_cache()->{value} = $self->query($cmd);
347 0           return $self->device_cache()->{value};
348             }
349             else {
350 0           Lab::Exception::CorruptParameter->throw( error =>
351             "unexpected value for 'function' in sub measure. Function can be CURRENT:AC, CURRENT:DC, VOLTAGE:AC, VOLTAGE:DC, RESISTANCE, FRESISTANCE, PERIOD, FREQUENCY, TEMPERATURE, DIODE"
352             );
353             }
354             }
355              
356             sub config_measurement { # basic
357 0     0 1   my $self = shift;
358              
359 0           my ( $function, $nop, $time, $range, $trigger ) = $self->_check_args(
360             \@_,
361             [ 'function', 'nop', 'time', 'range', 'trigger' ]
362             );
363              
364             # check input data
365 0 0         if ( not defined $trigger ) {
366 0           $trigger = 'BUS';
367             }
368 0 0         if ( not defined $range ) {
369 0           $range = 'DEF';
370             }
371 0 0         if ( not defined $time ) {
372 0           Lab::Exception::CorruptParameter->throw( error =>
373             "too view arguments given in sub config_measurement. Expected arguments are FUNCTION, #POINTS, TIME, <RANGE>, <TRIGGERSOURCE>"
374             );
375             }
376              
377 0           $self->set_function($function);
378 0           print "sub config_measurement: set FUNCTION: "
379             . $self->set_function() . "\n";
380              
381 0           $self->set_range( $function, $range );
382 0           print "sub config_measurement: set RANGE: " . $self->set_range() . "\n";
383              
384 0           my $nplc = ( $time * 50 ) / $nop;
385 0 0         if ( $nplc < 0.01 ) {
386 0           Lab::Exception::CorruptParameter->throw( error =>
387             "unexpected value for TIME in sub config_measurement. Expected values are between 0.5 ... 50000 sec."
388             );
389             }
390 0           $self->set_nplc( $function, $nplc );
391 0           print "sub config_measurement: set NPLC: " . $self->set_nplc() . "\n";
392              
393 0           $self->_init_buffer($nop);
394 0           print "sub config_measurement: init BUFFER: "
395             . $self->_init_buffer($nop) . "\n";
396              
397 0           $self->_init_trigger($trigger);
398 0           print "sub config_measurement: init TRIGGER: "
399             . $self->_init_trigger($trigger) . "\n";
400              
401 0           return $nplc;
402              
403             }
404              
405             sub trg { # basic
406 0     0 1   my $self = shift;
407 0           $self->write("*TRG");
408             }
409              
410             sub abort { # basic
411 0     0 1   my $self = shift;
412 0           $self->write("ABORT");
413             }
414              
415             sub wait { # basic
416 0     0 1   my $self = shift;
417 0           my $timeout = shift;
418              
419 0 0         if ( not defined $timeout ) {
420 0           $timeout = 100;
421             }
422              
423             my $status = Lab::VISA::viSetAttribute(
424             $self->{vi}->{instr},
425 0           $Lab::VISA::VI_ATTR_TMO_VALUE, $timeout
426             );
427 0 0         if ( $status != $Lab::VISA::VI_SUCCESS ) {
428 0           Lab::Exception::CorruptParameter->throw(
429             error => "Error while setting baud: $status" );
430             }
431              
432 0           print "waiting for data ... \n";
433 0           while (1) {
434 0 0         if ( $self->query(":STATUS:OPERATION:CONDITION?") >= 1024 ) {
435 0           last;
436             } # check if measurement has been finished
437 0           else { usleep(1e3); }
438             }
439              
440             my $status = Lab::VISA::viSetAttribute(
441             $self->{vi}->{instr},
442 0           $Lab::VISA::VI_ATTR_TMO_VALUE, 3000
443             );
444 0 0         if ( $status != $Lab::VISA::VI_SUCCESS ) {
445 0           Lab::Exception::CorruptParameter->throw(
446             error => "Error while setting baud: $status" );
447             }
448              
449             }
450              
451             sub active { # basic
452 0     0 1   my $self = shift;
453 0           my ($timeout) = $self->_check_args( \@_, ['value'] );
454              
455 0 0         if ( not defined $timeout ) {
456 0           $timeout = 100;
457             }
458              
459             my $status = Lab::VISA::viSetAttribute(
460             $self->{vi}->{instr},
461 0           $Lab::VISA::VI_ATTR_TMO_VALUE, $timeout
462             );
463 0 0         if ( $status != $Lab::VISA::VI_SUCCESS ) {
464 0           Lab::Exception::CorruptParameter->throw(
465             error => "Error while setting baud: $status" );
466             }
467              
468             # check if measurement has been finished
469 0 0         if ( $self->query(":STATUS:OPERATION:CONDITION?") >= 1024 ) {
470 0           return 0;
471             }
472             else {
473 0           return 1;
474             }
475              
476             my $status = Lab::VISA::viSetAttribute(
477             $self->{vi}->{instr},
478 0           $Lab::VISA::VI_ATTR_TMO_VALUE, 3000
479             );
480 0 0         if ( $status != $Lab::VISA::VI_SUCCESS ) {
481 0           Lab::Exception::CorruptParameter->throw(
482             error => "Error while setting baud: $status" );
483             }
484             }
485              
486             sub get_data { # basic
487 0     0 1   my $self = shift;
488 0           return $self->_read_buffer();
489             }
490              
491             # ------------------------------------ DATA BUFFER ----------------------------------------
492              
493             sub _clear_buffer { # internal
494 0     0     my $self = shift;
495 0           $self->write(":DATA:CLEAR");
496 0           return $self->query(":DATA:FREE?");
497             }
498              
499             sub _init_buffer { # internal
500 0     0     my $self = shift;
501 0           my ($nop) = $self->_check_args( \@_, ['value'] );
502              
503 0           $self->_clear_buffer();
504              
505 0 0 0       if ( $nop >= 2 && $nop <= 1024 ) {
506 0           $self->write("*CLS");
507 0           $self->write(":STATUS:OPERATION:ENABLE 16")
508             ; # enable status bit for measuring/idle status
509 0           $self->write("INIT:CONT OFF"); # set DMM to IDLE-state
510 0           $self->_init_trigger("BUS")
511             ; # trigger-count = 1, trigger-delay = 0s, trigger-source = IMM/EXT/TIM/MAN/BUS
512 0           $self->_set_triggercount(1);
513 0           $self->_set_triggerdelay(0);
514 0           my $return_nop = $self->_set_samplecount($nop);
515 0           $self->write(":INIT"); # set DMM from IDLE to WAIT-FOR_TRIGGER status
516 0           return $return_nop;
517             }
518             else {
519 0           Lab::Exception::CorruptParameter->throw( error =>
520             "unexpected value in sub set_nop_for_buffer. Must be between 2 and 1024."
521             );
522             }
523             }
524              
525             sub _read_buffer { # basic
526 0     0     my $self = shift;
527 0           my ($print) = $self->_check_args( \@_, ['value'] );
528              
529             # wait until data are available
530 0           $self->wait();
531              
532             #read data
533 0           $self->write(":FORMAT:DATA ASCII; :FORMAT:ELEMENTS READING")
534             ; # select Format for reading DATA
535 0           my $data = $self->{vi}->LongQuery(":DATA:DATA?");
536 0           chomp $data;
537 0           my @data = split( ",", $data );
538              
539             #print data
540 0 0         if ( $print eq "PRINT" ) {
541 0           foreach my $item (@data) { print $item. "\n"; }
  0            
542             }
543              
544 0           return @data;
545             }
546              
547             # -------------------------------------- TRIGGER ----------------------------------------------
548              
549             sub _init_trigger { # internal
550 0     0     my $self = shift;
551 0           my ($source) = $self->_check_args( \@_, ['source'] );
552              
553 0 0         if ( not defined $source ) {
554 0           $source = "BUS";
555             } # set BUS as default trigger source
556              
557 0           $self->_set_triggercount("DEF"); # DEF = 1
558 0           $self->_set_triggerdelay("DEF"); # DEF = 0
559 0           $self->_set_triggersource("BUS");
560              
561 0           return "trigger initiated";
562              
563             }
564              
565             sub _set_triggersource { # internal
566 0     0     my $self = shift;
567 0           my ($triggersource) = $self->_check_args( \@_, ['source'] );
568              
569             #return setting
570 0 0         if ( not defined $triggersource ) {
571 0           $triggersource = $self->query(":TRIGGER:SOURCE?");
572 0           chomp($triggersource);
573 0           return $triggersource;
574             }
575              
576             #set triggersoource
577 0 0         if ( $triggersource =~ /\b(IMM|imm|EXT|ext|TIM|tim|MAN|man|BUS|bus)\b/ ) {
578 0           return $self->query(
579             sprintf( ":TRIGGER:SOURCE %s; SOURCE?", $triggersource ) );
580             }
581             else {
582 0           Lab::Exception::CorruptParameter->throw( error =>
583             "unexpected value for SOURCE in sub _init_trigger. Must be IMM, EXT, TIM, MAN or BUS."
584             );
585             }
586             }
587              
588             sub _set_samplecount { # internal
589 0     0     my $self = shift;
590 0           my ($samplecount) = $self->_check_args( \@_, ['value'] );
591              
592             #return setting
593 0 0         if ( not defined $samplecount ) {
594 0           $samplecount = $self->query(":SAMPLE:COUNT?");
595 0           chomp($samplecount);
596 0           return $samplecount;
597             }
598              
599             #set samplecount
600 0 0 0       if ( $samplecount >= 1 && $samplecount <= 1024 ) {
601 0           return $self->query(
602             sprintf( ":SAMPLE:COUNT %d; COUNT?", $samplecount ) );
603             }
604             else {
605 0           Lab::Exception::CorruptParameter->throw( error =>
606             "unexpected value for SAMPLECOUNT in sub _set_samplecount. Must be between 1 and 1024."
607             );
608             }
609              
610             }
611              
612             sub _set_triggercount { # internal
613 0     0     my $self = shift;
614 0           my ($triggercount) = $self->_check_args( \@_, ['value'] );
615              
616             #return setting
617 0 0         if ( not defined $triggercount ) {
618 0           $triggercount = $self->query(":TRIGGER:COUNT?");
619 0           chomp($triggercount);
620 0           return $triggercount;
621             }
622              
623             #set triggercount
624 0 0 0       if ( ( $triggercount >= 1 && $triggercount <= 1024 )
      0        
625             or $triggercount =~ /\b(MIN|min|MAX|max|DEF|def)\b/ ) {
626 0           return $self->query(":TRIGGER:COUNT $triggercount; COUNT?");
627             }
628             else {
629 0           Lab::Exception::CorruptParameter->throw( error =>
630             "unexpected value for TRIGGERCOUNT in sub _set_triggercount. Must be between 1 and 1024 or MIN/MAX/DEF."
631             );
632             }
633             }
634              
635             sub _set_triggerdelay { # internal
636 0     0     my $self = shift;
637 0           my ($triggerdelay) = $self->_check_args( \@_, ['value'] );
638              
639             #return setting
640 0 0         if ( not defined $triggerdelay ) {
641 0           $triggerdelay = $self->query(":TRIGGER:DELAY?");
642 0           chomp($triggerdelay);
643 0           return $triggerdelay;
644             }
645              
646             #set triggerdelay
647 0 0 0       if ( ( $triggerdelay >= 0 && $triggerdelay <= 999999.999 )
      0        
648             or $triggerdelay =~ /\b(MIN|min|MAX|max|DEF|def)\b/ ) {
649 0           return $self->query(":TRIGGER:DELAY $triggerdelay; DELAY?");
650             }
651             else {
652 0           Lab::Exception::CorruptParameter->throw( error =>
653             "unexpected value for TRIGGERDELAY in sub _set_triggerdelay. Must be between 0 and 999999.999sec or MIN/MAX/DEF."
654             );
655             }
656             }
657              
658             sub set_timer { # advanced
659 0     0 0   my $self = shift;
660 0           my ($timer) = $self->_check_args( \@_, ['value'] );
661              
662             #return setting
663 0 0         if ( not defined $timer ) {
664 0           $timer = $self->query(":TRIGGER:TIMER?");
665 0           chomp($timer);
666 0           return $timer;
667             }
668              
669             #set timer
670 0 0 0       if ( ( $timer >= 1e-3 && $timer <= 999999.999 )
      0        
671             or $timer =~ /\b(MIN|min|MAX|max|DEF|def)\b/ ) {
672 0           return $self->query(":TRIGGER:TIMER $timer; TIMER?");
673             }
674             else {
675 0           Lab::Exception::CorruptParameter->throw( error =>
676             "unexpected value for TIMER in sub set_timer. Must be between 0 and 999999.999sec or MIN/MAX/DEF."
677             );
678             }
679             }
680              
681             # -----------------------------------------DISPLAY --------------------------------
682              
683             sub display { # basic
684 0     0 0   my $self = shift;
685 0           my ($data) = $self->_check_args( \@_, ['state'] );
686              
687 0 0         if ( not defined $data ) {
    0          
    0          
    0          
688 0           return $self->_display_text();
689             }
690             elsif ( $data =~ /\b(ON|on)\b/ ) {
691 0           return $self->_display_on();
692             }
693             elsif ( $data =~ /\b(OFF|off)\b/ ) {
694 0           return $self->_display_off();
695             }
696             elsif ( $data =~ /\b(CLEAR|clear)\b/ ) {
697 0           return $self->_display_clear();
698             }
699             else {
700 0           return $self->_display_text($data);
701             }
702              
703             }
704              
705             sub display_on { # for internal/advanced use only
706 0     0 1   my $self = shift;
707 0           $self->write(":DISPLAY:ENABLE ON");
708             }
709              
710             sub display_off { # for internal/advanced use only
711 0     0 1   my $self = shift;
712 0           $self->write(":DISPLAY:ENABLE OFF")
713             ; # when display is disabled, the instrument operates at a higher speed. Frontpanel commands are frozen.
714             }
715              
716             sub display_text { # for internal/advanced use only
717 0     0 1   my $self = shift;
718 0           my ($text) = $self->_check_args( \@_, ['text'] );
719              
720 0 0         if ($text) {
721 0           chomp( $text
722             = $self->query("DISPLAY:TEXT:DATA '$text'; STATE 1; DATA?") );
723 0           $text =~ s/\"//g;
724 0           return $text;
725             }
726             else {
727 0           chomp( $text = $self->query("DISPLAY:TEXT:DATA?") );
728 0           $text =~ s/\"//g;
729 0           return $text;
730             }
731             }
732              
733             sub display_clear { # for internal/advanced use only
734 0     0 1   my $self = shift;
735 0           $self->write("DISPlay:TEXT:STATE 0");
736             }
737              
738             # ----------------------------------------------------------------------------------------
739              
740             sub beep {
741 0     0 0   my $self = shift;
742 0           $self->write("BEEP");
743             }
744              
745             1;
746              
747             __END__
748              
749             =pod
750              
751             =encoding UTF-8
752              
753             =head1 NAME
754              
755             Lab::Instrument::Keithley2000 - Keithley 2000 digital multimeter
756              
757             =head1 VERSION
758              
759             version 3.881
760              
761             =head1 SYNOPSIS
762              
763             use Lab::Instrument::Keithley2000;
764             my $DMM=new Lab::Instrument::Keithley2000(0,22);
765             print $DMM->get_value('VOLTAGE:DC');
766              
767             =head1 DESCRIPTION
768              
769             The Lab::Instrument::Keithley2000 class implements an interface to the Keithley 2000 digital multimeter.
770              
771             =head1 CONSTRUCTOR
772              
773             my $DMM=new(\%options);
774              
775             =head1 METHODS
776              
777             =head2 get_value
778              
779             $value=$DMM->get_value($function);
780              
781             Make a measurement defined by $function with the previously specified range
782             and integration time.
783              
784             =over 4
785              
786             =item $function
787              
788             FUNCTION can be one of the measurement methods of the Keithley2000.
789              
790             "current:dc" --> DC current measurement
791             "current:ac" --> AC current measurement
792             "voltage:dc" --> DC voltage measurement
793             "voltage:ac" --> AC voltage measurement
794             "resisitance" --> resistance measurement (2-wire)
795             "fresistance" --> resistance measurement (4-wire)
796              
797             =back
798              
799             =head2 get_T
800              
801             $value=$DMM->get_value($sensor, $function, $range);
802              
803             Make a measurement defined by $function with the previously specified range
804             and integration time.
805              
806             =over 4
807              
808             =item $sensor
809              
810             SENSOR can be one of the Temperature-Diodes defined in Lab::Instrument::TemperatureDiodes.
811              
812             =item $function
813              
814             FUNCTION can be one of the measurement methods of the Keithley2000.
815              
816             "diode" --> read out temperatuer diode
817             "resisitance" --> resistance measurement (2-wire)
818             "fresistance" --> resistance measurement (4-wire)
819              
820             =item $range
821              
822             RANGE is given in terms of amps or ohms and can be 1e-5 | 1e-4 | 1e-3 | MIN | MAX | DEF or 0...101e6 | MIN | MAX | DEF | AUTO .
823             DEF is default AUTO activates the AUTORANGE-mode.
824             DEF will be set, if no value is given.
825              
826             =back
827              
828             =head2 config_measurement
829              
830             $K2000->config_measurement($function, $number_of_points, $time, $range);
831              
832             Preset the Keithley2000 for a TRIGGERED measurement.
833              
834             WARNING: It's not recomended to perform triggered measurments with the KEITHLEY 2000 DMM due to unsolved timing problems!!!!!
835              
836             =over 4
837              
838             =item $function
839              
840             FUNCTION can be one of the measurement methods of the Keithley2000.
841              
842             "current:dc" --> DC current measurement
843             "current:ac" --> AC current measurement
844             "voltage:dc" --> DC voltage measurement
845             "voltage:ac" --> AC voltage measurement
846             "resisitance" --> resistance measurement (2-wire)
847             "fresistance" --> resistance measurement (4-wire)
848              
849             =item $number_of_points
850              
851             Preset the NUMBER OF POINTS to be taken for one measurement TRACE .
852             The single measured points will be stored in the internal memory of the Keithley2000.
853             For the Keithley2000 the internal memory is limited to 1024 values.
854              
855             =item $time
856              
857             Preset the TIME duration for one full trace.
858             From TIME the integration time value for each measurement point will be derived [NPLC = (TIME *50Hz)/NOP].
859             Expected values are between 0.21 ... 20000 seconds.
860              
861             =item $range
862              
863             RANGE is given in terms of amps, volts or ohms and can be 0...+3,03A | MIN | MAX | DEF | AUTO , 0...757V(AC)/1010V(DC) | MIN | MAX | DEF | AUTO or 0...101e6 | MIN | MAX | DEF | AUTO .
864             DEF is default AUTO activates the AUTORANGE-mode.
865             DEF will be set, if no value is given.
866              
867             =back
868              
869             =head2 trg
870              
871             $K2000->trg();
872              
873             Sends a trigger signal via the GPIB-BUS to start the predefined measurement.
874             The LabVisa-script can immediatally be continued, e.g. to start another triggered measurement using a second Keithley2000.
875              
876             =head2 abort
877              
878             $K2000->abort();
879              
880             Aborts current (triggered) measurement.
881              
882             =head2 active
883              
884             $K2400->abort();
885              
886             Returns '1' if the current triggered measurement is still active and '0' if the current triggered measurement has allready been finished.
887              
888             =head2 wait
889              
890             $K2400->abort();
891              
892             WAIT until triggered measurement has been finished.
893              
894             =head2 get_data
895              
896             @data = $K2000->get_data();
897              
898             Reads all recorded values from the internal buffer and returnes them as an array of floatingpoint values.
899             Reading the buffer will start immediately after the triggered measurement has finished. The LabVisa-script cannot be continued until all requested readings have been recieved.
900              
901             =head2 set_function
902              
903             $K2000->set_function($function);
904              
905             Set a new value for the measurement function of the Keithley2000.
906              
907             =over 4
908              
909             =item $function
910              
911             FUNCTION can be one of the measurement methods of the Keithley2000.
912              
913             "current:dc" --> DC current measurement
914             "current:ac" --> AC current measurement
915             "voltage:dc" --> DC voltage measurement
916             "voltage:ac" --> AC voltage measurement
917             "resisitance" --> resistance measurement (2-wire)
918             "fresistance" --> resistance measurement (4-wire)
919              
920             =back
921              
922             =head2 set_range
923              
924             $K2000->set_range($function,$range);
925              
926             Set a new value for the predefined RANGE for the measurement function $function of the Keithley2000.
927              
928             =over 4
929              
930             =item $function
931              
932             FUNCTION can be one of the measurement methods of the Keithley2000.
933              
934             "current:dc" --> DC current measurement
935             "current:ac" --> AC current measurement
936             "voltage:dc" --> DC voltage measurement
937             "voltage:ac" --> AC voltage measurement
938             "resisitance" --> resistance measurement (2-wire)
939             "fresistance" --> resistance measurement (4-wire)
940              
941             =item $range
942              
943             RANGE is given in terms of amps, volts or ohms and can be 0...+3,03A | MIN | MAX | DEF | AUTO , 0...757V(AC)/1010V(DC) | MIN | MAX | DEF | AUTO or 0...101e6 | MIN | MAX | DEF | AUTO .
944             DEF is default AUTO activates the AUTORANGE-mode.
945             DEF will be set, if no value is given.
946              
947             =back
948              
949             =head2 set_nplc
950              
951             $K2000->set_nplc($function,$nplc);
952              
953             Set a new value for the predefined NUMBER of POWER LINE CYCLES for the measurement function $function of the Keithley2000.
954              
955             =over 4
956              
957             =item $function
958              
959             FUNCTION can be one of the measurement methods of the Keithley2000.
960              
961             "current:dc" --> DC current measurement
962             "current:ac" --> AC current measurement
963             "voltage:dc" --> DC voltage measurement
964             "voltage:ac" --> AC voltage measurement
965             "resisitance" --> resistance measurement (2-wire)
966             "fresistance" --> resistance measurement (4-wire)
967              
968             =item $nplc
969              
970             Preset the NUMBER of POWER LINE CYCLES which is actually something similar to an integration time for recording a single measurement value.
971             The values for $nplc can be any value between 0.01 ... 10.
972              
973             Example:
974             Assuming $nplc to be 10 and assuming a netfrequency of 50Hz this results in an integration time of 10*50Hz = 0.2 seconds for each measured value. Assuming $number_of_points to be 100 it takes in total 20 seconds to record all values for the trace.
975              
976             =back
977              
978             =head2 set_averaging
979              
980             $K2000->set_averaging($count, $filter);
981              
982             Set a new value for the predefined NUMBER of POWER LINE CYCLES for the measurement function $function of the Keithley2000.
983              
984             =over 4
985              
986             =item $count
987              
988             COUNT is the number of readings to be taken to fill the AVERAGING FILTER . COUNT can be 1 ... 100.
989              
990             =item $filter
991              
992             FILTER can be MOVING or REPEAT . A detailed description is refered to the user manual.
993              
994             =back
995              
996             =head2 display_on
997              
998             $K2000->display_on();
999              
1000             Turn the front-panel display on.
1001              
1002             =head2 display_off
1003              
1004             $K2000->display_off();
1005              
1006             Turn the front-panel display off.
1007              
1008             =head2 display_text
1009              
1010             $K2000->display_text($text);
1011             print $K2000->display_text();
1012              
1013             Display a message on the front panel. The multimeter will display up to 12
1014             characters in a message; any additional characters are truncated.
1015             Without parameter the displayed message is returned.
1016              
1017             =head2 display_clear
1018              
1019             $K2000->display_clear();
1020              
1021             Clear the message displayed on the front panel.
1022              
1023             =head2 reset
1024              
1025             $K2000->reset();
1026              
1027             Reset the multimeter to its power-on configuration.
1028              
1029             =head1 CAVEATS/BUGS
1030              
1031             probably many
1032              
1033             =head1 SEE ALSO
1034              
1035             =over 4
1036              
1037             =item L<Lab::Instrument>
1038              
1039             =back
1040              
1041             =head1 COPYRIGHT AND LICENSE
1042              
1043             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
1044              
1045             Copyright 2013-2014 Christian Butschkow
1046             2016 Simon Reinhardt
1047             2017 Andreas K. Huettel
1048             2020 Andreas K. Huettel
1049              
1050              
1051             This is free software; you can redistribute it and/or modify it under
1052             the same terms as the Perl 5 programming language system itself.
1053              
1054             =cut