Vorgangsbezeichnung in Dialogbuchung: DB-Upgrade und Rose

[mfinanz.git] / SL / MoreCommon.pm

diff --git a/SL/MoreCommon.pm b/SL/MoreCommon.pm
index 8f6486135190e51c758ab2e8b1a745bbe709b5bf..0aa84a729de54a4983b1d884709907edb82f42b2 100644 (file)
--- a/SL/MoreCommon.pm
+++ b/SL/MoreCommon.pm
@@ -3,13 +3,12 @@ package SL::MoreCommon;
 require Exporter;
 our @ISA = qw(Exporter);
 
 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 ary_to_hash);
+our @EXPORT    = qw(save_form restore_form compare_numbers cross);
+our @EXPORT_OK = qw(ary_union ary_intersect ary_diff listify ary_to_hash uri_encode uri_decode);

 
 

+use Encode ();

 use List::MoreUtils qw(zip);
 use List::MoreUtils qw(zip);

-use YAML;
-
-use SL::AM;
+use SL::YAML;

 
 use strict;
 
 
 use strict;
 


@@ -24,7 +23,7 @@ sub save_form {
     delete $main::form->{$key};
   }
 
     delete $main::form->{$key};
   }
 

-  my $old_form = YAML::Dump($main::form);
+  my $old_form = SL::YAML::Dump($main::form);

   $old_form =~ s|!|!:|g;
   $old_form =~ s|\n|!n|g;
   $old_form =~ s|\r|!r|g;
   $old_form =~ s|!|!:|g;
   $old_form =~ s|\n|!n|g;
   $old_form =~ s|\r|!r|g;


@@ -50,7 +49,7 @@ sub restore_form {
   $old_form =~ s|!n|\n|g;
   $old_form =~ s|![!:]|!|g;
 
   $old_form =~ s|!n|\n|g;
   $old_form =~ s|![!:]|!|g;
 

-  my $new_form = YAML::Load($old_form);
+  my $new_form = SL::YAML::Load($old_form);

   map { $form->{$_} = $new_form->{$_} if (!$keep_vars_map{$_}) } keys %{ $new_form };
 
   $main::lxdebug->leave_sub();
   map { $form->{$_} = $new_form->{$_} if (!$keep_vars_map{$_}) } keys %{ $new_form };
 
   $main::lxdebug->leave_sub();


@@ -59,13 +58,9 @@ sub restore_form {
 sub compare_numbers {
   $main::lxdebug->enter_sub();
 
 sub compare_numbers {
   $main::lxdebug->enter_sub();
 

-  my $a      = shift;
-  my $a_unit = shift;
-  my $b      = shift;
-  my $b_unit = shift;
-
-  $main::all_units ||= AM->retrieve_units(\%main::myconfig, $main::form);
-  my $units          = $main::all_units;
+  my ($a, $a_unit, $b, $b_unit) = @_;
+  require SL::AM;
+  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();
 
   if (!$units->{$a_unit} || !$units->{$b_unit} || ($units->{$a_unit}->{base_unit} ne $units->{$b_unit}->{base_unit})) {
     $main::lxdebug->leave_sub();


@@ -80,15 +75,6 @@ sub compare_numbers {
   return $a <=> $b;
 }
 
   return $a <=> $b;
 }
 

-sub any (&@) {
-  my $f = shift;
-  return if ! @_;
-  for (@_) {
-    return 1 if $f->();
-  }
-  return 0;
-}
-

 sub cross(&\@\@) {
   my $op = shift;
   use vars qw/@A @B/;
 sub cross(&\@\@) {
   my $op = shift;
   use vars qw/@A @B/;


@@ -165,6 +151,27 @@ sub ary_to_hash {
   return zip(@indexes, @values);
 }
 
   return zip(@indexes, @values);
 }
 

+sub uri_encode {
+  my ($str) = @_;
+
+  $str =  Encode::encode('utf-8-strict', $str);
+  $str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge;
+
+  return $str;
+}
+
+sub uri_decode {
+  my $str = $_[0] // '';
+
+  $str =~ tr/+/ /;
+  $str =~ s/\\$//;
+
+  $str =~ s/%([0-9a-fA-Z]{2})/pack("C",hex($1))/eg;
+  $str =  Encode::decode('utf-8-strict', $str);
+
+  return $str;
+}
+

 1;
 
 __END__
 1;
 
 __END__


@@ -175,7 +182,7 @@ SL::MoreCommon.pm - helper functions
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 

-this is a collection of helper functions used in Lx-Office.
+this is a collection of helper functions used in kivitendo.

 Most of them are either obvious or too obscure to care about unless you really have to.
 The exceptions are documented here.
 
 Most of them are either obvious or too obscure to care about unless you really have to.
 The exceptions are documented here.
 


@@ -184,6 +191,7 @@ The exceptions are documented here.
 =over 4
 
 =item save_form
 =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.
 =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.


@@ -207,8 +215,6 @@ 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.
 
 As cross expects an array but returns a list it is not directly chainable
 at the moment. This will be corrected in the future.
 

-=back
-

 =item ary_to_hash INDEX_KEY, VALUE_KEY, ARRAY
 
 Returns a hash with the content of ARRAY based on the values of
 =item ary_to_hash INDEX_KEY, VALUE_KEY, ARRAY
 
 Returns a hash with the content of ARRAY based on the values of