X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=6d2ae491414dd264a84fad73cb033ea14aacdaf2;hb=8484285f05cdb419d89c4385d8889117bbd2df62;hp=c75249bace8f10ff23219018f6f733b361df41bb;hpb=dc50b737f80c8bd09ac2fbbfa2cc06a04e9d8753;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index c75249bac..6d2ae4914 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -63,10 +63,13 @@ use strict; my $standard_dbh; END { - if ($standard_dbh) { - $standard_dbh->disconnect(); - undef $standard_dbh; - } + disconnect_standard_dbh(); +} + +sub disconnect_standard_dbh { + return unless $standard_dbh; + $standard_dbh->disconnect(); + undef $standard_dbh; } sub _store_value { @@ -240,20 +243,17 @@ sub new { tie %{ $self }, 'SL::Watchdog'; } - read(STDIN, $_, $ENV{CONTENT_LENGTH}); + bless $self, $type; - if ($ENV{QUERY_STRING}) { - $_ = $ENV{QUERY_STRING}; - } + $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING}; + $self->_input_to_hash($ARGV[0]) if @ARGV && $ARGV[0]; - if ($ARGV[0]) { - $_ = $ARGV[0]; + if ($ENV{CONTENT_LENGTH}) { + my $content; + read STDIN, $content, $ENV{CONTENT_LENGTH}; + $self->_request_to_hash($content); } - bless $self, $type; - - $self->_request_to_hash($_); - my $db_charset = $main::dbcharset; $db_charset ||= Common::DEFAULT_CHARSET; @@ -455,8 +455,8 @@ sub error { $self->show_generic_error($msg); } else { - - die "Error: $msg\n"; + print STDERR "Error: $msg\n"; + ::end_of_request(); } $main::lxdebug->leave_sub(); @@ -555,6 +555,20 @@ sub _get_request_uri { return $uri; } +sub _add_to_request_uri { + my $self = shift; + + my $relative_new_path = shift; + my $request_uri = shift || $self->_get_request_uri; + my $relative_new_uri = URI->new($relative_new_path); + my @request_segments = $request_uri->path_segments; + + my $new_uri = $request_uri->clone; + $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments); + + return $new_uri; +} + sub create_http_response { $main::lxdebug->enter_sub(); @@ -772,7 +786,7 @@ sub _prepare_html_template { my $info = "Developer information: templates/webpages/${file}.html is newer than the translation file locale/${language}/all.\n" . "Please re-run 'locales.pl' in 'locale/${language}'."; print(qq|
$info
|); - die($info); + ::end_of_request(); } $file = "templates/webpages/${file}.html"; @@ -781,7 +795,7 @@ sub _prepare_html_template { my $info = "Web page template '${file}' not found.\n" . "Please re-run 'locales.pl' in 'locale/${language}'."; print(qq|
$info
|); - die($info); + ::end_of_request(); } if ($self->{"DEBUG"}) { @@ -841,25 +855,14 @@ sub parse_html_template { 'CACHE_SIZE' => 0, 'PLUGIN_BASE' => 'SL::Template::Plugin', 'INCLUDE_PATH' => '.:templates/webpages', + 'COMPILE_EXT' => $main::template_compile_ext, + 'COMPILE_DIR' => $main::template_compile_dir, }) || die; map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; - my $in = IO::File->new($file, 'r'); - - if (!$in) { - print STDERR "Error opening template file: $!"; - $main::lxdebug->leave_sub(); - return ''; - } - - my $input = join('', <$in>); - $in->close(); - my $output; - if (!$template->process(\$input, $additional_params, \$output)) { - print STDERR $template->error(); - } + $template->process($file, $additional_params, \$output) || die $template->error(); $main::lxdebug->leave_sub(); @@ -895,9 +898,11 @@ sub show_generic_error { $self->header(); print $self->parse_html_template("generic/error", $add_params); + print STDERR "Error: $error\n"; + $main::lxdebug->leave_sub(); - die("Error: $error\n"); + ::end_of_request(); } sub show_generic_information { @@ -917,7 +922,7 @@ sub show_generic_information { $main::lxdebug->leave_sub(); - die("Information: $text\n"); + ::end_of_request(); } # write Trigger JavaScript-Code ($qty = quantity of Triggers) @@ -975,7 +980,7 @@ sub redirect { if (!$self->{callback}) { $self->info($msg); - exit; + ::end_of_request(); } # my ($script, $argv) = split(/\?/, $self->{callback}, 2); @@ -1257,20 +1262,23 @@ sub parse_template { $self->{OUT} = ">$self->{tmpfile}"; } + my $result; + if ($self->{OUT}) { - open(OUT, "$self->{OUT}") or $self->error("$self->{OUT} : $!"); + open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!"); + $result = $template->parse(*OUT); + close OUT; + } else { - open(OUT, ">-") or $self->error("STDOUT : $!"); $self->header; + $result = $template->parse(*STDOUT); } - if (!$template->parse(*OUT)) { + if (!$result) { $self->cleanup(); $self->error("$self->{IN} : " . $template->get_error()); } - close(OUT); - if ($template->uses_temp_file() || $self->{media} eq 'email') { if ($self->{media} eq 'email') { @@ -1334,8 +1342,11 @@ sub parse_template { #print(STDERR "OUT $self->{OUT}\n"); for my $i (1 .. $self->{copies}) { if ($self->{OUT}) { - open(OUT, $self->{OUT}) - or $self->error($self->cleanup . "$self->{OUT} : $!"); + open OUT, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT while ; + close OUT; + seek IN, 0, 0; + } else { $self->{attachment_filename} = ($self->{attachment_filename}) ? $self->{attachment_filename} @@ -1348,18 +1359,8 @@ Content-Length: $numbytes |; - open(OUT, ">-") or $self->error($self->cleanup . "$!: STDOUT"); - - } - - while () { - print OUT $_; - + $::locale->with_raw_io(\*STDOUT, sub { print while }); } - - close(OUT); - - seek IN, 0, 0; } close(IN); @@ -1579,7 +1580,8 @@ sub dbconnect_noauto { sub get_standard_dbh { $main::lxdebug->enter_sub(2); - my ($self, $myconfig) = @_; + my $self = shift; + my $myconfig = shift || \%::myconfig; if ($standard_dbh && !$standard_dbh->{Active}) { $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore"); @@ -1780,8 +1782,9 @@ sub check_exchangerate { sub get_all_currencies { $main::lxdebug->enter_sub(); - my ($self, $myconfig) = @_; - my $dbh = $self->get_standard_dbh($myconfig); + my $self = shift; + my $myconfig = shift || \%::myconfig; + my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT curr FROM defaults|; @@ -2620,7 +2623,7 @@ sub all_vc { my ($self, $myconfig, $table, $module) = @_; my $ref; - my $dbh = $self->get_standard_dbh($myconfig); + my $dbh = $self->get_standard_dbh; $table = $table eq "customer" ? "customer" : "vendor"; @@ -3028,8 +3031,8 @@ sub lastname_used { sub current_date { $main::lxdebug->enter_sub(); - my $self = shift; - my $myconfig = shift || \%::myconfig; + my $self = shift; + my $myconfig = shift || \%::myconfig; my ($thisdate, $days) = @_; my $dbh = $self->get_standard_dbh($myconfig);