X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMoreCommon.pm;h=9be3bc8a16c9ef66e096ccb26904d0216f400cc3;hb=72be9c763f3b7f7df1fae4fe10011e45f9e2ad1d;hp=0d5413b1a90be01a19c1c0e7794158530aa67053;hpb=9bd3030a376850c427c102c6e0c54f19bd19332e;p=kivitendo-erp.git

diff --git a/SL/MoreCommon.pm b/SL/MoreCommon.pm
index 0d5413b1a..9be3bc8a1 100644
--- a/SL/MoreCommon.pm
+++ b/SL/MoreCommon.pm
@@ -4,8 +4,9 @@ require Exporter;
 our @ISA = qw(Exporter);
 
 our @EXPORT    = qw(save_form restore_form compare_numbers any cross);
-our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify);
+our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash uri_encode uri_decode);
 
+use List::MoreUtils qw(zip);
 use YAML;
 
 use SL::AM;
@@ -58,13 +59,9 @@ sub restore_form {
 sub compare_numbers {
   $main::lxdebug->enter_sub();
 
-  my $a      = shift;
-  my $a_unit = shift;
-  my $b      = shift;
-  my $b_unit = shift;
+  my ($a, $a_unit, $b, $b_unit) = @_;
 
-  $main::all_units ||= AM->retrieve_units(\%main::myconfig, $main::form);
-  my $units          = $main::all_units;
+  my $units          = AM->retrieve_all_units;
 
   if (!$units->{$a_unit} || !$units->{$b_unit} || ($units->{$a_unit}->{base_unit} ne $units->{$b_unit}->{base_unit})) {
     $main::lxdebug->leave_sub();
@@ -148,6 +145,43 @@ sub listify {
   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);
+}
+
+sub uri_encode {
+  my ($str) = @_;
+
+  $str =  Encode::encode('utf-8-strict', $str) if $::locale->is_utf8;
+  $str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge;
+
+  return $str;
+}
+
+sub uri_decode {
+  my ($str) = @_;
+
+  $str =~ tr/+/ /;
+  $str =~ s/\\$//;
+
+  $str =~ s/%([0-9a-fA-Z]{2})/pack("C",hex($1))/eg;
+  $str =  Encode::decode('utf-8-strict', $str) if $::locale->is_utf8;
+
+  return $str;
+}
+
 1;
 
 __END__
@@ -190,6 +224,27 @@ will modify the input arrays.
 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