X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMoreCommon.pm;h=e09d7c85dd13a236a8b45103bf0a1ee647b3a28f;hb=1043d7f814fccf5864e677b1e38577d0a150026c;hp=32ca6b6c08938331cb4f396741e49957bc572e3f;hpb=8c7e44938a661e035f62840e1e177353240ace5d;p=kivitendo-erp.git

diff --git a/SL/MoreCommon.pm b/SL/MoreCommon.pm
index 32ca6b6c0..e09d7c85d 100644
--- a/SL/MoreCommon.pm
+++ b/SL/MoreCommon.pm
@@ -3,7 +3,8 @@ package SL::MoreCommon;
 require Exporter;
 @ISA = qw(Exporter);
 
-@EXPORT = qw(save_form restore_form compare_numbers);
+@EXPORT    = qw(save_form restore_form compare_numbers any cross);
+@EXPORT_OK = qw(ary_union ary_intersect ary_diff);
 
 use YAML;
 
@@ -76,5 +77,86 @@ sub compare_numbers {
   return $a <=> $b;
 }
 
+sub any (&@) {
+  my $f = shift;
+  return if ! @_;
+  for (@_) {
+    return 1 if $f->();
+  }
+  return 0;
+}
+
+=item cross BLOCK ARRAY ARRAY
+
+Evaluates BLOCK for each combination of elements in ARRAY1 and ARRAY2
+and returns a new list consisting of BLOCK's return values.
+The two elements are set to $a and $b.
+Note that those two are aliases to the original value so changing them
+will modify the input arrays.
+
+  # append each to each
+  @a = qw/a b c/;
+  @b = qw/1 2 3/;
+  @x = cross { "$a$b" } @a, @b;
+  # returns a1, a2, a3, b1, b2, b3, c1, c2, c3
+
+As cross expects an array but returns a list it is not directly chainable
+at the moment. This will be corrected in the future.
+
+=cut
+sub cross(&\@\@) {
+  my $op = shift;
+  use vars qw/@A @B/;
+  local (*A, *B) = @_;    # syms for caller's input arrays
+
+  # Localise $a, $b
+  my ($caller_a, $caller_b) = do {
+    my $pkg = caller();
+    no strict 'refs';
+    \*{$pkg.'::a'}, \*{$pkg.'::b'};
+  };
+
+  local(*$caller_a, *$caller_b);
+
+  # This map expression is also the return value.
+  map { my $a_index = $_;
+    map { my $b_index = $_;
+      # assign to $a, $b as refs to caller's array elements
+      (*$caller_a, *$caller_b) = \($A[$a_index], $B[$b_index]);
+      $op->();    # perform the transformation
+    }  0 .. $#B;
+  }  0 .. $#A;
+}
+
+sub _ary_calc_union_intersect {
+  my ($a, $b) = @_;
+
+  my %count = ();
+
+  foreach my $e (@$a, @$b) { $count{$e}++ }
+
+  my @union = ();
+  my @isect = ();
+  foreach my $e (keys %count) {
+    push @union, $e;
+    push @isect, $e if $count{$e} == 2;
+  }
+
+  return (\@union, \@isect);
+}
+
+sub ary_union {
+  return @{ (_ary_calc_union_intersect @_)[0] };
+}
+
+sub ary_intersect {
+  return @{ (_ary_calc_union_intersect @_)[1] };
+}
+
+sub ary_diff {
+  my ($a, $b) = @_;
+  my %in_b    = map { $_ => 1 } @$b;
+  return grep { !$in_b{$_} } @$a;
+}
 
 1;