X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=6e7145f20fb5d773897029abe9508fb422b3adbf;hb=89c9ff022d3f13e27ba6bda085df15707fcfb0eb;hp=f0ad1a17b0292c6e5e4e105447df014fb19376bf;hpb=70bf75174885ce60e8236dbc3637807b130fd5e5;p=kivitendo-erp.git
diff --git a/SL/Form.pm b/SL/Form.pm
index f0ad1a17b..6e7145f20 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 <
-