X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=efcad4ad8ddedf68d1f0814216dd5d5e572c0986;hb=3a94f4d2dd9a835d4a7007e1b999ea00b3c4e1cd;hp=2dcd31f7c386b269e2c05ac53757ce8008f40f61;hpb=92331b8e3417f4a28db17f7af1b8154e985c4da1;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 2dcd31f7c..efcad4ad8 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -43,22 +43,28 @@ use CGI; use CGI::Ajax; use Cwd; use Encode; +use File::Copy; use IO::File; use SL::Auth; use SL::Auth::DB; use SL::Auth::LDAP; use SL::AM; -use SL::DB; use SL::Common; +use SL::CVar; +use SL::DB; use SL::DBUtils; +use SL::DO; +use SL::IC; +use SL::IS; use SL::Mailer; use SL::Menu; +use SL::OE; use SL::Template; use SL::User; use Template; use URI; use List::Util qw(first max min sum); -use List::MoreUtils qw(any apply); +use List::MoreUtils qw(all any apply); use strict; @@ -256,7 +262,7 @@ sub new { $self->_request_to_hash($content); } - my $db_charset = $main::dbcharset; + my $db_charset = $::lx_office_conf{system}->{dbcharset}; $db_charset ||= Common::DEFAULT_CHARSET; my $encoding = $self->{INPUT_ENCODING} || $db_charset; @@ -379,7 +385,7 @@ sub escape { my ($self, $str) = @_; $str = Encode::encode('utf-8-strict', $str) if $::locale->is_utf8; - $str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge; + $str =~ s/([^a-zA-Z0-9_.:-])/sprintf("%%%02x", ord($1))/ge; $main::lxdebug->leave_sub(2); @@ -395,6 +401,7 @@ sub unescape { $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; $main::lxdebug->leave_sub(2); @@ -442,13 +449,23 @@ sub hide_form { $main::lxdebug->leave_sub(); } +sub throw_on_error { + my ($self, $code) = @_; + local $self->{__ERROR_HANDLER} = sub { die({ error => $_[0] }) }; + $code->(); +} + sub error { $main::lxdebug->enter_sub(); $main::lxdebug->show_backtrace(); my ($self, $msg) = @_; - if ($ENV{HTTP_USER_AGENT}) { + + if ($self->{__ERROR_HANDLER}) { + $self->{__ERROR_HANDLER}->($msg); + + } elsif ($ENV{HTTP_USER_AGENT}) { $msg =~ s/\n/
/g; $self->show_generic_error($msg); @@ -620,7 +637,7 @@ sub header { # extra code is currently only used by menuv3 and menuv4 to set their css. # it is strongly deprecated, and will be changed in a future version. my ($self, $extra_code) = @_; - my $db_charset = $::dbcharset || Common::DEFAULT_CHARSET; + my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET; my @header; $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++; @@ -680,7 +697,6 @@ EOT print < -