X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMoreCommon.pm;h=048e3ecd8bacfe1fbd134958e9aa8518735a09cc;hb=2cf0bf46e2d6372ad8402d73e2ab1e7cc59b122e;hp=1ee62cca4118ac961e92e5ec3d6833bc2d6b6209;hpb=bc40c9890a1798edd9038d7d558a5e2df1ef21fd;p=kivitendo-erp.git

diff --git a/SL/MoreCommon.pm b/SL/MoreCommon.pm
index 1ee62cca4..048e3ecd8 100644
--- a/SL/MoreCommon.pm
+++ b/SL/MoreCommon.pm
@@ -1,14 +1,18 @@
 package SL::MoreCommon;
 
 require Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-@EXPORT = qw(save_form restore_form compare_numbers any cross);
+our @EXPORT    = qw(save_form restore_form compare_numbers any cross);
+our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash);
 
+use List::MoreUtils qw(zip);
 use YAML;
 
 use SL::AM;
 
+use strict;
+
 sub save_form {
   $main::lxdebug->enter_sub();
 
@@ -85,24 +89,6 @@ sub any (&@) {
   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/;
@@ -127,4 +113,121 @@ sub cross(&\@\@) {
   }  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;
+}
+
+sub listify {
+  my @ary = scalar @_ > 1 ? @_ : ref $_[0] eq 'ARRAY' ? @{ $_[0] } : (@_);
+  return wantarray ? @ary : scalar @ary;
+}
+
+sub ary_to_hash {
+  my $idx_key   = shift;
+  my $value_key = shift;
+
+  return map { ($_, 1) } @_ if !defined($idx_key);
+
+  my @indexes = map { ref $_ eq 'HASH' ? $_->{ $idx_key } : $_->$idx_key(); } @_;
+  my @values  = map {
+      !defined($value_key) ? $_
+    : ref $_ eq 'HASH'     ? $_->{ $value_key }
+    :                        $_->$value_key()
+  } @_;
+
+  return zip(@indexes, @values);
+}
+
 1;
+
+__END__
+
+=head1 NAME
+
+SL::MoreCommon.pm - helper functions
+
+=head1 DESCRIPTION
+
+this is a collection of helper functions used in Lx-Office.
+Most of them are either obvious or too obscure to care about unless you really have to.
+The exceptions are documented here.
+
+=head2 FUNCTIONS
+
+=over 4
+
+=item save_form
+=item restore_form
+
+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.
+
+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.
+
+=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.
+
+=item ary_to_hash INDEX_KEY, VALUE_KEY, ARRAY
+
+Returns a hash with the content of ARRAY based on the values of
+INDEX_KEY and VALUE_KEY.
+
+If INDEX_KEY is undefined then the elements of ARRAY are the keys and
+'1' is the value for each of them.
+
+If INDEX_KEY is defined then each element of ARRAY is checked whether
+or not it is a hash. If it is then its element at the position
+INDEX_KEY will be the resulting hash element's key. Otherwise the
+element is assumed to be a blessed reference, and its INDEX_KEY
+function will be called.
+
+The values of the resulting hash follow a similar pattern. If
+VALUE_KEY is undefined then the current element itself is the new hash
+element's value. If the current element is a hash then its element at
+the position VALUE_KEY will be the resulting hash element's
+key. Otherwise the element is assumed to be a blessed reference, and
+its VALUE_KEY function will be called.
+
+=back
+
+=cut