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();
94 local (*A, *B) = @_; # syms for caller's input arrays
97 my ($caller_a, $caller_b) = do {
100 \*{$pkg.'::a'}, \*{$pkg.'::b'};
103 local(*$caller_a, *$caller_b);
105 # This map expression is also the return value.
106 map { my $a_index = $_;
107 map { my $b_index = $_;
108 # assign to $a, $b as refs to caller's array elements
109 (*$caller_a, *$caller_b) = \($A[$a_index], $B[$b_index]);
110 $op->(); # perform the transformation
115 sub _ary_calc_union_intersect {
120 foreach my $e (@$a, @$b) { $count{$e}++ }
124 foreach my $e (keys %count) {
126 push @isect, $e if $count{$e} == 2;
129 return (\@union, \@isect);
133 return @{ (_ary_calc_union_intersect @_)[0] };
137 return @{ (_ary_calc_union_intersect @_)[1] };
142 my %in_b = map { $_ => 1 } @$b;
143 return grep { !$in_b{$_} } @$a;
147 my @ary = scalar @_ > 1 ? @_ : ref $_[0] eq 'ARRAY' ? @{ $_[0] } : (@_);
148 return wantarray ? @ary : scalar @ary;
157 SL::MoreCommon.pm - helper functions
161 this is a collection of helper functions used in Lx-Office.
162 Most of them are either obvious or too obscure to care about unless you really have to.
163 The exceptions are documented here.
172 A lot of the old sql-ledger routines are strictly procedural. They search for params in the $form object, do stuff with it, and return a status code.
174 Once in a while you'll want something from such a function without altering $form. Yeah, you could rewrite the routine from scratch... not. Just save you form, execute the routine, grab your results, and restore the previous form while you curse at the original design.
176 =item cross BLOCK ARRAY ARRAY
178 Evaluates BLOCK for each combination of elements in ARRAY1 and ARRAY2
179 and returns a new list consisting of BLOCK's return values.
180 The two elements are set to $a and $b.
181 Note that those two are aliases to the original value so changing them
182 will modify the input arrays.
184 # append each to each
187 @x = cross { "$a$b" } @a, @b;
188 # returns a1, a2, a3, b1, b2, b3, c1, c2, c3
190 As cross expects an array but returns a list it is not directly chainable
191 at the moment. This will be corrected in the future.