File Coverage

blib/lib/Lab/Moose/Sweep.pm
Criterion Covered Total %
statement 196 218 89.9
branch 51 66 77.2
condition 4 6 66.6
subroutine 22 24 91.6
pod 0 4 0.0
total 273 318 85.8


line stmt bran cond sub pod time code
1             package Lab::Moose::Sweep;
2             $Lab::Moose::Sweep::VERSION = '3.881';
3             #ABSTRACT: Base class for high level sweeps
4              
5 4     4   8450 use v5.20;
  4         19  
6              
7             # Step/List and Continuous sweep are implemented as subclasses
8              
9              
10 4     4   54 use Moose;
  4         13  
  4         37  
11 4     4   28084 use MooseX::StrictConstructor;
  4         12  
  4         41  
12 4     4   14184 use Moose::Util::TypeConstraints 'enum';
  4         10  
  4         42  
13 4     4   1931 use MooseX::Params::Validate;
  4         13  
  4         29  
14 4     4   4340 use Lab::Moose::Sweep::DataFile;
  4         18  
  4         159  
15 4     4   2400 use Lab::Moose::Countdown 'countdown';
  4         18  
  4         247  
16 4     4   30 use Data::Dumper;
  4         12  
  4         208  
17              
18             # Do not import all functions as they clash with the attribute methods.
19 4     4   31 use Lab::Moose::Catfile qw/our_catfile/;
  4         11  
  4         187  
20              
21 4     4   25 use Carp;
  4         9  
  4         10038  
22              
23             #
24             # Public attributes set by the user
25             #
26              
27             has filename_extension => ( is => 'ro', isa => 'Str', default => 'Value=' );
28              
29             has delay_before_loop => ( is => 'ro', isa => 'Num', default => 0 );
30             has delay_in_loop => ( is => 'ro', isa => 'Num', default => 0 );
31             has delay_after_loop => ( is => 'ro', isa => 'Num', default => 0 );
32             has before_loop => (
33             is => 'ro',
34             isa => 'CodeRef',
35             default => sub {
36             sub { }
37             }
38             );
39             has after_loop => (
40             is => 'ro',
41             isa => 'CodeRef',
42             default => sub {
43             sub { }
44             }
45             );
46              
47             #
48             # Private attributes used internally
49             #
50              
51             has slave => (
52             is => 'ro', isa => 'Lab::Moose::Sweep', init_arg => undef,
53             writer => '_slave'
54             );
55              
56             has is_slave =>
57             ( is => 'ro', isa => 'Bool', init_arg => undef, writer => '_is_slave' );
58              
59             has datafile_params => (
60             is => 'ro',
61             isa => 'ArrayRef[Lab::Moose::Sweep::DataFile]', init_arg => undef,
62             writer => '_datafile_params'
63             );
64              
65             has foldername =>
66             ( is => 'ro', isa => 'Str', init_arg => undef, writer => '_foldername' );
67              
68             # real Lab::Moose::DataFile
69             has datafiles => (
70             is => 'ro', isa => 'HashRef[Lab::Moose::DataFile]', init_arg => undef,
71             writer => '_datafiles'
72             );
73              
74             has logged_datafiles => (
75             is => 'ro', isa => 'HashRef[Bool]', init_arg => undef,
76             writer => '_logged_datafiles'
77             );
78              
79             has create_datafile_blocks => (
80             is => 'ro', isa => 'Bool', init_arg => undef,
81             writer => '_create_datafile_blocks'
82             );
83              
84             # Should this sweep create a new datafile for each measurement point?
85             has create_datafiles => (
86             is => 'ro',
87             isa => 'Bool', init_arg => undef, writer => '_create_datafiles'
88             );
89              
90             has datafolder => (
91             is => 'ro',
92             isa => 'Lab::Moose::DataFolder',
93             init_arg => undef,
94             writer => '_datafolder'
95             );
96              
97             has measurement => (
98             is => 'ro', isa => 'CodeRef', init_arg => undef, writer => '_measurement',
99             predicate => 'has_measurement',
100             );
101              
102             #
103             has was_used => (
104             is => 'ro', isa => 'Bool', init_arg => undef, default => 0,
105             writer => '_was_used'
106             );
107              
108             sub _ensure_no_slave {
109 16     16   28 my $self = shift;
110 16 50       568 if ( $self->is_slave() ) {
111 0         0 croak "cannot do this with slave";
112             }
113             }
114              
115             sub _ensure_sweeps_different {
116 16     16   34 my $self = shift;
117 16         47 my @sweeps = @_;
118              
119 16         40 my %h = map { ( $_ + 0 ) => 1 } (@sweeps);
  20         126  
120 16         58 my @keys = keys %h;
121 16 50       90 if ( @keys != @sweeps ) {
122 0         0 croak "all sweeps must be separate objects!";
123             }
124             }
125              
126             sub _add_plots {
127 36     36   89 my $self = shift;
128 36         64 my $datafile = shift;
129 36         58 my $handle = shift;
130 36         56 my @plots = @{ $handle->plots };
  36         1156  
131 36         103 for my $plot_params (@plots) {
132 0         0 $datafile->add_plot($plot_params);
133             }
134             }
135              
136             sub _parse_slave_arg {
137 16     16   73 my %args = @_;
138 16 100       65 if ( defined $args{slaves} ) {
139 1 50       6 if ( defined $args{slave} ) {
140 0         0 croak "give either slave or slaves arg";
141             }
142 1         18 return $args{slaves};
143             }
144 15 100       49 if ( defined $args{slave} ) {
145 2         8 return [ $args{slave} ];
146             }
147             else {
148 13         70 return [];
149             }
150             }
151              
152             sub _parse_datafile_arg {
153 16     16   70 my %args = @_;
154 16 100       85 if ( defined $args{datafiles} ) {
155 1 50       5 if ( defined $args{datafile} ) {
156 0         0 croak "give either datafile or datafiles arg";
157             }
158 1         3 return $args{datafiles};
159             }
160 15 50       50 if ( defined $args{datafile} ) {
161 15         48 return [ $args{datafile} ];
162             }
163             else {
164 0         0 croak "need either datafile or datafiles arg";
165             }
166             }
167              
168             # Called by user on master sweep
169             sub start {
170 16     16 0 470 my ( $self, %args ) = validated_hash(
171             \@_,
172             slave => { isa => 'Lab::Moose::Sweep', optional => 1 },
173             slaves => { isa => 'ArrayRef[Lab::Moose::Sweep]', optional => 1 },
174             datafile => { isa => 'Lab::Moose::Sweep::DataFile', optional => 1 },
175             datafiles =>
176             { isa => 'ArrayRef[Lab::Moose::Sweep::DataFile]', optional => 1 },
177             measurement => { isa => 'CodeRef' },
178             datafile_dim => { isa => enum( [qw/2 1 0/] ), optional => 1 },
179              
180             # might allow point_dim = 2 in the future.
181             point_dim => { isa => enum( [qw/1 0/] ), default => 0 },
182             folder => { isa => 'Str|Lab::Moose::DataFolder', optional => 1 },
183             date_prefix => { isa => 'Bool', default => 1 },
184             time_prefix => { isa => 'Bool', default => 1 },
185             meta_data => { isa => 'HashRef', optional => 1 },
186             );
187              
188 16         82139 my $slaves = _parse_slave_arg(%args);
189 16         76 my $datafile_params = _parse_datafile_arg(%args);
190 16         37 my $measurement = $args{measurement};
191 16         44 my $datafile_dim = $args{datafile_dim};
192 16         31 my $point_dim = $args{point_dim};
193 16         36 my $folder = $args{folder};
194 16         32 my $date_prefix = $args{date_prefix};
195 16         31 my $time_prefix = $args{time_prefix};
196 16         40 my $meta_data = $args{meta_data};
197              
198 16         104 $self->_ensure_no_slave();
199              
200 16         30 my $num_slaves = 0;
201 16         32 my @slaves;
202 16         34 my @sweeps = ($self);
203 16 50       48 if ( defined $slaves ) {
204 16         27 @slaves = @{$slaves};
  16         35  
205 16         31 $num_slaves = @slaves;
206 16         42 push @sweeps, @slaves;
207             }
208              
209 16         43 for my $sweep (@sweeps) {
210 20 50       598 if ( $sweep->was_used() ) {
211 0         0 croak "sweep was used before. cannot use it for multiple runs.";
212             }
213 20         665 $sweep->_was_used(1);
214             }
215              
216 16         113 $self->_ensure_sweeps_different(@sweeps);
217              
218 16 100       58 if ( defined $datafile_dim ) {
219 3 50       13 if ( $point_dim > $datafile_dim ) {
220 0         0 croak "datafile_dim must be >= point_dim";
221             }
222              
223 3 50 66     19 if ( $num_slaves + $point_dim == 0 and $datafile_dim == 2 ) {
224 0         0 croak
225             "cannot create 2D datafile without slaves and zero point_dim";
226             }
227             }
228             else {
229             # Set default log_structure
230 13 100       51 if ( $num_slaves + $point_dim == 0 ) {
231 10         21 $datafile_dim = 1,
232             }
233             else {
234 3         7 $datafile_dim = 2,
235             }
236             }
237              
238 16 100       65 if ( $datafile_dim == 2 ) {
239 3 100       12 if ( $point_dim == 0 ) {
    50          
240 2         94 $sweeps[-2]->_create_datafile_blocks(1);
241             }
242             elsif ( $point_dim == 1 ) {
243 1         39 $sweeps[-1]->_create_datafile_blocks(1);
244             }
245             }
246              
247 16 100       42 if ($num_slaves) {
248              
249             # Set slave/parent relationships
250 3         18 my $parent = $self;
251 3         14 for my $slave (@slaves) {
252 4         135 $slave->_is_slave(1);
253 4         129 $parent->_slave($slave);
254 4         8 $parent = $slave;
255             }
256             }
257              
258 16 100       42 if ($num_slaves) {
259 3         108 $slaves[-1]->_measurement($measurement);
260             }
261             else {
262 13         495 $self->_measurement($measurement);
263             }
264              
265             # Pass this to master sweep's _start method if we have a single datafile
266 16         35 my $datafolder;
267 16 50       45 if ( defined $folder ) {
268 16 100       48 if ( ref $folder ) {
269 2         6 $datafolder = $folder;
270             }
271             else {
272 14         98 $datafolder = Lab::Moose::datafolder(
273             path => $folder,
274             date_prefix => $date_prefix,
275             time_prefix => $time_prefix,
276             );
277             }
278             }
279             else {
280 0         0 $datafolder = Lab::Moose::datafolder(
281             date_prefix => $date_prefix,
282             time_prefix => $time_prefix
283             );
284             }
285              
286 16         538 $self->_foldername( $datafolder->path() );
287              
288 16 100       57 if ($meta_data) {
289 1         36 $datafolder->meta_file->log( meta => $meta_data );
290             }
291              
292 16         43 my $datafiles;
293              
294 16 100       68 if ( ( $num_slaves + $point_dim ) - $datafile_dim >= 0 ) {
295 4         11 my $datafile_creating_sweep
296             = $sweeps[ ( $num_slaves + $point_dim ) - $datafile_dim ];
297 4         164 $datafile_creating_sweep->_create_datafiles(1);
298 4         173 $datafile_creating_sweep->_datafile_params($datafile_params);
299 4         551 $datafile_creating_sweep->_datafolder($datafolder);
300             }
301             else {
302             # only top-level datafiles
303 12         25 for my $handle ( @{$datafile_params} ) {
  12         38  
304 13         22 my %params = %{ $handle->params };
  13         437  
305 13         55 my $filename = delete $params{filename};
306 13         41 $filename .= '.dat';
307 13         69 my $datafile = Lab::Moose::datafile(
308             folder => $datafolder,
309             filename => $filename,
310             %params
311             );
312 13         152 $self->_add_plots( $datafile, $handle );
313 13         81 $datafiles->{$handle} = $datafile;
314             }
315             }
316              
317 16         85 $self->_start(
318             datafiles => $datafiles,
319             filename_extensions => [],
320             );
321              
322             }
323              
324             sub _gen_filename {
325 23     23   43 my $self = shift;
326 23         111 my ( $filename, $extensions ) = validated_list(
327             \@_,
328             filename => { isa => 'Str' },
329             extensions => { isa => 'ArrayRef[Str]' },
330             );
331              
332 23         6534 my @extensions = @{$extensions};
  23         80  
333              
334 23         100 my $basename = $filename . '_' . join( '_', @extensions ) . '.dat';
335              
336 23         37 pop @extensions;
337 23 100       73 if ( @extensions >= 1 ) {
338              
339             # create subdirectories in datafolder
340 9         30 return our_catfile( @extensions, $basename );
341             }
342             else {
343 14         43 return $basename;
344             }
345             }
346              
347             # to be implemented in subclass:
348              
349             # go_to_sweep_start
350              
351             # sweep_finished
352              
353             # go_to_next_point
354              
355             # get_value
356              
357             sub _start {
358 38     38   67 my $self = shift;
359 38         230 my ( $datafiles, $filename_extensions ) = validated_list(
360             \@_,
361             datafiles => { isa => 'Maybe[HashRef[Lab::Moose::DataFile]]' },
362             filename_extensions => { isa => 'ArrayRef[Str]' },
363             );
364              
365 38         30415 my $slave = $self->slave();
366 38         1059 my $create_datafiles = $self->create_datafiles;
367 38         94 my $push_filename_extensions = not defined $datafiles;
368              
369 38 50 66     141 if ( $create_datafiles and defined $datafiles ) {
370 0         0 croak "should not get datafile arg";
371             }
372              
373 38         172 $self->go_to_sweep_start();
374              
375 38         1092 my $before_loop_code = $self->before_loop();
376 38         162 $self->$before_loop_code();
377              
378 38         1550 countdown( $self->delay_before_loop );
379 38         179 $self->start_sweep();
380 38         110 while ( not $self->sweep_finished() ) {
381 158         527 $self->go_to_next_point();
382 158         4635 countdown( $self->delay_in_loop );
383 158         289 my @filename_extensions = @{$filename_extensions};
  158         395  
384              
385             # Only call get_value if we have to
386 158 100       388 if ($push_filename_extensions) {
387 26         872 push @filename_extensions,
388             $self->filename_extension . $self->get_value();
389             }
390              
391             # Create new datafile?
392 158 100       381 if ($create_datafiles) {
393 23         40 for my $handle ( @{ $self->datafile_params } ) {
  23         721  
394 23         35 my %params = %{ $handle->params };
  23         675  
395 23         59 my $filename = delete $params{filename};
396              
397 23         95 $filename = $self->_gen_filename(
398             filename => $filename,
399             extensions => [@filename_extensions],
400             );
401              
402 23         752 my $datafile = Lab::Moose::datafile(
403             folder => $self->datafolder,
404             filename => $filename,
405             %params,
406             );
407 23         145 $self->_add_plots( $datafile, $handle );
408 23         568 $datafiles->{$handle} = $datafile;
409             }
410             }
411              
412 158 100       410 if ($slave) {
413              
414 22         111 $slave->_start(
415             datafiles => $datafiles,
416             filename_extensions => [@filename_extensions],
417             );
418              
419             }
420             else {
421             # do measurement
422 136         4596 $self->_datafiles($datafiles);
423 136         4958 $self->_logged_datafiles( {} );
424 136         3956 my $meas = $self->measurement();
425 136         642 $self->$meas();
426 136         383 my %logged = %{ $self->logged_datafiles };
  136         3882  
427 136 50       347 if ( keys(%logged) != keys( %{$datafiles} ) ) {
  136         479  
428 0         0 croak
429             "unused datafiles. Make sure that a logging method is used for each datafile";
430             }
431              
432             }
433 158 100       4483 if ( $self->create_datafile_blocks() ) {
434 18         45 for my $datafile ( values %{$datafiles} ) {
  18         60  
435 18         89 $datafile->new_block();
436             }
437             }
438 158         4794 countdown( $self->delay_after_loop );
439             }
440 38         1113 my $after_loop_code = $self->after_loop();
441 38         141 $self->$after_loop_code();
442              
443             }
444              
445             sub _validated_datafile_arg {
446              
447             # could only use validated_hash without caching
448 142     142   223 my $self = shift;
449 142         513 my %args = @_;
450              
451 142         377 my $handle = delete $args{datafile};
452              
453 142         216 my %datafiles = %{ $self->datafiles() };
  142         4198  
454 142         338 my $datafile;
455              
456 142 50       408 if ( keys(%datafiles) < 1 ) {
457 0         0 croak "no datafiles available in log method";
458             }
459 142 100       353 if ( not defined $handle ) {
460 130         332 my @keys = keys(%datafiles);
461 130 50       314 if ( @keys != 1 ) {
462 0         0 croak
463             "no 'datafile => ...' argument for the 'log' method. Must be used for multiple datafiles.";
464             }
465 130         279 $handle = $keys[0];
466              
467             }
468 142         235 $datafile = $datafiles{$handle};
469 142         734 return ( $self, $datafile, $handle, %args );
470             }
471              
472             sub _validated_log {
473 142     142   330 my ( $self, $datafile, $handle, %args ) = _validated_datafile_arg(@_);
474 142         4205 $self->logged_datafiles()->{$handle} = 1;
475 142         676 return ( $self, $datafile, %args );
476             }
477              
478             sub log {
479 135     135 0 17302 my ( $self, $datafile, %args ) = _validated_log(@_);
480 135         634 $datafile->log(%args);
481             }
482              
483             sub log_block {
484 7     7 0 105 my ( $self, $datafile, %args ) = _validated_log(@_);
485 7         32 $datafile->log_block(%args);
486             }
487              
488             sub _get_innermost_slave {
489 0     0     my $self = shift;
490 0           while ( defined $self->slave ) {
491 0           $self = $self->slave;
492             }
493 0           return $self;
494             }
495              
496             sub refresh_plots {
497 0     0 0   my $self = shift;
498 0           $self = $self->_get_innermost_slave();
499 0           my ( $self2, $datafile, $handle, %args )
500             = _validated_datafile_arg( $self, @_ );
501 0           $datafile->refresh_plots(%args);
502             }
503              
504             __PACKAGE__->meta->make_immutable();
505             1;
506              
507             __END__
508              
509             =pod
510              
511             =encoding UTF-8
512              
513             =head1 NAME
514              
515             Lab::Moose::Sweep - Base class for high level sweeps
516              
517             =head1 VERSION
518              
519             version 3.881
520              
521             =head1 DESCRIPTION
522              
523             The Sweep interface is documented in L<Lab::Measurement::Tutorial>.
524              
525             =head1 COPYRIGHT AND LICENSE
526              
527             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
528              
529             Copyright 2017 Simon Reinhardt
530             2018 Andreas K. Huettel, Simon Reinhardt
531             2020 Andreas K. Huettel
532             2021 Fabian Weinelt
533              
534              
535             This is free software; you can redistribute it and/or modify it under
536             the same terms as the Perl 5 programming language system itself.
537              
538             =cut