File Coverage

blib/lib/Lab/XPRESS/Sweep.pm
Criterion Covered Total %
statement 379 804 47.1
branch 57 232 24.5
condition 20 78 25.6
subroutine 28 52 53.8
pod 5 36 13.8
total 489 1202 40.6


line stmt bran cond sub pod time code
1             package Lab::XPRESS::Sweep;
2             $Lab::XPRESS::Sweep::VERSION = '3.881';
3             #ABSTRACT: Base sweep class
4              
5 8     8   109 use v5.20;
  8         28  
6              
7 8     8   3635 use Role::Tiny::With;
  8         41716  
  8         497  
8              
9 8     8   61 use Time::HiRes qw/usleep/, qw/time/;
  8         19  
  8         60  
10 8     8   1002 use POSIX qw(ceil);
  8         21  
  8         81  
11 8     8   12500 use Term::ReadKey;
  8         24  
  8         726  
12 8     8   66 use Storable qw(dclone);
  8         18  
  8         343  
13 8     8   52 use Lab::Generic;
  8         61  
  8         253  
14 8     8   3855 use Lab::XPRESS::Sweep::Dummy;
  8         25  
  8         268  
15 8     8   3512 use Lab::XPRESS::Utilities::Utilities;
  8         25  
  8         237  
16 8     8   52 use Lab::Exception;
  8         18  
  8         149  
17 8     8   45 use Carp;
  8         15  
  8         420  
18 8     8   50 use strict;
  8         15  
  8         178  
19              
20 8     8   47 use Storable qw(dclone);
  8         18  
  8         372  
21             $Storable::forgive_me = 1;
22              
23 8     8   47 use Carp qw(cluck croak);
  8         15  
  8         70683  
24              
25             our @ISA = ('Lab::Generic');
26              
27             our $PAUSE = 0;
28             our $ACTIVE_SWEEPS = ();
29              
30             our $AUTOLOAD;
31              
32             sub new {
33 2     2 0 6 my $proto = shift;
34 2   33     11 my $class = ref($proto) || $proto;
35 2         12 my $self = $class->SUPER::new(@_);
36              
37             $self->{default_config} = {
38 2         42 instrument => undef,
39             allowed_instruments => [undef],
40              
41             interval => 0,
42             mode => 'dummy',
43             delay_before_loop => 0,
44             delay_in_loop => 0,
45             delay_after_loop => 0,
46             before_loop => undef,
47              
48             points => [ undef, undef ],
49              
50             rate => [undef],
51             duration => [undef],
52              
53             stepwidth => [undef],
54             number_of_points => [undef],
55              
56             backsweep => 0,
57             repetitions => 1,
58              
59             separate_files => 0,
60             folders => 1,
61              
62             filename_extension => '#'
63             };
64              
65 2         7 $self->{LOG} = ();
66 2         8 @{ $self->{LOG} }[0] = {};
  2         7  
67              
68             # deep copy $default_config:
69 2         6 while ( my ( $k, $v ) = each %{ $self->{default_config} } ) {
  38         97  
70 36 100       67 if ( ref($v) eq 'ARRAY' ) {
71 12         22 $self->{config}->{$k} = ();
72 12         16 foreach ( @{$v} ) {
  12         23  
73 14         20 push( @{ $self->{config}->{$k} }, $_ );
  14         33  
74             }
75             }
76             else {
77 24         44 $self->{config}->{$k} = $v;
78             }
79             }
80              
81 2         6 my $type = ref $_[0];
82              
83 2 50       12 if ( $type =~ /HASH/ ) {
84 2         21 %{ $self->{config} }
85 2         4 = ( %{ $self->{config} }, %{ shift @_ }, %{ shift @_ } );
  2         24  
  2         9  
  2         9  
86             }
87              
88             #for debugging: print config parameters:
89             # while ( my ($k,$v) = each %{$self->{config}} )
90             # {
91             # print "$k => $v\n";
92             # }
93             # print "\n\n";
94              
95             # print "\n\n";
96              
97 2         18 $self->prepaire_config();
98              
99 2         12 $self->{master} = undef;
100 2         5 $self->{slaves} = ();
101 2         5 $self->{slave_counter} = 0;
102              
103 2         7 $self->{DataFile_counter} = 0;
104 2         5 $self->{DataFiles} = ();
105              
106 2         6 $self->{filenamebase} = ();
107 2         6 $self->{filename_extensions} = [];
108              
109 2         6 $self->{pause} = 0;
110 2         5 $self->{active} = 0;
111 2         5 $self->{repetition} = 0;
112              
113 2         13 return bless $self, $class;
114             }
115              
116             sub prepaire_config {
117 2     2 0 5 my $self = shift;
118              
119             # deep Copy original Config Data:
120              
121             # correct typing errors:
122 2         11 $self->{config}->{mode} =~ s/\s+//g; #remove all whitespaces
123 2         31 $self->{config}->{mode} =~ "\L$self->{config}->{mode}"
124             ; # transform all uppercase letters to lowercase letters
125 2 50       14 if ( $self->{config}->{mode}
126             =~ /continuous|contious|cont|continuouse|continouse|coninuos|continuose/
127             ) {
128 0         0 $self->{config}->{mode} = 'continuous';
129             }
130              
131             # make an Array out of single values if necessary:
132 2 50       13 if ( ref( $self->{config}->{points} ) ne 'ARRAY' ) {
133 0         0 $self->{config}->{points} = [ $self->{config}->{points} ];
134             }
135 2 50       9 if ( ref( $self->{config}->{rate} ) ne 'ARRAY' ) {
136 0         0 $self->{config}->{rate} = [ $self->{config}->{rate} ];
137             }
138 2 50       8 if ( ref( $self->{config}->{duration} ) ne 'ARRAY' ) {
139 0         0 $self->{config}->{duration} = [ $self->{config}->{duration} ];
140             }
141 2 50       8 if ( ref( $self->{config}->{stepwidth} ) ne 'ARRAY' ) {
142 0         0 $self->{config}->{stepwidth} = [ $self->{config}->{stepwidth} ];
143             }
144 2 50       8 if ( ref( $self->{config}->{number_of_points} ) ne 'ARRAY' ) {
145             $self->{config}->{number_of_points}
146 0         0 = [ $self->{config}->{number_of_points} ];
147             }
148 2 50       93 if ( ref( $self->{config}->{interval} ) ne 'ARRAY' ) {
149 2         14 $self->{config}->{interval} = [ $self->{config}->{interval} ];
150             }
151              
152 2         801 $self->{config_original} = dclone( $self->{config} );
153              
154             # calculate the length of each Array:
155 2         11 my $length_points = @{ $self->{config}->{points} };
  2         6  
156 2         5 my $length_rate = @{ $self->{config}->{rate} };
  2         7  
157 2         4 my $length_duration = @{ $self->{config}->{duration} };
  2         49  
158 2         4 my $length_stepwidth = @{ $self->{config}->{stepwidth} };
  2         6  
159 2         4 my $length_number_of_points = @{ $self->{config}->{number_of_points} };
  2         6  
160 2         4 my $length_interval = @{ $self->{config}->{interval} };
  2         5  
161              
162             # Look for inconsistent sweep parameters:
163 2 50 33     12 if ( $length_points < 2 and $self->{config}->{mode} ne 'list' ) {
164 0         0 die
165             "inconsistent definition of sweep_config_data: less than two elements defined in 'points'. You need at least a 'start' and a 'stop' point.";
166             }
167              
168 2 50       7 if ( $length_rate > $length_points ) {
169 0         0 die
170             "inconsistent definition of sweep_config_data: number of elements in 'rate' larger than number of elements in 'points'.";
171             }
172 2 50       6 if ( $length_duration > $length_points ) {
173 0         0 die
174             "inconsistent definition of sweep_config_data: number of elements in 'duration' larger than number of elements in 'points'.";
175             }
176 2 50 33     11 if ( $length_stepwidth > $length_points - 1
177             and $self->{config}->{mode} ne 'list' ) {
178 0         0 die
179             "inconsistent definition of sweep_config_data: number of elements in 'stepwidth' larger than number of sweep sequences.";
180             }
181 2 50 33     10 if ( $length_number_of_points > $length_points - 1
182             and $self->{config}->{mode} ne 'list' ) {
183 0         0 die
184             "inconsistent definition of sweep_config_data: number of elements in 'number_of_points' larger than number of sweep sequences.";
185             } #
186 2 50 33     9 if ( $length_interval > $length_points
187             and $self->{config}->{mode} ne 'list' ) {
188 0         0 die
189             "inconsistent definition of sweep_config_data: number of elements in 'interval' larger than number of sweep sequences.";
190             }
191              
192             # fill up Arrays to fit with given Points:
193 2         7 while ( ( $length_rate = @{ $self->{config}->{rate} } ) < $length_points )
  4         16  
194             {
195             push(
196 2         8 @{ $self->{config}->{rate} },
197 2         4 @{ $self->{config}->{rate} }[-1]
  2         7  
198             );
199             }
200              
201 2         5 while ( ( $length_duration = @{ $self->{config}->{duration} } )
  6         18  
202             < $length_points ) {
203             push(
204 4         9 @{ $self->{config}->{duration} },
205 4         10 @{ $self->{config}->{duration} }[-1]
  4         10  
206             );
207             }
208              
209 2         4 while ( ( $length_stepwidth = @{ $self->{config}->{stepwidth} } )
  4         12  
210             < $length_points ) {
211             push(
212 2         6 @{ $self->{config}->{stepwidth} },
213 2         4 @{ $self->{config}->{stepwidth} }[-1]
  2         6  
214             );
215             }
216              
217 2         5 while (
218             (
219             $length_number_of_points
220 4         13 = @{ $self->{config}->{number_of_points} }
221             ) < $length_points
222             ) {
223             push(
224 2         5 @{ $self->{config}->{number_of_points} },
225 2         5 @{ $self->{config}->{number_of_points} }[-1]
  2         5  
226             );
227             }
228              
229 2         4 while ( ( $length_interval = @{ $self->{config}->{interval} } )
  4         13  
230             < $length_points ) {
231             push(
232 2         5 @{ $self->{config}->{interval} },
233 2         4 @{ $self->{config}->{interval} }[-1]
  2         5  
234             );
235             }
236              
237             # calculate the length of each Array again:
238 2         4 my $length_points = @{ $self->{config}->{points} };
  2         5  
239 2         3 my $length_rate = @{ $self->{config}->{rate} };
  2         5  
240 2         4 my $length_duration = @{ $self->{config}->{duration} };
  2         4  
241 2         3 my $length_stepwidth = @{ $self->{config}->{stepwidth} };
  2         5  
242 2         4 my $length_number_of_points = @{ $self->{config}->{number_of_points} };
  2         5  
243              
244             # evaluate sweep sign:
245 2         9 foreach my $i ( 0 .. $length_points - 2 ) {
246 2 50       4 if ( @{ $self->{config}->{points} }[$i]
  2 0       6  
247 2         9 - @{ $self->{config}->{points} }[ $i + 1 ] < 0 ) {
248 2         5 @{ $self->{config}->{sweepsigns} }[$i] = 1;
  2         8  
249             }
250 0         0 elsif ( @{ $self->{config}->{points} }[$i]
251 0         0 - @{ $self->{config}->{points} }[ $i + 1 ] > 0 ) {
252 0         0 @{ $self->{config}->{sweepsigns} }[$i] = -1;
  0         0  
253             }
254             else {
255 0         0 @{ $self->{config}->{sweepsigns} }[$i] = 0;
  0         0  
256             }
257             }
258              
259             # add current position to Points-Array:
260 2         4 unshift( @{ $self->{config}->{points} }, $self->get_value() );
  2         10  
261              
262             # calculate duration from rate and vise versa:
263 2 50 33     22 if ( defined @{ $self->{config}->{rate} }[0]
  2 50 33     16  
    50 33        
    50          
    50          
264 2         10 and defined @{ $self->{config}->{duration} }[0] ) {
265 0         0 die
266             'inconsistent definition of sweep_config_data: rate as well as duration defined. Use only one of both.';
267             }
268 2         12 elsif ( defined @{ $self->{config}->{duration} }[0]
269 0         0 and @{ $self->{config}->{duration} }[0] == 0 ) {
270 0         0 die 'bad definition of sweep parameters: duration == 0 not allowed';
271             }
272 2         10 elsif ( defined @{ $self->{config}->{rate} }[0]
273 2         10 and @{ $self->{config}->{rate} }[0] == 0 ) {
274 0         0 die 'bad definition of sweep parameters: rate == 0 not allowed';
275             }
276 2         8 elsif ( defined @{ $self->{config}->{duration} }[0] ) {
277 0         0 foreach my $i ( 0 .. $length_points - 1 ) {
278 0         0 @{ $self->{config}->{rate} }[$i]
279 0         0 = abs(@{ $self->{config}->{points} }[ $i + 1 ]
280 0         0 - @{ $self->{config}->{points} }[$i] )
281 0         0 / @{ $self->{config}->{duration} }[$i];
  0         0  
282             }
283             }
284 2         8 elsif ( defined @{ $self->{config}->{rate} }[0] ) {
285 2         6 foreach my $i ( 0 .. $length_points - 1 ) {
286 4         13 @{ $self->{config}->{duration} }[$i]
287 4         10 = abs(@{ $self->{config}->{points} }[ $i + 1 ]
288 4         15 - @{ $self->{config}->{points} }[$i] )
289 4         9 / @{ $self->{config}->{rate} }[$i];
  4         19  
290             }
291             }
292              
293             # calculate stepwidth from Number_of_Points and vise versa:
294 2 50 33     9 if ( defined @{ $self->{config}->{stepwidth} }[0]
  2 50       20  
    50          
295 2         18 and defined @{ $self->{config}->{number_of_points} }[0] ) {
296 0         0 die
297             'inconsistent definition of sweep_config_data: step as well as number_of_points defined. Use only one of both.';
298             }
299 2         11 elsif ( defined @{ $self->{config}->{number_of_points} }[0] ) {
300 0         0 unshift( @{ $self->{config}->{number_of_points} }, 1 );
  0         0  
301 0         0 foreach my $i ( 1 .. $length_points - 1 ) {
302 0         0 @{ $self->{config}->{stepwidth} }[ $i - 1 ]
303 0         0 = abs(@{ $self->{config}->{points} }[ $i + 1 ]
304 0         0 - @{ $self->{config}->{points} }[$i] )
305 0         0 / @{ $self->{config}->{number_of_points} }[$i];
  0         0  
306             }
307             }
308 2         17 elsif ( defined @{ $self->{config}->{stepwidth} }[0] ) {
309 2         7 foreach my $i ( 1 .. $length_points - 1 ) {
310 2         6 @{ $self->{config}->{number_of_points} }[ $i - 1 ]
311 2         6 = abs(@{ $self->{config}->{points} }[ $i + 1 ]
312 2         6 - @{ $self->{config}->{points} }[$i] )
313 2         5 / @{ $self->{config}->{stepwidth} }[$i];
  2         7  
314             }
315             }
316 2         4 shift @{ $self->{config}->{points} };
  2         5  
317              
318             # Calculations and checks depending on the selected sweep mode:
319 2 50       16 if ( $self->{config}->{mode} eq 'continuous' ) {
    50          
    0          
320 0 0 0     0 if ( not defined @{ $self->{config}->{rate} }[0]
  0         0  
321 0         0 or not defined @{ $self->{config}->{duration} }[0] ) {
322 0         0 die
323             "inconsistent definition of sweep_config_data: for sweep_mode 'continuous' you have to define the rate or the duration for the sweep.";
324             }
325             }
326             elsif ( $self->{config}->{mode} eq 'step' ) {
327 2         8 $self->{config}->{interval} = [0];
328 2 50 33     5 if ( not defined @{ $self->{config}->{stepwidth} }[0]
  2         34  
329 2         13 or not defined @{ $self->{config}->{number_of_points} }[0] ) {
330 0         0 die
331             "inconsistent definition of sweep_config_data: for sweep_mode 'step' you have to define the setp-size or the number_of_points.";
332             }
333              
334             # calculate each point/rate/stepsign/duration in step-sweep:
335 2         4 my $temp_points = ();
336 2         4 my $temp_rate = ();
337 2         4 my $temp_sweepsigns = ();
338 2         10 my $temp_duration = ();
339              
340 2         12 foreach my $i ( 0 .. $length_points - 2 ) {
341             my $nop = abs(
342             (
343 2         6 @{ $self->{config}->{points} }[ $i + 1 ]
344 2         14 - @{ $self->{config}->{points} }[$i]
345 2         6 ) / @{ $self->{config}->{stepwidth} }[$i]
  2         8  
346             );
347 2         45 $nop = ceil($nop);
348              
349 2         9 my $point = @{ $self->{config}->{points} }[$i];
  2         8  
350 2         10 for ( my $j = 0; $j <= $nop; $j++ ) {
351 22 50 66     28 if ( $point != @{$temp_points}[-1]
  22         52  
352 2         9 or not defined @{$temp_points}[-1] ) {
353 22         28 push( @{$temp_points}, $point );
  22         46  
354             push(
355 22         36 @{$temp_rate},
356 22         29 @{ $self->{config}->{rate} }[ $i + 1 ]
  22         39  
357             );
358             push(
359 22         32 @{$temp_duration},
360 22         33 @{ $self->{config}->{duration} }[ $i + 1 ]
361 22         29 / @{ $self->{config}->{number_of_points} }[$i]
  22         51  
362             );
363             push(
364 22         29 @{$temp_sweepsigns},
365 22         39 @{ $self->{config}->{sweepsigns} }[$i]
  22         41  
366             );
367             }
368 22         36 $point += @{ $self->{config}->{stepwidth} }[$i]
369 22         32 * @{ $self->{config}->{sweepsigns} }[$i];
  22         50  
370             }
371 2         6 @{$temp_points}[-1] = @{ $self->{config}->{points} }[ $i + 1 ];
  2         7  
  2         5  
372             }
373 2         5 pop @{$temp_rate};
  2         4  
374 2         3 pop @{$temp_duration};
  2         3  
375 2         5 pop @{$temp_sweepsigns};
  2         4  
376 2         3 unshift( @{$temp_rate}, @{ $self->{config}->{rate} }[0] );
  2         4  
  2         7  
377 2         13 unshift( @{$temp_duration}, @{ $self->{config}->{duration} }[0] );
  2         5  
  2         6  
378              
379             #unshift ( @{$temp_sweepsigns}, @{$self->{config}->{sweepsigns}}[0]);
380              
381 2         6 $self->{config}->{points} = $temp_points;
382 2         4 $self->{config}->{rate} = $temp_rate;
383 2         5 $self->{config}->{duration} = $temp_duration;
384 2         5 $self->{config}->{sweepsigns} = $temp_sweepsigns;
385             }
386             elsif ( $self->{config}->{mode} eq 'list' ) {
387 0         0 $self->{config}->{interval} = [0];
388 0 0       0 if ( not defined @{ $self->{config}->{rate} }[0] ) {
  0         0  
389 0         0 die
390             "inconsistent definition of sweep_config_data: 'rate' needs to be defined in sweep mode 'list'";
391             }
392             }
393              
394             # check if instrument is supported:
395 2 50 33     5 if (
396 2         10 defined @{ $self->{config}->{allowed_instruments} }[0]
397 19         47 and not( grep { $_ eq ref( $self->{config}->{instrument} ) }
398 2         19 @{ $self->{config}->{allowed_instruments} } )
399             ) {
400 0         0 die
401             "inconsistent definition of sweep_config_data: Instrument (ref($self->{config}->{instrument})) is not supported by Sweep.";
402             }
403              
404             # check if sweep-mode is supported:
405 2 50 33     9 if (
406 2         10 defined @{ $self->{config}->{allowed_sweep_modes} }[0]
407 6         33 and not( grep { $_ eq $self->{config}->{mode} }
408 2         5 @{ $self->{config}->{allowed_sweep_modes} } )
409             ) {
410 0         0 die
411             "inconsistent definition of sweep_config_data: Sweep mode $self->{config}->{mode} is not supported by Sweep.";
412             }
413              
414             # adjust repetitions in case of Backsweep selected:
415              
416 2 50       11 if ( $self->{config}->{backsweep} == 1 ) {
417 0         0 $self->{config}->{repetitions} *= 2;
418             }
419              
420             }
421              
422             sub prepare_backsweep {
423 0     0 0 0 my $self = shift;
424 0         0 my $points = ();
425 0         0 my $rates = ();
426 0         0 my $durations = ();
427 0         0 foreach my $point ( @{ $self->{config}->{points} } ) {
  0         0  
428 0         0 unshift( @{$points}, $point );
  0         0  
429             }
430 0         0 foreach my $rate ( @{ $self->{config}->{rate} } ) {
  0         0  
431 0         0 unshift( @{$rates}, $rate );
  0         0  
432             }
433 0         0 foreach my $duration ( @{ $self->{config}->{duration} } ) {
  0         0  
434 0         0 unshift( @{$durations}, $duration );
  0         0  
435             }
436              
437 0         0 unshift( @{$rates}, pop( @{$rates} ) );
  0         0  
  0         0  
438 0         0 unshift( @{$durations}, 0 );
  0         0  
439 0         0 pop( @{$durations} );
  0         0  
440              
441             #print "Points @{$points} \n";
442             #print "rate @{$rate} \n";
443             #print "duration @{$duration} \n";
444 0         0 $self->{config}->{points} = $points;
445 0         0 $self->{config}->{rate} = $rates;
446 0         0 $self->{config}->{duration} = $durations;
447              
448             }
449              
450             sub add_DataFile {
451 2     2 1 21 my $self = shift;
452 2         4 my $DataFile = shift;
453              
454 2         4 push( @{ $self->{filenamebase} }, $DataFile->{filenamebase} );
  2         12  
455              
456 2         5 push( @{ $self->{DataFiles} }, $DataFile );
  2         7  
457 2         4 $self->{DataFile_counter}++;
458              
459 2         8 @{ $self->{LOG} }[ $self->{DataFile_counter} ] = {};
  2         6  
460              
461 2         6 return $self;
462             }
463              
464             sub start {
465 2     2 1 14 my $self = shift;
466 2         17 ReadMode('cbreak');
467              
468 2         82 unshift( @{$ACTIVE_SWEEPS}, $self );
  2         9  
469              
470             # calculate duration for the defined sweep:
471             #$self->estimate_sweep_duration();
472 2         5 foreach my $slave ( @{ $self->{slaves} } ) {
  2         8  
473              
474             #$slave->estimate_sweep_duration();
475             }
476              
477             # show estimated sweep duration:
478             #my $sweep_structure = $self->sweep_structure();
479              
480             # create header for each DataFile:
481 2         5 foreach my $file ( @{ $self->{DataFiles} } ) {
  2         6  
482 2         4 foreach my $instrument ( @{ ${Lab::Instrument::INSTRUMENTS} } ) {
  2         8  
483              
484             #print $instrument."\n";
485 0         0 $file->add_header( $instrument->create_header() );
486             }
487             }
488              
489 2 50       3 if ( not defined @{ $self->{slaves} }[0] ) {
  2         9  
490 2 50       10 if ( $self->{DataFile_counter} <= 0 ) {
491 0         0 print new Lab::Exception::Warning( error => "Attention: "
492             . ref($self)
493             . " has no DataFile ! \n" );
494             }
495 2 50       6 if ( defined @{ $self->{filename_extensions} }[0] ) {
  2         9  
496 0         0 foreach my $DataFile ( @{ $self->{DataFiles} } ) {
  0         0  
497 0         0 my $filenamebase = $DataFile->{filenamebase};
498 0         0 my $new_filenamebase
499             = $self->add_filename_extensions($filenamebase);
500 0 0       0 if ( $new_filenamebase ne $DataFile->{file} ) {
501 0         0 $DataFile->change_filenamebase($new_filenamebase);
502             }
503             }
504             }
505              
506             # elsif ($self->{config}->{separate_files} == 1) {
507             # foreach my $DataFile (@{$self->{DataFiles}}) {
508             # my $filenamebase = $DataFile->{filenamebase};
509             # $DataFile->change_filenamebase($filenamebase);
510             # }
511             # }
512              
513             }
514              
515             # link break signals to default functions:
516 2         26 $SIG{BREAK} = \&enable_pause;
517              
518             #$SIG{INT} = \&abort;
519              
520 2   66     16 for (
521             my $i = 1;
522             ( $i <= $self->{config}->{repetitions} )
523             or ( $self->{config}->{repetitions} < 0 );
524             $i++
525             ) {
526 2         5 $self->{repetition}++;
527 2         5 foreach my $file ( @{ $self->{DataFiles} } ) {
  2         8  
528 2         18 $file->start_block();
529             }
530 2         7 $self->{iterator} = 0;
531 2         8 $self->{sequence} = 0;
532 2         19 $self->before_loop();
533 2         9 $self->go_to_sweep_start();
534 2         22 $self->delay( $self->{config}->{delay_before_loop} );
535 2         5 my $before_loop = $self->{config}{before_loop};
536              
537 2 50       14 if ($before_loop) {
538 0 0       0 if ( ref $before_loop ne 'CODE' ) {
539 0         0 croak "'before_loop' argument must be a coderef";
540             }
541 0         0 $self->$before_loop();
542             }
543              
544             # continuous sweep:
545 2 50       11 if ( $self->{config}->{mode} eq 'continuous' ) {
546 0         0 $self->start_continuous_sweep();
547             }
548 2         11 $self->{Time_start} = time();
549 2         13 $self->{Date_start}, $self->{TimeStamp_start} = timestamp();
550 2         9 $self->{loop}->{t0} = $self->{Time_start};
551              
552 2         7 $self->{active} = 1;
553              
554 2         11 while (1) {
555 22         72 $self->in_loop();
556              
557             # step mode:
558 22 50       124 if ( $self->{config}->{mode} =~ /step|list/ ) {
559 22         75 $self->go_to_next_step();
560 22         277 $self->delay( $self->{config}->{delay_in_loop} );
561             }
562 22         74 $self->{Time} = time() - $self->{Time_start};
563 22         66 $self->{Date}, $self->{TimeStamp} = timestamp();
564              
565             # Master mode: call slave measurements if defined
566 22 50       44 if ( defined @{ $self->{slaves} }[0] ) {
  22         66  
567 0         0 my $extension = $self->get_filename_extension();
568 0         0 foreach my $slave ( @{ $self->{slaves} } ) {
  0         0  
569              
570             my $extensions
571 0         0 = dclone( \@{ $self->{filename_extensions} } );
  0         0  
572 0         0 push( @{$extensions}, $extension );
  0         0  
573              
574 0         0 $slave->{filename_extensions} = $extensions;
575              
576 0         0 $slave->start($self);
577             }
578             }
579              
580             # Slave mode: do measurement
581             else {
582 22         31 my $i = 1;
583 22         32 foreach my $DataFile ( @{ $self->{DataFiles} } ) {
  22         50  
584              
585 22         72 $DataFile->{measurement}->($self);
586 22 50       70 if ( $DataFile->{autolog} == 1 ) {
587 22         50 $DataFile->LOG( $self->create_LOG_HASH($i) );
588             }
589              
590 22         75 $i++;
591             }
592             }
593              
594             # exit loop:
595 22 100 66     79 if ( $self->exit_loop() or $self->{last} ) {
596 2         9 $self->{last} = 0;
597 2         7 last;
598             }
599              
600             # pause:
601 20 50 33     148 if ( $self->{config}->{mode} =~ /step|list/ and $PAUSE ) {
602 0         0 $self->pause();
603 0         0 $PAUSE = 0;
604             }
605              
606             # check loop duratioin:
607 20         41 $self->{iterator}++;
608 20         76 $self->check_loop_duration();
609             }
610              
611 2         6 $self->{active} = 0;
612              
613 2         21 $self->after_loop();
614 2 50       8 if ($PAUSE) {
615 0         0 $self->pause();
616 0         0 $PAUSE = 0;
617             }
618 2         9 $self->delay( $self->{config}->{delay_after_loop} );
619              
620             # prepare_backsweep:
621 2 50       33 if ( $self->{config}->{backsweep} > 0 ) {
622 0         0 $self->prepare_backsweep();
623             }
624              
625             }
626              
627             # finish measurement:
628 2         19 $self->finish();
629              
630 2         73 return $self;
631              
632             }
633              
634             sub delay {
635 26     26 0 43 my $self = shift;
636 26         40 my $delay = shift;
637              
638 26 50       56 if ( $delay <= 0 ) {
    0          
639 26         52 return;
640             }
641             elsif ( $delay > 1 ) {
642 0         0 my_sleep( $delay, $self, \&user_command );
643             }
644             else {
645 0         0 my_usleep( $delay * 1e6, $self, \&user_command );
646             }
647              
648             }
649              
650             sub estimate_sweep_duration {
651 0     0 0 0 my $self = shift;
652 0         0 my $duration = 0;
653              
654 0         0 $duration += $self->{config}->{delay_before_loop};
655              
656 0 0       0 if ( $self->{config}->{mode} =~ /conti/ ) {
    0          
657 0         0 foreach ( @{ $self->{config}->{duration} } ) {
  0         0  
658 0         0 $duration += $_;
659             }
660             }
661             elsif ( $self->{config}->{mode} =~ /step|list/ ) {
662 0         0 foreach ( @{ $self->{config}->{duration} } ) {
  0         0  
663 0         0 $duration += $_;
664 0         0 $duration += $self->{config}->{delay_in_loop};
665             }
666             }
667              
668 0         0 $duration += $self->{config}->{delay_after_loop};
669 0         0 $duration *= $self->{config}->{repetitions};
670              
671 0         0 $self->{config}->{estimated_sweep_duration} = $duration;
672 0         0 return $duration;
673              
674             }
675              
676             sub estimate_total_sweep_duration {
677 0     0 0 0 my $self = shift;
678              
679 0 0       0 if ( not defined $self->{master} ) {
680 0         0 my $duration_total = 0;
681 0         0 foreach my $slave ( @{ $self->{slaves} } ) {
  0         0  
682 0         0 $duration_total += $slave->{config}->{estimated_sweep_duration};
683             }
684              
685             #print "duration_total_1: $duration_total\n";
686 0         0 my $number_of_steps = @{ $self->{config}->{duration} } - 1;
  0         0  
687 0         0 $duration_total *= $number_of_steps;
688              
689             #print "duration_total_2: $duration_total\n";
690 0         0 $duration_total += $self->{config}->{estimated_sweep_duration};
691              
692             #print "duration_total_3: $duration_total\n";
693 0         0 $duration_total *= $self->{config}->{repetitions};
694              
695             #print "duration_total_4: $duration_total\n";
696 0         0 $self->{config}->{estimated_sweep_duration_total} = $duration_total;
697             }
698              
699             }
700              
701             sub sweep_structure {
702 0     0 0 0 my $self = shift;
703 0         0 my $text = "";
704              
705 0 0       0 if ( not defined $self->{master} ) {
706 0         0 $self->estimate_total_sweep_duration();
707              
708 0         0 $text
709             .= "\n\n\n=====================================================================\n";
710 0         0 $text
711             .= "=================== Master/Slave Sweep ============================\n";
712 0         0 $text
713             .= "=====================================================================\n\n\n";
714 0         0 $text .= "=========================\n";
715 0         0 $text .= " Master = $self->{config}->{id}\n";
716 0         0 $text .= "=========================\n";
717 0         0 $text .= "\t|\n";
718 0         0 $text .= "\t|\n";
719             $text .= "\t|--> Instrument = "
720 0         0 . ref( $self->{config}->{instrument} ) . "\n";
721              
722             # while ( my ($key,$value) = each %{$self->{config}} )
723             # {
724             # if ( ref($value) eq "ARRAY" )
725             # {
726             # $text .= "\t|--> $key = @{$value}\n";
727             # }
728             # elsif ( ref($value) eq "HASH" )
729             # {
730             # $text .= "\t|--> $key = %{$value}\n";
731             # }
732             # else
733             # {
734             # $text .= "\t|--> $key = $value\n";
735             # }
736             # }
737 0         0 $text .= "\t|--> Mode = $self->{config}->{mode}\n";
738 0 0       0 if ( $self->{config}->{mode} =~ /conti/ ) {
739 0         0 $text .= "\t|--> Interval = $self->{config}->{interval}\n";
740             }
741 0         0 $text .= "\t|--> Points = @{$self->{config_original}->{points}}\n";
  0         0  
742 0 0       0 if ( $self->{config}->{mode} =~ /step/ ) {
743 0         0 $text .= "\t|--> stepwidth = @{$self->{config}->{stepwidth}}\n";
  0         0  
744             }
745 0         0 $text .= "\t|--> rate = @{$self->{config_original}->{rate}}\n";
  0         0  
746 0         0 $text
747 0         0 .= "\t|--> duration = @{$self->{config_original}->{duration}}\n";
748 0         0 $text
749             .= "\t|--> Delays (before, in, after) loop = $self->{config}->{delay_before_loop}, $self->{config}->{delay_in_loop}, $self->{config}->{delay_after_loop}\n";
750 0         0 $text .= "\t|--> Backsweep = $self->{config}->{backsweep}\n";
751 0         0 $text
752             .= "\t|--> Repetitions = $self->{config_original}->{repetitions}\n";
753             $text
754             .= "\t|--> Estimated Duration = "
755             . seconds2time( $self->{config}->{estimated_sweep_duration} )
756 0         0 . "\n";
757 0         0 $text .= "\t|----------------------------------------------------\n";
758              
759 0         0 foreach my $slave ( @{ $self->{slaves} } ) {
  0         0  
760 0         0 $text .= "\t\t|\n";
761 0         0 $text .= "\t\t|\n";
762 0         0 $text .= "\t=========================\n";
763 0         0 $text .= "\t Slave = $slave->{config}->{id}\n";
764 0         0 $text .= "\t=========================\n";
765 0         0 $text .= "\t\t|\n";
766 0         0 $text .= "\t\t|\n";
767             $text .= "\t\t|--> Instrument = "
768 0         0 . ref( $slave->{config}->{instrument} ) . "\n";
769 0         0 $text .= "\t\t|--> Mode = $slave->{config}->{mode}\n";
770              
771 0 0       0 if ( $slave->{config}->{mode} =~ /conti/ ) {
772 0         0 $text .= "\t\t|--> Interval = $slave->{config}->{interval}\n";
773             }
774             $text
775 0         0 .= "\t\t|--> Points = @{$slave->{config_original}->{points}}\n";
  0         0  
776 0 0       0 if ( $slave->{config}->{mode} =~ /step/ ) {
777 0         0 $text
778 0         0 .= "\t\t|--> stepwidth = @{$slave->{config}->{stepwidth}}\n";
779             }
780 0         0 $text .= "\t\t|--> rate = @{$slave->{config_original}->{rate}}\n";
  0         0  
781 0         0 $text
782 0         0 .= "\t\t|--> duration = @{$slave->{config_original}->{duration}}\n";
783 0         0 $text
784             .= "\t\t|--> Delays (before, in, after) loop = $slave->{config}->{delay_before_loop}, $slave->{config}->{delay_in_loop}, $slave->{config}->{delay_after_loop}\n";
785 0         0 $text .= "\t\t|--> Backsweep = $slave->{config}->{backsweep}\n";
786 0         0 $text
787             .= "\t\t|--> Repetitions = $slave->{config_original}->{repetitions}\n";
788             $text
789             .= "\t\t|--> Estimated Duration = "
790             . seconds2time( $slave->{config}->{estimated_sweep_duration} )
791 0         0 . "\n";
792 0         0 $text
793             .= "\t\t|----------------------------------------------------\n";
794             }
795 0         0 $text .= "\n\n";
796             $text
797             .= "Estimated Duration for Master/Slave-Sweep: "
798             . seconds2time(
799             $self->{config}->{estimated_sweep_duration_total} )
800 0         0 . "\n\n\n";
801 0         0 $text
802             .= "=====================================================================\n";
803 0         0 $text
804             .= "=====================================================================\n\n";
805              
806 0         0 foreach my $slave ( @{ $self->{slaves} } ) {
  0         0  
807 0         0 foreach my $file ( @{ $slave->{DataFiles} } ) {
  0         0  
808 0         0 $file->add_header($text);
809             }
810             }
811 0         0 print $text;
812             }
813             else {
814 0         0 return undef;
815             }
816              
817             }
818              
819             sub add_filename_extensions {
820 0     0 0 0 my $self = shift;
821              
822 0         0 my $filenamebase = shift;
823              
824 0         0 $filenamebase =~ /(.+)(\/|\/\/|\\|\\\\)(.+)\b/;
825              
826 0         0 my $directory = $1;
827 0         0 my $filename = $3;
828 0         0 my $filetype = ".dat";
829 0 0       0 if ( $filename =~ /(.+)(\..+)\b/ ) {
830 0         0 $filename = $1;
831 0         0 $filetype = $2;
832             }
833              
834 0         0 my $extension_length = @{ $self->{filename_extensions} };
  0         0  
835              
836 0 0       0 if ( $self->{config}->{separate_files} == 0 ) {
    0          
837              
838 0         0 for ( my $i = 0; $i < $extension_length - 2; $i++ ) {
839 0         0 $directory .= "/" . @{ $self->{filename_extensions} }[$i];
  0         0  
840             }
841              
842 0         0 for ( my $i = 0; $i < $extension_length - 1; $i++ ) {
843 0         0 $filename .= "_" . @{ $self->{filename_extensions} }[$i];
  0         0  
844             }
845             }
846             elsif ( $self->{config}->{separate_files} == 1 ) {
847              
848 0         0 for ( my $i = 0; $i < $extension_length - 1; $i++ ) {
849 0         0 $directory .= "/" . @{ $self->{filename_extensions} }[$i];
  0         0  
850             }
851 0         0 for ( my $i = 0; $i < $extension_length; $i++ ) {
852 0         0 $filename .= "_" . @{ $self->{filename_extensions} }[$i];
  0         0  
853             }
854             }
855              
856 0 0       0 if ( $self->{config}->{folders} == 0 ) {
857 0         0 $directory = $1; #do not create folder
858             }
859              
860 0         0 return $directory . "/" . $filename . $filetype;
861             }
862              
863             sub get_value {
864 0     0 1 0 my $self = shift;
865 0         0 return @{ $self->{config}->{points} }[ $self->{iterator} ];
  0         0  
866             }
867              
868             sub enable_pause {
869 0     0 0 0 print "Sweep will be paused after finishing this sweep. \n";
870 0         0 $PAUSE = 1;
871             }
872              
873             sub pause {
874 0     0 0 0 my $self = shift;
875 0         0 print "\n\nPAUSE: continue with <ENTER>\n";
876 0         0 ReadMode('normal');
877 0         0 <>;
878 0         0 ReadMode('cbreak');
879 0         0 $PAUSE = 0;
880             }
881              
882             sub finish {
883 2     2 0 4 my $self = shift;
884              
885             # delete entry in ACTIVE_SWEEPS:
886 2         4 foreach my $i ( 0 .. ( my $length = @{$ACTIVE_SWEEPS} ) - 1 ) {
  2         11  
887              
888             #print "$i FINISH: ".$self."\t".@{$ACTIVE_SWEEPS}[$i]."\n";
889             #print "active array before: {@{$ACTIVE_SWEEPS}}\n";
890 2 50       7 if ( $self eq @{$ACTIVE_SWEEPS}[$i] ) {
  2         11  
891              
892             #@LIST = splice(@ARRAY, OFFSET, LENGTH, @REPLACE_WITH);
893 2         5 @{$ACTIVE_SWEEPS} = splice( @{$ACTIVE_SWEEPS}, $i + 1, 1 );
  2         7  
  2         10  
894              
895             #print "active array after: {@{$ACTIVE_SWEEPS}}\n";
896             }
897             }
898              
899             # save plot image for all defined measurements:
900 2         5 foreach my $file ( @{ $self->{DataFiles} } ) {
  2         7  
901 2         14 foreach ( 0 .. $file->{plot_count} - 1 ) {
902 0 0       0 if ( $file->{logger}->{plots}->[$_]->{autosave} eq 'always' ) {
903 0         0 $file->save_plot($_);
904             }
905             }
906             }
907              
908             # close DataFiles for all defined slaves:
909 2         6 foreach my $slave ( @{ $self->{slaves} } ) {
  2         7  
910 0         0 foreach my $file ( @{ $slave->{DataFiles} } ) {
  0         0  
911 0         0 foreach ( 0 .. $file->{plot_count} - 1 ) {
912              
913 0 0       0 if ( $file->{logger}->{plots}->[$_]->{autosave} eq 'last' ) {
914 0         0 $file->save_plot($_);
915             }
916             }
917             }
918             }
919              
920             # close DataFiles of Master:
921 2 50       12 if ( not defined $self->{master} ) {
922 2         6 foreach my $file ( @{ $self->{DataFiles} } ) {
  2         7  
923 2         8 foreach ( 0 .. $file->{plot_count} - 1 ) {
924 0 0       0 if ( $file->{logger}->{plots}->[$_]->{autosave} eq 'last' ) {
925 0         0 $file->save_plot($_);
926             }
927             }
928             }
929             }
930              
931 2         10 ReadMode('normal');
932             }
933              
934             sub active {
935 0     0 0 0 my $self = shift;
936 0         0 return $self->{active};
937             }
938              
939             sub abort {
940              
941 2     2 0 5 foreach my $sweep ( @{$ACTIVE_SWEEPS} ) {
  2         6  
942 0         0 $sweep->exit();
943             }
944              
945 2         8 while ( @{$ACTIVE_SWEEPS}[0] ) {
  2         10  
946 0         0 my $sweep = @{$ACTIVE_SWEEPS}[0];
  0         0  
947 0         0 $sweep->finish();
948             }
949              
950 2         58 exit;
951             }
952              
953             sub stop {
954              
955 0     0 0 0 print "Sweep stopped by User!\n";
956 0         0 foreach my $sweep ( @{$ACTIVE_SWEEPS} ) {
  0         0  
957 0         0 $sweep->exit();
958             }
959              
960             }
961              
962             sub exit {
963 0     0 0 0 return shift;
964             }
965              
966             sub last {
967 0     0 1 0 my $self = shift;
968 0         0 $self->{last} = 1;
969 0         0 return;
970             }
971              
972             sub before_loop {
973 2     2 0 5 return shift;
974             }
975              
976             sub go_to_sweep_start {
977 0     0 0 0 return shift;
978             }
979              
980             sub start_continuous_sweep {
981 0     0 0 0 return shift;
982             }
983              
984             sub in_loop {
985 22     22 0 34 return shift;
986             }
987              
988             sub go_to_next_step {
989 0     0 0 0 return shift;
990             }
991              
992             sub after_loop {
993 2     2 0 4 return shift;
994             }
995              
996             sub exit_loop {
997 0     0 0 0 return shift;
998             }
999              
1000             sub check_loop_duration {
1001              
1002 20     20 0 39 my $self = shift;
1003              
1004 20         63 my $char = ReadKey(1e-5);
1005 20 50       732 if ( defined $char ) {
1006 0         0 $self->user_command($char);
1007             }
1008              
1009 20 50       48 if ( @{ $self->{config}->{interval} }[ $self->{sequence} ] == 0 ) {
  20         71  
1010 20         49 return 0;
1011             }
1012              
1013 0 0       0 if ( $self->{config}->{mode} =~ /step|list/ ) {
1014 0         0 return 0;
1015             }
1016              
1017 0         0 $self->{loop}->{t1} = time();
1018              
1019 0 0       0 if ( not defined $self->{loop}->{t0} ) {
1020 0         0 $self->{loop}->{t0} = time();
1021 0         0 return 0;
1022             }
1023              
1024 0 0       0 if ( ( $self->{loop}->{t1} - $self->{loop}->{t0} )
1025 0         0 > @{ $self->{config}->{interval} }[ $self->{sequence} ] ) {
1026             carp( "WARNING: Measurement Loop takes more time ("
1027             . ( $self->{loop}->{t1} - $self->{loop}->{t0} )
1028 0         0 . ") than specified by measurement intervall (@{$self->{config}->{sequence}}[$self->{iterator}]).\n"
  0         0  
1029             );
1030             }
1031             my $delta_time = ( $self->{loop}->{t1} - $self->{loop}->{t0} )
1032 0         0 + $self->{loop}->{overtime};
1033              
1034 0 0 0     0 if ( defined $self->{config}->{instrument}
1035             and $self->{config}->{instrument}->can("active") ) {
1036 0         0 while (
1037             (
1038 0         0 @{ $self->{config}->{interval} }[ $self->{sequence} ]
1039             - $delta_time
1040             ) > 0.2
1041             ) {
1042 0         0 my $time0 = time();
1043 0         0 $self->{config}->{instrument}->active();
1044 0         0 $delta_time = $delta_time + ( ( time() - $time0 ) );
1045             }
1046             }
1047              
1048 0 0       0 if ( $delta_time > @{ $self->{config}->{interval} }[ $self->{sequence} ] )
  0         0  
1049             {
1050             $self->{loop}->{overtime} = $delta_time
1051 0         0 - @{ $self->{config}->{interval} }[ $self->{sequence} ];
  0         0  
1052 0         0 $delta_time = @{ $self->{config}->{interval} }[ $self->{sequence} ];
  0         0  
1053              
1054             #warn "WARNING: Measurement Loop takes more time ($self->{loop}->{overtime}) than specified by measurement intervall (@{$self->{config}->{sequence}}[$self->{iterator}]).\n";
1055             }
1056             else {
1057 0         0 $self->{loop}->{overtime} = 0;
1058             }
1059              
1060             usleep(
1061             (
1062 0         0 @{ $self->{config}->{interval} }[ $self->{sequence} ]
  0         0  
1063             - $delta_time
1064             ) * 1e6
1065             );
1066              
1067 0         0 $self->{loop}->{t0} = time();
1068 0         0 return $delta_time;
1069              
1070             }
1071              
1072             sub user_command {
1073 0     0 0 0 my $self = shift;
1074 0         0 my $cmd = shift;
1075              
1076 0         0 print "user_command = " . $cmd . "\n";
1077              
1078 0 0       0 if ( $cmd eq "g" ) {
    0          
1079 0         0 foreach my $datafile ( @{ $self->{DataFiles} } ) {
  0         0  
1080 0         0 $datafile->gnuplot_restart();
1081             }
1082             }
1083             elsif ( $cmd eq "p" ) {
1084              
1085             #foreach my $datafile (@{$self->{DataFiles}})
1086             # {
1087 0         0 @{ $self->{DataFiles} }[0]->gnuplot_pause();
  0         0  
1088              
1089             # }
1090             }
1091              
1092 0         0 return 1;
1093              
1094             }
1095              
1096             sub LOG {
1097              
1098 44     44 1 237 my $self = shift;
1099 44         87 my @args = @_;
1100              
1101 44 50       114 if ( ref( $args[0] ) eq "HASH" ) {
1102 44 100       92 my $file = ( defined $args[1] ) ? $args[1] : 0;
1103 44 50       71 if ( not defined @{ $self->{DataFiles} }[ $args[1] - 1 ] ) {
  44         116  
1104 0         0 Lab::Exception::Warning->throw(
1105             "DataFile $file is not defined! \n");
1106             }
1107 44         84 while ( my ( $key, $value ) = each %{ $args[0] } ) {
  154         441  
1108 110         144 @{ $self->{LOG} }[$file]->{$key} = $value;
  110         267  
1109             }
1110             }
1111             else {
1112             # for old style: LOG("column_name", "value", "File")
1113 0 0       0 my $file = ( defined $args[2] ) ? $args[2] : 0;
1114 0 0       0 if ( not defined @{ $self->{DataFiles} }[ $args[2] - 1 ] ) {
  0         0  
1115 0         0 Lab::Exception::Warning->throw(
1116             "DataFile $file is not defined! \n");
1117             }
1118 0         0 @{ $self->{LOG} }[$file]->{ $args[0] } = $args[1];
  0         0  
1119             }
1120             }
1121              
1122             sub set_autolog {
1123 0     0 0 0 my $self = shift;
1124 0         0 my $value = shift;
1125 0         0 my $file = shift;
1126              
1127 0 0 0     0 if ( not defined $file or $file == 0 ) {
    0          
1128 0         0 foreach my $DataFile ( @{ $self->{DataFiles} } ) {
  0         0  
1129 0         0 $DataFile->set_autolog($value);
1130             }
1131             }
1132 0         0 elsif ( defined @{ $self->{DataFiles} }[ $file - 1 ] ) {
1133 0         0 @{ $self->{DataFiles} }[ $file - 1 ]->set_autolog($value);
  0         0  
1134             }
1135             else {
1136 0         0 print new Lab::Exception::Warning(
1137             "DataFile $file is not defined! \n");
1138             }
1139              
1140 0         0 return $self;
1141             }
1142              
1143             sub skip_LOG {
1144 0     0 0 0 my $self = shift;
1145 0         0 my $file = shift;
1146              
1147 0 0 0     0 if ( not defined $file or $file == 0 ) {
    0          
1148 0         0 foreach my $DataFile ( @{ $self->{DataFiles} } ) {
  0         0  
1149 0         0 $DataFile->skiplog();
1150             }
1151             }
1152 0         0 elsif ( defined @{ $self->{DataFiles} }[ $file - 1 ] ) {
1153 0         0 @{ $self->{DataFiles} }[ $file - 1 ]->skiplog();
  0         0  
1154             }
1155             else {
1156 0         0 print new Lab::Exception::Warning(
1157             "DataFile $file is not defined! \n");
1158             }
1159              
1160 0         0 return $self;
1161             }
1162              
1163             sub write_LOG {
1164 22     22 0 30 my $self = shift;
1165 22         34 my $file = shift;
1166              
1167 22 50 33     55 if ( not defined $file or $file == 0 ) {
    0          
1168 22         35 my $i = 1;
1169 22         28 foreach my $DataFile ( @{ $self->{DataFiles} } ) {
  22         44  
1170 22         47 $DataFile->LOG( $self->create_LOG_HASH($i) );
1171 22         63 $i++;
1172             }
1173             }
1174 0         0 elsif ( defined @{ $self->{DataFiles} }[ $file - 1 ] ) {
1175 0         0 @{ $self->{DataFiles} }[ $file - 1 ]
  0         0  
1176             ->LOG( $self->create_LOG_HASH($file) );
1177             }
1178             else {
1179 0         0 print new Lab::Exception::Warning(
1180             "DataFile $file is not defined! \n");
1181             }
1182              
1183 22         112 return $self;
1184              
1185             }
1186              
1187             sub create_LOG_HASH {
1188 44     44 0 64 my $self = shift;
1189 44         63 my $file = shift;
1190              
1191 44         72 my $LOG_HASH = {};
1192              
1193 44         66 foreach
1194 44         67 my $column ( @{ @{ $self->{DataFiles} }[ $file - 1 ]->{COLUMNS} } ) {
  44         112  
1195 110 50       144 if ( defined @{ $self->{LOG} }[$file]->{$column} ) {
  110 50       216  
1196 0         0 $LOG_HASH->{$column} = @{ $self->{LOG} }[$file]->{$column};
  0         0  
1197             }
1198 110         215 elsif ( defined @{ $self->{LOG} }[0]->{$column} ) {
1199 110         174 $LOG_HASH->{$column} = @{ $self->{LOG} }[0]->{$column};
  110         266  
1200             }
1201             else {
1202 0 0 0     0 if ( exists @{ $self->{LOG} }[$file]->{$column}
  0         0  
1203 0         0 or exists @{ $self->{LOG} }[0]->{$column} ) {
1204 0         0 print new Lab::Exception::Warning(
1205             "Value for Paramter $column undefined\n");
1206             }
1207             else {
1208 0         0 print new Lab::Exception::Warning(
1209             "Paramter $column not found. Maybe a typing error??\n");
1210             }
1211 0         0 $LOG_HASH->{$column} = '?';
1212             }
1213             }
1214              
1215 44         162 return $LOG_HASH;
1216              
1217             }
1218              
1219             sub add_slave {
1220 0     0 0   my $self = shift;
1221 0           my $slave = shift;
1222              
1223 0 0         if ( not $self->{config}->{mode} =~ /step|list/ ) {
1224 0           Lab::Exception::Warning->throw( error =>
1225             "Can't add slave to master-sweep which is not in mode list or step."
1226             );
1227             }
1228              
1229 0           my $type = ref($slave);
1230 0 0         if ( $type =~ /^Lab::XPRESS::Sweep::Frame/ ) {
    0          
    0          
1231 0 0         if ( not defined $slave->{master} ) {
    0          
1232 0           Lab::Exception::Warning->throw(
1233             error => 'No master defined in Frame.' );
1234             }
1235 0           elsif ( not defined @{ $slave->{master}->{slaves} }[0] ) {
1236 0           Lab::Exception::Warning->throw(
1237             error => 'No slave(s) defined in Frame.' );
1238             }
1239              
1240 0           push( @{ $self->{slaves} }, $slave->{master} );
  0            
1241 0           $slave = $slave->{master};
1242              
1243 0           $self->{slave_counter}++;
1244              
1245             }
1246             elsif ( $type =~ /^Lab::XPRESS::Sweep/ ) {
1247 0 0         if ( defined $slave->{master} ) {
1248 0           Lab::Exception::Warning->throw( error =>
1249             "Cannot add slave sweep with an already defined master sweep ."
1250             );
1251             }
1252              
1253 0 0 0       if ( $slave->{DataFile_counter} <= 0
1254 0           and not defined @{ $slave->{slaves} }[-1] ) {
1255 0           while (1) {
1256 0           print
1257             "\n XPRESS::FRAME: -- Added slave sweep has no DataFile! Continue anyway (y/n) ?\n";
1258 0           my $answer = <>;
1259 0 0         if ( $answer =~ /y|Y/ ) {
    0          
1260 0           last;
1261             }
1262             elsif ( $answer =~ /n|N/ ) {
1263 0           exit;
1264             }
1265             }
1266             }
1267              
1268 0           push( @{ $self->{slaves} }, $slave );
  0            
1269 0           $self->{slave_counter}++;
1270             }
1271             elsif ( $type eq 'CODE' ) {
1272 0           $slave = new Lab::XPRESS::Sweep::Dummy($slave);
1273 0           push( @{ $self->{slaves} }, $slave );
  0            
1274 0           $self->{slave_counter}++;
1275             }
1276             else {
1277 0           Lab::Exception::Warning->throw(
1278             error => "slave object is of type $type. Cannot add slave." );
1279             }
1280              
1281 0           $slave->{master} = $self;
1282 0           $self->{DataFile_counter} = 0;
1283 0           $self->{DataFiles} = ();
1284              
1285 0           return $self;
1286             }
1287              
1288             sub get_filename_extension {
1289 0     0 0   my $self = shift;
1290 0           return $self->{config}->{filename_extension} . $self->get_value();
1291             }
1292              
1293             sub deep_copy {
1294              
1295             # if not defined then return it
1296 0 0 0 0 0   return undef if $#_ < 0 || !defined( $_[0] );
1297              
1298             # if not a reference then return the parameter
1299 0 0         return $_[0] if !ref( $_[0] );
1300 0           my $obj = shift;
1301 0 0         if ( UNIVERSAL::isa( $obj, 'SCALAR' ) ) {
    0          
    0          
    0          
1302 0           my $temp = deepcopy($$obj);
1303 0           return \$temp;
1304             }
1305             elsif ( UNIVERSAL::isa( $obj, 'HASH' ) ) {
1306 0           my $temp_hash = {};
1307 0           foreach my $key ( keys %$obj ) {
1308 0 0 0       if ( !defined( $obj->{$key} ) || !ref( $obj->{$key} ) ) {
1309 0           $temp_hash->{$key} = $obj->{$key};
1310             }
1311             else {
1312 0           $temp_hash->{$key} = deep_copy( $obj->{$key} );
1313             }
1314             }
1315 0           return $temp_hash;
1316             }
1317             elsif ( UNIVERSAL::isa( $obj, 'ARRAY' ) ) {
1318 0           my $temp_array = [];
1319 0           foreach my $array_val (@$obj) {
1320 0 0 0       if ( !defined($array_val) || !ref($array_val) ) {
1321 0           push( @$temp_array, $array_val );
1322             }
1323             else {
1324 0           push( @$temp_array, deep_copy($array_val) );
1325             }
1326             }
1327 0           return $temp_array;
1328             }
1329              
1330             # ?? I am uncertain about this one
1331             elsif ( UNIVERSAL::isa( $obj, 'REF' ) ) {
1332 0           my $temp = deepcopy($$obj);
1333 0           return \$temp;
1334             }
1335              
1336             # I guess that it is either CODE, GLOB or LVALUE
1337             else {
1338 0           return $obj;
1339             }
1340             }
1341              
1342             # Need to provide this or AUTOLOAD cannot find it and will die on object destruction.
1343       0     sub DESTROY {
1344              
1345             # do nothing
1346             }
1347              
1348             sub AUTOLOAD {
1349              
1350 0     0     my $self = shift;
1351 0 0         my $type = ref($self) or croak "\$self is not an object";
1352 0           my $value = undef;
1353              
1354 0           my $name = $AUTOLOAD;
1355 0           $name =~ s/.*://; # strip fully qualified portion
1356              
1357 0 0         if ( exists $self->{_permitted}->{$name} ) {
    0          
1358 0 0         if (@_) {
1359 0           return $self->{$name} = shift;
1360             }
1361             else {
1362 0           return $self->{$name};
1363             }
1364             }
1365             elsif ( $name =~ qr/^(set_)(.*)$/ ) {
1366              
1367             # There is a problem with deep copying of the instrument hash.
1368             # The elements of the hash could not be accessed correctly.
1369             # The workaround is to tempsave the hashref and put it back in
1370             # place. This should be only temporary though.
1371              
1372             # NOTE: changed the creation of config_original (in prepare_config function), so it is a copy
1373             # of {config} unsing dclone instead of deep_copy. I think this adresses the issue above.
1374              
1375 0           my $instrument = $self->{config}->{instrument};
1376              
1377 0 0         if ( exists $self->{config_original}->{$2} ) {
1378 0 0         if ( $self->active() ) {
1379 0           print Lab::Exception::Warning->new( error =>
1380             "WARNING: Cannot set parameter while sweep is active \n"
1381             );
1382 0           return;
1383             }
1384 0 0         if ( @_ == 1 ) {
1385 0           $self->{config_original}->{$2} = @_[0];
1386             }
1387             else {
1388 0           $self->{config_original}->{$2} = deep_copy( \@_ );
1389             }
1390              
1391 0           $self->{config} = deep_copy( $self->{config_original} );
1392              
1393             #use Data::Dumper;
1394              
1395             #print Dumper $self->{config};
1396              
1397 0           $self->{config}->{instrument} = $instrument;
1398 0           $self->prepaire_config();
1399             }
1400             else {
1401 0           print Lab::Exception::Warning->new(
1402             error => "WARNING: Parameter $2 does not exist \n" );
1403             }
1404             }
1405              
1406             else {
1407 0           Lab::Exception::Warning->throw( error => "AUTOLOAD in "
1408             . __PACKAGE__
1409             . " couldn't access field '${name}'.\n" );
1410             }
1411             }
1412              
1413             with 'Lab::XPRESS::Sweep::LogBlock';
1414              
1415             # sub timestamp {
1416              
1417             # my $self = shift;
1418             # my ($Sekunden, $Minuten, $Stunden, $Monatstag, $Monat,
1419             # $Jahr, $Wochentag, $Jahrestag, $Sommerzeit) = localtime(time);
1420              
1421             # $Monat+=1;
1422             # $Jahrestag+=1;
1423             # $Monat = $Monat < 10 ? $Monat = "0".$Monat : $Monat;
1424             # $Monatstag = $Monatstag < 10 ? $Monatstag = "0".$Monatstag : $Monatstag;
1425             # $Stunden = $Stunden < 10 ? $Stunden = "0".$Stunden : $Stunden;
1426             # $Minuten = $Minuten < 10 ? $Minuten = "0".$Minuten : $Minuten;
1427             # $Sekunden = $Sekunden < 10 ? $Sekunden = "0".$Sekunden : $Sekunden;
1428             # $Jahr+=1900;
1429              
1430             # return "$Monatstag.$Monat.$Jahr", "$Stunden:$Minuten:$Sekunden";
1431              
1432             # }
1433              
1434             1;
1435              
1436             __END__
1437              
1438             =pod
1439              
1440             =encoding UTF-8
1441              
1442             =head1 NAME
1443              
1444             Lab::XPRESS::Sweep - Base sweep class
1445              
1446             =head1 VERSION
1447              
1448             version 3.881
1449              
1450             =head1 SYNOPSIS
1451              
1452             Lab::XPRESS::Sweep is meant to be used as a base class for inheriting Sweeps.
1453             It should not be used directly.
1454              
1455             =head1 DESCRIPTION
1456              
1457             The Lab::XPRESS::Sweep class implements major parts of the Lab::XPRESS framework, a modular way for easy scripting measurements in perl and Lab::Measurement.
1458             Direct usage of this class would not result in any action. However it constitutes the fundament for more spezialized subclass Sweeps e.g. Lab::XPRESS::Sweep::Magnet.
1459              
1460             =head1 SWEEP PARAMETERS
1461              
1462             The configuration parameters are described in the particular subclasses (e.g. Lab::XPRESS::Sweep::Magnet).
1463              
1464             =head1 METHODS
1465              
1466             =head2 add_DataFile [Lab::XPRESS::Data::XPRESS_DataFile object]
1467              
1468             use this method to assign a DataFile object with a sweep if it operates as a slave or as a individual sweep. The sweep will call the user-defined measurment routine assigned with the DataFile.
1469             Sweeps accept multiple DataFile objects when add_DataFile is used repeatedly.
1470              
1471             =head2 start
1472              
1473             use this method to execute the sweep.
1474              
1475             =head2 get_value
1476              
1477             returns by default the current value of the points array or the current step. The method is intended to be overloaded by Sweep-Subclasses, in order to return the current value of the sweeping instrument.
1478              
1479             =head2 LOG [hash, int (default = 0)]
1480              
1481             use this method to store the data collected by user-defined measurment routine in the DataFile object.
1482              
1483             The hash has to look like this: $column_name => $value
1484             The column_name has to be one of the previously defined columnames in the DataFile object.
1485              
1486             When using multiple DataFile objects within one sweep, you can direct the data hash one of the DataFiles by the second parameter (int). If this parameter is set to 0 (default) the data hash will be directed to all DataFile objects.
1487              
1488             Examples:
1489             $sweep->LOG({
1490             'voltage' => 10,
1491             'current' => 1e-6,
1492             'reistance' => $R
1493             });
1494              
1495             OR:
1496              
1497             $sweep->LOG({'voltage' => 10});
1498             $sweep->LOG({'current' => 1e-6});
1499             $sweep->LOG({'reistance' => $R});
1500              
1501             for two DataFiles:
1502              
1503             # this value will be logged in both DataFiles
1504             $sweep->LOG({'voltage' => 10},0);
1505              
1506             # this values will be logged in DataFile 1
1507             $sweep->LOG({
1508             'current' => 1e-6,
1509             'reistance' => $R1
1510             },1);
1511              
1512             # this values will be logged in DataFile 2
1513             $sweep->LOG({
1514             'current' => 10e-6,
1515             'reistance' => $R2
1516             },2);
1517              
1518             .
1519              
1520             =head2 last
1521              
1522             use this method, in order to stop the current sweep. Example:
1523              
1524             # Stop a voltage Sweep if device current exeeds a critical limit.
1525              
1526             if ($current > $high_limit) {
1527             $voltage_sweep->last();
1528             }
1529              
1530             .
1531              
1532             =head1 HOW TO DEVELOP SUBCLASS OF Lab::XPRESS::Sweep
1533              
1534             preefine the default_config hash values in method 'new':
1535              
1536             sub new {
1537             my $proto = shift;
1538             my @args=@_;
1539             my $class = ref($proto) || $proto;
1540             my $self->{default_config} = {
1541             id => 'Magnet_sweep',
1542             filename_extension => 'B=',
1543             interval => 1,
1544             points => [],
1545             duration => [],
1546             mode => 'continuous',
1547             allowed_instruments => ['Lab::Instrument::IPS', 'Lab::Instrument::IPSWeiss1', 'Lab::Instrument::IPSWeiss2', 'Lab::Instrument::IPSWeissDillFridge'],
1548             allowed_sweep_modes => ['continuous', 'list', 'step'],
1549             number_of_points => [undef]
1550             };
1551            
1552             $self = $class->SUPER::new($self->{default_config},@args);
1553             bless ($self, $class);
1554            
1555             return $self;
1556             }
1557              
1558             the following methodes have to be overloaded in the subclass:
1559              
1560             sub go_to_sweep_start{}
1561             sub start_continuous_sweep{}
1562             sub go_to_next_step{}
1563             sub exit_loop{}
1564             sub get_value{}
1565             sub exit{}
1566              
1567             additionally see one of the present Sweep-Subclasses.
1568              
1569             =head1 CAVEATS/BUGS
1570              
1571             probably some
1572              
1573             =head1 COPYRIGHT AND LICENSE
1574              
1575             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
1576              
1577             Copyright 2012 Stefan Geissler
1578             2013 Alois Dirnaichner, Andreas K. Huettel, Christian Butschkow, Stefan Geissler
1579             2014 Alexei Iankilevitch, Christian Butschkow
1580             2015 Christian Butschkow
1581             2016-2017 Andreas K. Huettel, Simon Reinhardt
1582             2018 Simon Reinhardt
1583             2020 Andreas K. Huettel
1584              
1585              
1586             This is free software; you can redistribute it and/or modify it under
1587             the same terms as the Perl 5 programming language system itself.
1588              
1589             =cut