X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FMoreCommon.pm;h=0aa84a729de54a4983b1d884709907edb82f42b2;hb=95b5d54bac9dc0cb47c67444c9e19c1d68b0d520;hp=bb31f2defb3f73c98c9bc0320cd40d42fc617de5;hpb=af16cfe65e669bd9ab1535c9ef6639753cfae7d0;p=kivitendo-erp.git diff --git a/SL/MoreCommon.pm b/SL/MoreCommon.pm index bb31f2def..0aa84a729 100644 --- a/SL/MoreCommon.pm +++ b/SL/MoreCommon.pm @@ -3,13 +3,12 @@ package SL::MoreCommon; 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 YAML; - -use SL::AM; +use SL::YAML; use strict; @@ -24,7 +23,7 @@ sub save_form { 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; @@ -50,7 +49,7 @@ sub restore_form { $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(); @@ -60,7 +59,7 @@ sub compare_numbers { $main::lxdebug->enter_sub(); 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})) { @@ -76,15 +75,6 @@ sub compare_numbers { 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/; @@ -161,6 +151,27 @@ sub ary_to_hash { 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__ @@ -171,7 +182,7 @@ SL::MoreCommon.pm - helper functions =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. @@ -180,6 +191,7 @@ The exceptions are documented here. =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.