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 <
-