File Coverage

blib/lib/Lab/Moose/Instrument/OI_IPS.pm
Criterion Covered Total %
statement 26 166 15.6
branch 0 32 0.0
condition 0 9 0.0
subroutine 9 38 23.6
pod 11 27 40.7
total 46 272 16.9


line stmt bran cond sub pod time code
1             package Lab::Moose::Instrument::OI_IPS;
2             $Lab::Moose::Instrument::OI_IPS::VERSION = '3.900';
3             #ABSTRACT: Oxford Instruments IPS Intelligent Power Supply
4              
5 1     1   2221 use v5.20;
  1         4  
6              
7 1     1   10 use Moose;
  1         3  
  1         8  
8 1     1   7359 use Moose::Util::TypeConstraints qw/enum/;
  1         4  
  1         11  
9 1     1   459 use MooseX::Params::Validate;
  1         2  
  1         10  
10 1         83 use Lab::Moose::Instrument qw/
11 1     1   461 validated_getter validated_setter validated_no_param_setter setter_params /;
  1         3  
12 1     1   237 use Lab::Moose::Instrument::Cache;
  1         7  
  1         13  
13 1     1   602 use Lab::Moose::Countdown 'countdown';
  1         2  
  1         48  
14 1     1   6 use Carp;
  1         2  
  1         54  
15 1     1   7 use namespace::autoclean;
  1         4  
  1         8  
16              
17             extends 'Lab::Moose::Instrument';
18              
19             # Ideally, max_fields and max_field_rates should be preconfigured in a
20             # subclass, with values specific for the magnet used at the setup
21              
22             has max_fields =>
23             ( is => 'ro', isa => 'ArrayRef[Lab::Moose::PosNum]', required => 1 );
24             has max_field_rates =>
25             ( is => 'ro', isa => 'ArrayRef[Lab::Moose::PosNum]', required => 1 );
26              
27             has verbose => (
28             is => 'ro',
29             isa => 'Bool',
30             default => 1
31             );
32              
33             sub BUILD {
34 0     0 0   my $self = shift;
35              
36 0           warn "The IPS driver is work in progress. You have been warned\n";
37              
38             # Unlike modern GPIB equipment, this device does not assert the EOI
39             # at end of message. The controller shell stop reading when receiving the
40             # eos byte.
41              
42 0           $self->connection->set_termchar( termchar => "\r" );
43 0           $self->connection->enable_read_termchar();
44 0           $self->clear();
45              
46             # Use extended resolution mode (setpoint 10 μT, rate 100 μT/min)
47 0           $self->set_communications_protocol( value => 4 );
48              
49 0           $self->set_control( value => 3 );
50              
51 0           $self->_check_field_rates();
52             }
53              
54             sub _check_field_rates {
55 0     0     my $self = shift;
56 0           my @max_fields = @{ $self->max_fields };
  0            
57 0           my @max_field_rates = @{ $self->max_field_rates };
  0            
58 0 0         if ( @max_fields < 1 ) {
59 0           croak "Need at least one element in max_fields array";
60             }
61 0 0         if ( @max_fields != @max_field_rates ) {
62 0           croak "Need as many values in max_fields as in max_field_rates";
63             }
64              
65 0           for my $i ( 1 .. $#max_fields ) {
66 0 0         if ( $max_fields[$i] <= $max_fields[ $i - 1 ] ) {
67 0           croak "values in max_fields must be in increasing order";
68             }
69 0 0         if ( $max_field_rates[$i] > $max_field_rates[ $i - 1 ] ) {
70 0           croak "values in max_field_rates must decrease";
71             }
72             }
73             }
74              
75             sub _check_sweep_parameters {
76 0     0     my ( $self, %args ) = validated_hash(
77             \@_,
78             current => { isa => 'Num' },
79             target => { isa => 'Num' },
80             rate => { isa => 'Num' },
81             );
82              
83 0           my $current = abs( delete $args{current} );
84 0           my $target = abs( delete $args{target} );
85 0           my $rate = abs( delete $args{rate} );
86              
87 0 0         my $max_field = ( $current > $target ) ? $current : $target;
88              
89 0           my @max_fields = @{ $self->max_fields };
  0            
90 0           my @max_field_rates = @{ $self->max_field_rates };
  0            
91 0           my $maximum_allowed_field = $max_fields[-1];
92              
93 0           my $i = 0;
94 0           while (1) {
95 0 0         if ( $max_field <= $max_fields[$i] ) {
96 0           last;
97             }
98 0 0         if ( $max_field > $maximum_allowed_field ) {
99 0           croak
100             "target field $max_field exceeds absolute maximum field $maximum_allowed_field";
101             }
102 0           ++$i;
103              
104             }
105 0           my $max_rate = $max_field_rates[$i];
106 0 0         if ( $rate > $max_rate ) {
107 0           croak "Rate $rate exceeds maximum allowed rate $max_rate";
108             }
109             }
110              
111              
112             # query wrapper with error checking
113             around query => sub {
114             my $orig = shift;
115             my $self = shift;
116             my %args = @_;
117              
118             my $result = $self->$orig(@_);
119             my $cmd = $args{command};
120              
121             # remove trailing "\n" and "\r"
122             $result =~ s/\s*$//;
123             $cmd =~ s/\s*$//;
124              
125             my $cmd_char = substr( $cmd, 0, 1 );
126              
127             # IPS query answers always start with the command character
128             # if successful.
129             # With a question mark and the command char on failure
130             my $status = substr( $result, 0, 1 );
131             if ( $status eq '?' ) {
132             croak "IPS returned error '$result' on command '$cmd'";
133             }
134             elsif ( defined $cmd_char and ( $status ne $cmd_char ) ) {
135             croak "IPS returned unexpected answer. Expected '$cmd_char' prefix,
136             received '$status' on command '$cmd'";
137             }
138             return substr( $result, 1 );
139             };
140              
141              
142             sub sweep_to_field {
143 0     0 0   my ( $self, %args ) = validated_getter(
144             \@_,
145             target => { isa => 'Num' },
146             rate => { isa => 'Num' },
147             );
148              
149 0           my $point = delete $args{target};
150 0           my $rate = delete $args{rate};
151              
152 0           $self->config_sweep( point => $point, rate => $rate, %args );
153              
154 0           $self->trg(%args);
155              
156 0           $self->wait(%args);
157 0           return $self->get_field(%args);
158             }
159              
160              
161             sub config_sweep {
162 0     0 0   my ( $self, %args ) = validated_hash(
163             \@_,
164             point => { isa => 'Num' },
165             rate => { isa => 'Num' },
166             );
167 0           my $target = delete $args{point};
168 0           my $rate = delete $args{rate};
169              
170 0           $self->set_field_sweep_rate( value => $rate, %args );
171 0           $self->set_target_field( value => $target, %args );
172              
173 0           my $current_field = $self->get_field();
174 0           $self->_check_sweep_parameters(
175             current => $current_field, target => $target,
176             rate => $rate
177             );
178 0 0         if ( $self->verbose() ) {
179 0           say "config_sweep: target: $target (T), rate: $rate (T/min)";
180             }
181             }
182              
183              
184             sub set_control {
185 0     0 1   my ( $self, $value, %args ) = validated_setter(
186             \@_,
187             value => { isa => enum( [qw/0 1 2 3/] ) },
188             );
189 0           my $result = $self->query( command => "C$value\r", %args );
190 0           sleep(1);
191 0           return $result;
192             }
193              
194              
195             sub set_communications_protocol {
196 0     0 1   my ( $self, $value, %args ) = validated_setter(
197             \@_,
198             value => { isa => enum( [qw/0 2 4 6/] ) }
199             );
200              
201             # This command does not produce an echo -> use write, not query.
202 0           $self->write( command => "Q$value\r" );
203             }
204              
205              
206             sub examine_status {
207 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
208 0           return "X" . $self->query( command => "X\r", %args );
209             }
210              
211              
212             sub active {
213 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
214 0           my $status = $self->examine_status(@_);
215 0           return substr( $status, 11, 1 );
216             }
217              
218              
219             sub in_persistent_mode {
220 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
221 0           my $status = $self->examine_status(@_);
222 0           my $n = substr( $status, 8, 1 );
223 0 0 0       if ( $n == 0 || $n == 2 ) {
    0          
224              
225             # heater off
226 0           return 1;
227             }
228             elsif ( $n == 1 ) {
229 0           return;
230             }
231             else {
232 0           croak "bad heater status $n";
233             }
234             }
235              
236             sub set_persistent_mode {
237 0     0 0   my ( $self, %args ) = validated_setter(
238             \@_,
239             mode => { isa => 'Int' }
240             );
241              
242 0           my $mode = delete $args{mode};
243              
244             # return 0 if not $self->{device_settings}->{has_switchheater};
245              
246 0           my $switch = $self->get_switch_heater();
247              
248             #print "We are in mode $current_mode \n";
249              
250 0 0 0       if ( $mode == 1 ) {
    0 0        
    0          
251              
252 0           $self->hold();
253 0           $self->set_switch_heater( value => 0 );
254              
255 0           $self->to_zero();
256              
257             #$current_mode = 1;
258              
259             }
260             elsif ( $mode == 0 and $switch == 2 ) {
261              
262 0           my $setpoint = $self->get_persistent_field();
263              
264 0           $self->set_target_field( value => $setpoint );
265              
266 0           $self->to_setpoint();
267              
268             #print "Try to start switchheater...\n";
269 0           $self->set_switchheater( value => 1 );
270              
271             #print "Switchheater has status ".$self->get_switchheater();
272              
273             }
274             elsif ( $mode == 0 and $switch == 0 ) {
275 0           print "Zero magnetic field. Switch on switchheater.\n";
276 0           $self->set_switchheater( value => 1 );
277              
278             }
279              
280             }
281              
282             sub get_persistent_field {
283 0     0 0   my ( $self, %args ) = validated_getter( \@_ );
284              
285             # Are we really in persistent mode?
286              
287 0           return $self->read_parameter( value => 18 );
288              
289             }
290              
291              
292             sub wait {
293 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
294 0           my $verbose = $self->verbose();
295              
296             # enable autoflush
297 0           my $autoflush = STDOUT->autoflush();
298              
299 0           while (1) {
300 0           sleep 1;
301 0           my $field = $self->get_field(%args);
302 0           printf( "Field: %.6f T \r", $field );
303 0 0         if ( not $self->active ) {
304 0           last;
305             }
306             }
307 0 0         if ($verbose) {
308 0           print " " x 70 . "\r";
309             }
310              
311             # reset autoflush to previous value
312 0           STDOUT->autoflush($autoflush);
313             }
314              
315              
316             sub read_parameter {
317 0     0 1   my ( $self, $value, %args ) = validated_setter(
318             \@_,
319             value => { isa => enum( [ ( 0 .. 24 ) ] ) },
320             );
321 0           my $result = $self->query( command => "R$value\r", %args );
322              
323             # device bug: sometimes the value is returned with a leading 'R'
324 0           $result =~ s/^R//;
325 0           return sprintf( "%e", $result );
326             }
327              
328              
329             sub get_field {
330 0     0 1   my $self = shift;
331 0           return $self->read_parameter( value => 7, @_ );
332             }
333              
334              
335             sub get_value {
336 0     0 1   my $self = shift;
337 0           return $self->get_field(@_);
338             }
339              
340             sub get_field_rate {
341 0     0 0   my $self = shift;
342 0           return $self->read_parameter( value => 9, @_ );
343             }
344              
345             sub set_activity {
346 0     0 0   my ( $self, $value, %args ) = validated_setter(
347             \@_,
348             value => { isa => enum( [ 0, 1, 2, 4 ] ) },
349             );
350              
351 0           return $self->query( command => "A$value\r", %args );
352             }
353              
354             sub hold {
355 0     0 0   my $self = shift;
356 0           return $self->set_activity( value => 0, @_ );
357             }
358              
359             sub to_setpoint {
360 0     0 0   my $self = shift;
361 0           return $self->set_activity( value => 1, @_ );
362             }
363              
364             sub trg {
365 0     0 0   my $self = shift;
366 0           return $self->to_setpoint(@_);
367             }
368              
369             sub to_zero {
370 0     0 0   my $self = shift;
371 0           return $self->set_activity( value => 2, @_ );
372             }
373              
374             sub set_front_panel_display_parameter {
375 0     0 0   my ( $self, $value, %args ) = validated_setter(
376             \@_,
377             value => { isa => enum( [ ( 0 .. 24 ) ] ) },
378             );
379 0           return $self->query( command => "F$value\r", %args );
380             }
381              
382              
383             sub set_switch_heater {
384 0     0 1   my ( $self, $value, %args ) = validated_setter(
385             \@_,
386              
387             # Do not implement "2" (without check)
388             value => { isa => enum( [ 0, 1 ] ) },
389             );
390 0           return $self->query( command => "H$value\r", %args );
391             }
392              
393              
394             sub get_switch_heater {
395 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
396 0           my $status = $self->examine_status(@_);
397 0           return substr( $status, 8, 1 );
398             }
399              
400             sub set_target_field {
401 0     0 0   my ( $self, $value, %args ) = validated_setter(
402             \@_,
403             value => { isa => 'Num' },
404             );
405 0           $value = sprintf( "%.5f", $value );
406 0           return $self->query( command => "J$value\r", %args );
407             }
408              
409             sub get_target_field {
410 0     0 0   my $self = shift;
411 0           return $self->read_parameter( value => 8, @_ );
412             }
413              
414             sub set_mode {
415 0     0 0   my ( $self, $value, %args ) = validated_setter(
416             \@_,
417             value => { isa => enum( [ 0, 1, 4, 5, 8, 9 ] ) }
418             );
419 0           return $self->query( command => "M$value\r", %args );
420             }
421              
422             sub set_field_sweep_rate {
423 0     0 0   my ( $self, $value, %args ) = validated_setter(
424             \@_,
425             value => { isa => 'Lab::Moose::PosNum' },
426             );
427 0           $value = sprintf( "%.4f", $value );
428 0           return $self->query( command => "T$value\r" );
429             }
430              
431              
432             __PACKAGE__->meta()->make_immutable();
433              
434             1;
435              
436             __END__
437              
438             =pod
439              
440             =encoding UTF-8
441              
442             =head1 NAME
443              
444             Lab::Moose::Instrument::OI_IPS - Oxford Instruments IPS Intelligent Power Supply
445              
446             =head1 VERSION
447              
448             version 3.900
449              
450             =head1 SYNOPSIS
451              
452             use Lab::Moose;
453              
454             # Constructor
455             my $ips = instrument(
456             type => 'OI_IPS',
457             connection_type => 'LinuxGPIB',
458             connection_options => {pad => 10},
459              
460             # safety limits, should be fixed in a subclass of this driver
461             max_fields => [7, 10], # absolute maximum field of 10T
462             max_field_rates => [0.1, 0.05], # 0.1 T/min maximum rate in range 0T..7T
463             # 0.05 T/min maximum rate in range 7T..10T
464             );
465              
466              
467             # Get field
468             my $field = $ips->get_field();
469              
470             # Sweep to 1T with rate 0.1T/min
471              
472             $ips->sweep_to_field(target => 1, rate => 0.1);
473              
474             =head1 METHODS
475              
476             =head1 sweep_to_field
477              
478             my $new_field = $ips->sweep_to_field(
479             target => $target_field, # Tesla
480             rate => $rate, # Tesla/min
481             );
482              
483             =head1 config_sweep
484              
485             $ips->config_sweep(point => $target, rate => $rate);
486              
487             Only define setpoints, do not start sweep.
488              
489             =head2 set_control
490              
491             $ips->set_control(value => 1);
492              
493             Set device local/remote mode (0, 1, 2, 3)
494              
495             =head2 set_communications_protocol
496              
497             $ips->set_communications_protocol(value => 0);
498              
499             Allowed values: C<0, 2, 4, 6>.
500              
501             This driver sets the protocol to C<4> "Extended Resolution" on startup.
502              
503             =head2 examine_status
504              
505             my $status = $ips->examine_status();
506              
507             Return status (XmnAnCnHnMmnPmn).
508              
509             =head2 active
510              
511             my $status = $ips->active();
512              
513             Return true value if IPS is sweeping. Return false when sweep finished.
514              
515             =head2 in_persistent_mode
516              
517             if ($ips->in_persistent_mode()) {
518             ...
519             }
520              
521             Return 1 if in persistent mode; otherwise return false.
522              
523             =head2 wait
524              
525             $ips->wait();
526              
527             Wait until current sweep is finished. Print status messages if C<verbose> attribute was set in constructor (default).
528              
529             =head2 read_parameter
530              
531             my $value = $ips->read_parameter(value => 1);
532              
533             Allowed values for C<value> are 0..13
534              
535             =head2 get_field
536              
537             my $field = $ips->get_field();
538              
539             Return current field (Tesla).
540              
541             =head2 get_value
542              
543             Alias for L</get_field>
544              
545             =head2 set_switch_heater
546              
547             $ips->set_switch_heater(value => 0); # Heater off
548             $ips->set_switch_heater(value => 1); # Heater on (only done if magnet current equals power supply current)
549              
550             =head2 get_switch_heater
551              
552             my $switch = $ips->get_switch_heater();
553              
554             Return values:
555              
556             =over
557              
558             =item 0: Off Magnet at Zero (switch closed)
559              
560             =item 1: On (switch open)
561              
562             =item 2: Off Magnet at Field (switch closed)
563              
564             =item 5: Heater Fault (heater is on but current is low)
565              
566             =item 8: No Switch Fitted
567              
568             =back
569              
570             =head2 Consumed Roles
571              
572             This driver consumes the following roles:
573              
574             =over
575              
576             =back
577              
578             =head1 COPYRIGHT AND LICENSE
579              
580             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
581              
582             Copyright 2019 Simon Reinhardt
583             2020 Andreas K. Huettel, Simon Reinhardt
584             2021 Andreas K. Huettel, Fabian Weinelt, Simon Reinhardt
585              
586              
587             This is free software; you can redistribute it and/or modify it under
588             the same terms as the Perl 5 programming language system itself.
589              
590             =cut