1 package SL::MoreCommon;
4 our @ISA = qw(Exporter);
6 our @EXPORT = qw(save_form restore_form compare_numbers cross);
7 our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash uri_encode uri_decode);
9 use List::MoreUtils qw(zip);
17 $main::lxdebug->enter_sub();
19 my @dont_dump_keys = @_;
20 my %not_dumped_values;
22 foreach my $key (@dont_dump_keys) {
23 $not_dumped_values{$key} = $main::form->{$key};
24 delete $main::form->{$key};
27 my $old_form = YAML::Dump($main::form);
28 $old_form =~ s|!|!:|g;
29 $old_form =~ s|\n|!n|g;
30 $old_form =~ s|\r|!r|g;
32 map { $main::form->{$_} = $not_dumped_values{$_} } keys %not_dumped_values;
34 $main::lxdebug->leave_sub();
40 $main::lxdebug->enter_sub();
42 my ($old_form, $no_delete, @keep_vars) = @_;
44 my $form = $main::form;
45 my %keep_vars_map = map { $_ => 1 } @keep_vars;
47 map { delete $form->{$_} if (!$keep_vars_map{$_}); } keys %{$form} unless ($no_delete);
49 $old_form =~ s|!r|\r|g;
50 $old_form =~ s|!n|\n|g;
51 $old_form =~ s|![!:]|!|g;
53 my $new_form = YAML::Load($old_form);
54 map { $form->{$_} = $new_form->{$_} if (!$keep_vars_map{$_}) } keys %{ $new_form };
56 $main::lxdebug->leave_sub();
60 $main::lxdebug->enter_sub();
62 my ($a, $a_unit, $b, $b_unit) = @_;
64 my $units = AM->retrieve_all_units;
66 if (!$units->{$a_unit} || !$units->{$b_unit} || ($units->{$a_unit}->{base_unit} ne $units->{$b_unit}->{base_unit})) {
67 $main::lxdebug->leave_sub();
71 $a *= $units->{$a_unit}->{factor};
72 $b *= $units->{$b_unit}->{factor};
74 $main::lxdebug->leave_sub();
82 local (*A, *B) = @_; # syms for caller's input arrays
85 my ($caller_a, $caller_b) = do {
88 \*{$pkg.'::a'}, \*{$pkg.'::b'};
91 local(*$caller_a, *$caller_b);
93 # This map expression is also the return value.
94 map { my $a_index = $_;
95 map { my $b_index = $_;
96 # assign to $a, $b as refs to caller's array elements
97 (*$caller_a, *$caller_b) = \($A[$a_index], $B[$b_index]);
98 $op->(); # perform the transformation
103 sub _ary_calc_union_intersect {
108 foreach my $e (@$a, @$b) { $count{$e}++ }
112 foreach my $e (keys %count) {
114 push @isect, $e if $count{$e} == 2;
117 return (\@union, \@isect);
121 return @{ (_ary_calc_union_intersect @_)[0] };
125 return @{ (_ary_calc_union_intersect @_)[1] };
130 my %in_b = map { $_ => 1 } @$b;
131 return grep { !$in_b{$_} } @$a;
135 my @ary = scalar @_ > 1 ? @_ : ref $_[0] eq 'ARRAY' ? @{ $_[0] } : (@_);
136 return wantarray ? @ary : scalar @ary;
141 my $value_key = shift;
143 return map { ($_, 1) } @_ if !defined($idx_key);
145 my @indexes = map { ref $_ eq 'HASH' ? $_->{ $idx_key } : $_->$idx_key(); } @_;
147 !defined($value_key) ? $_
148 : ref $_ eq 'HASH' ? $_->{ $value_key }
152 return zip(@indexes, @values);
158 $str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
159 $str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge;
165 my $str = $_[0] // '';
170 $str =~ s/%([0-9a-fA-Z]{2})/pack("C",hex($1))/eg;
171 $str = Encode::decode('utf-8-strict', $str) if $::locale->is_utf8;
182 SL::MoreCommon.pm - helper functions
186 this is a collection of helper functions used in kivitendo.
187 Most of them are either obvious or too obscure to care about unless you really have to.
188 The exceptions are documented here.
198 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.
200 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.
202 =item cross BLOCK ARRAY ARRAY
204 Evaluates BLOCK for each combination of elements in ARRAY1 and ARRAY2
205 and returns a new list consisting of BLOCK's return values.
206 The two elements are set to $a and $b.
207 Note that those two are aliases to the original value so changing them
208 will modify the input arrays.
210 # append each to each
213 @x = cross { "$a$b" } @a, @b;
214 # returns a1, a2, a3, b1, b2, b3, c1, c2, c3
216 As cross expects an array but returns a list it is not directly chainable
217 at the moment. This will be corrected in the future.
219 =item ary_to_hash INDEX_KEY, VALUE_KEY, ARRAY
221 Returns a hash with the content of ARRAY based on the values of
222 INDEX_KEY and VALUE_KEY.
224 If INDEX_KEY is undefined then the elements of ARRAY are the keys and
225 '1' is the value for each of them.
227 If INDEX_KEY is defined then each element of ARRAY is checked whether
228 or not it is a hash. If it is then its element at the position
229 INDEX_KEY will be the resulting hash element's key. Otherwise the
230 element is assumed to be a blessed reference, and its INDEX_KEY
231 function will be called.
233 The values of the resulting hash follow a similar pattern. If
234 VALUE_KEY is undefined then the current element itself is the new hash
235 element's value. If the current element is a hash then its element at
236 the position VALUE_KEY will be the resulting hash element's
237 key. Otherwise the element is assumed to be a blessed reference, and
238 its VALUE_KEY function will be called.