1 package SL::MoreCommon;
4 our @ISA = qw(Exporter);
6 our @EXPORT = qw(save_form restore_form compare_numbers any cross);
7 our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify);
16 $main::lxdebug->enter_sub();
18 my @dont_dump_keys = @_;
19 my %not_dumped_values;
21 foreach my $key (@dont_dump_keys) {
22 $not_dumped_values{$key} = $main::form->{$key};
23 delete $main::form->{$key};
26 my $old_form = YAML::Dump($main::form);
27 $old_form =~ s|!|!:|g;
28 $old_form =~ s|\n|!n|g;
29 $old_form =~ s|\r|!r|g;
31 map { $main::form->{$_} = $not_dumped_values{$_} } keys %not_dumped_values;
33 $main::lxdebug->leave_sub();
39 $main::lxdebug->enter_sub();
41 my ($old_form, $no_delete, @keep_vars) = @_;
43 my $form = $main::form;
44 my %keep_vars_map = map { $_ => 1 } @keep_vars;
46 map { delete $form->{$_} if (!$keep_vars_map{$_}); } keys %{$form} unless ($no_delete);
48 $old_form =~ s|!r|\r|g;
49 $old_form =~ s|!n|\n|g;
50 $old_form =~ s|![!:]|!|g;
52 my $new_form = YAML::Load($old_form);
53 map { $form->{$_} = $new_form->{$_} if (!$keep_vars_map{$_}) } keys %{ $new_form };
55 $main::lxdebug->leave_sub();
59 $main::lxdebug->enter_sub();
66 $main::all_units ||= AM->retrieve_units(\%main::myconfig, $main::form);
67 my $units = $main::all_units;
69 if (!$units->{$a_unit} || !$units->{$b_unit} || ($units->{$a_unit}->{base_unit} ne $units->{$b_unit}->{base_unit})) {
70 $main::lxdebug->leave_sub();
74 $a *= $units->{$a_unit}->{factor};
75 $b *= $units->{$b_unit}->{factor};
77 $main::lxdebug->leave_sub();
91 =item cross BLOCK ARRAY ARRAY
93 Evaluates BLOCK for each combination of elements in ARRAY1 and ARRAY2
94 and returns a new list consisting of BLOCK's return values.
95 The two elements are set to $a and $b.
96 Note that those two are aliases to the original value so changing them
97 will modify the input arrays.
102 @x = cross { "$a$b" } @a, @b;
103 # returns a1, a2, a3, b1, b2, b3, c1, c2, c3
105 As cross expects an array but returns a list it is not directly chainable
106 at the moment. This will be corrected in the future.
112 local (*A, *B) = @_; # syms for caller's input arrays
115 my ($caller_a, $caller_b) = do {
118 \*{$pkg.'::a'}, \*{$pkg.'::b'};
121 local(*$caller_a, *$caller_b);
123 # This map expression is also the return value.
124 map { my $a_index = $_;
125 map { my $b_index = $_;
126 # assign to $a, $b as refs to caller's array elements
127 (*$caller_a, *$caller_b) = \($A[$a_index], $B[$b_index]);
128 $op->(); # perform the transformation
133 sub _ary_calc_union_intersect {
138 foreach my $e (@$a, @$b) { $count{$e}++ }
142 foreach my $e (keys %count) {
144 push @isect, $e if $count{$e} == 2;
147 return (\@union, \@isect);
151 return @{ (_ary_calc_union_intersect @_)[0] };
155 return @{ (_ary_calc_union_intersect @_)[1] };
160 my %in_b = map { $_ => 1 } @$b;
161 return grep { !$in_b{$_} } @$a;
165 my @ary = scalar @_ > 1 ? @_ : ref $_[0] eq 'ARRAY' ? @{ $_[0] } : (@_);
166 return wantarray ? @ary : scalar @ary;