X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=efcad4ad8ddedf68d1f0814216dd5d5e572c0986;hb=3a94f4d2dd9a835d4a7007e1b999ea00b3c4e1cd;hp=f0ad1a17b0292c6e5e4e105447df014fb19376bf;hpb=7b162f9b3b7aefffcc9725b74c3589571d47aa8e;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index f0ad1a17b..efcad4ad8 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -43,21 +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::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; @@ -255,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; @@ -378,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); @@ -394,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); @@ -441,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); @@ -619,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}++; @@ -679,7 +697,6 @@ EOT print < -