File Coverage

blib/lib/Lab/Moose/Instrument/LinearStepSweep.pm
Criterion Covered Total %
statement 57 64 89.0
branch 13 20 65.0
condition n/a
subroutine 9 9 100.0
pod 1 2 50.0
total 80 95 84.2


line stmt bran cond sub pod time code
1             package Lab::Moose::Instrument::LinearStepSweep;
2             $Lab::Moose::Instrument::LinearStepSweep::VERSION = '3.881';
3             #ABSTRACT: Role for linear step sweeps used by voltage/current sources.
4              
5 7     7   5320 use v5.20;
  7         31  
6 7     7   46 use Moose::Role;
  7         18  
  7         51  
7 7     7   37433 use MooseX::Params::Validate;
  7         18  
  7         81  
8 7     7   3455 use Lab::Moose::Instrument 'setter_params';
  7         20  
  7         450  
9              
10             # time() returns floating seconds.
11 7     7   51 use Time::HiRes qw/time usleep/;
  7         20  
  7         76  
12 7     7   1318 use Lab::Moose 'linspace';
  7         30  
  7         89  
13 7     7   88 use Carp;
  7         22  
  7         4521  
14              
15             requires qw/max_units_per_second max_units_per_step min_units max_units
16             source_level cached_source_level source_level_timestamp/;
17              
18              
19             # Enforce max_units/min_units.
20             sub check_max_and_min {
21 170     170 0 257 my $self = shift;
22 170         283 my $to = shift;
23              
24 170         5386 my $min = $self->min_units();
25 170         5230 my $max = $self->max_units();
26 170 50       594 if ( $to < $min ) {
    50          
27 0         0 croak "target $to is below minimum allowed value $min";
28             }
29             elsif ( $to > $max ) {
30 0         0 croak "target $to is above maximum allowed value $max";
31             }
32             }
33              
34             sub linear_step_sweep {
35 170     170 1 854 my ( $self, %args ) = validated_hash(
36             \@_,
37             to => { isa => 'Num' },
38             verbose => { isa => 'Bool', default => 1 },
39             setter_params(),
40             );
41 170         42830 my $to = delete $args{to};
42 170         383 my $verbose = delete $args{verbose};
43 170         595 my $from = $self->cached_source_level();
44 170         6349 my $last_timestamp = $self->source_level_timestamp();
45 170         406 my $distance = abs( $to - $from );
46              
47 170         490 $self->check_max_and_min($to);
48              
49 170 100       406 if ( not defined $last_timestamp ) {
50 19         97 $last_timestamp = time();
51             }
52              
53             # Enforce step size and rate.
54 170         5537 my $step = abs( $self->max_units_per_step() );
55              
56 170         5501 my $rate = abs( $self->max_units_per_second() );
57 170 50       419 if ( $step < 1e-9 ) {
58 0         0 croak "step size must be > 0";
59             }
60              
61 170 50       379 if ( $rate < 1e-9 ) {
62 0         0 croak "rate must be > 0";
63             }
64              
65 170         667 my @steps = linspace(
66             from => $from, to => $to, step => $step,
67             exclude_from => 1
68             );
69              
70 170         307 my $time_per_step;
71 170 100       347 if ( $distance < $step ) {
72 167         308 $time_per_step = $distance / $rate;
73             }
74             else {
75 3         9 $time_per_step = $step / $rate;
76             }
77              
78 170         508 my $time = time();
79              
80 170 50       403 if ( $time < $last_timestamp ) {
81              
82             # should never happen
83 0         0 croak "time error";
84             }
85              
86             # Do we have to wait to enforce the maximum rate or can we start right now?
87 170         312 my $waiting_time = $time_per_step - ( $time - $last_timestamp );
88 170 100       365 if ( $waiting_time > 0 ) {
89 3         25832 usleep( 1e6 * $waiting_time );
90             }
91 170         866 $self->source_level( value => shift @steps, %args );
92              
93             # enable autoflush
94 170         918 my $autoflush = STDOUT->autoflush();
95 170         6582 for my $step (@steps) {
96 36         365886 usleep( 1e6 * $time_per_step );
97              
98             # YokogawaGS200 has 5 + 1/2 digits precision
99 36 50       410 if ($verbose) {
100 0         0 printf(
101             "Sweeping to %.5g: Setting level to %.5e \r", $to,
102             $step
103             );
104             }
105 36         330 $self->source_level( value => $step, %args );
106             }
107 170 50       505 if ($verbose) {
108 0         0 print " " x 70 . "\r";
109             }
110              
111             # reset autoflush to previous value
112 170         644 STDOUT->autoflush($autoflush);
113 170         11424 $self->source_level_timestamp( time() );
114             }
115              
116              
117             1;
118              
119             __END__
120              
121             =pod
122              
123             =encoding UTF-8
124              
125             =head1 NAME
126              
127             Lab::Moose::Instrument::LinearStepSweep - Role for linear step sweeps used by voltage/current sources.
128              
129             =head1 VERSION
130              
131             version 3.881
132              
133             =head1 METHODS
134              
135             =head2 linear_step_sweep
136              
137             $source->linear_step_sweep(
138             to => $new_level,
139             timeout => $timeout # optional
140             );
141              
142             =head1 REQUIRED METHODS
143              
144             The following methods are required for role consumption:
145             C<max_units_per_second, max_units_per_step, min_units, max_units,
146             source_level, cached_source_level, source_level_timestamp >
147              
148             =head1 COPYRIGHT AND LICENSE
149              
150             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
151              
152             Copyright 2017-2018 Simon Reinhardt
153             2020 Andreas K. Huettel
154              
155              
156             This is free software; you can redistribute it and/or modify it under
157             the same terms as the Perl 5 programming language system itself.
158              
159             =cut