X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/570abc830fa2c4382d1b731297420c4eefde8cc4..065dd9a6920db0bcaa4bebdc5497f90ccbde835b:/SL/Form.pm

diff --git a/SL/Form.pm b/SL/Form.pm
index bf9deb4ba..6d2ae4914 100644
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -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();
 
@@ -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();
 
@@ -1259,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') {
@@ -1336,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 <IN>;
+          close OUT;
+          seek IN, 0, 0;
+
         } else {
           $self->{attachment_filename} = ($self->{attachment_filename})
                                        ? $self->{attachment_filename}
@@ -1350,18 +1359,8 @@ Content-Length: $numbytes
 
 |;
 
-          open(OUT, ">-") or $self->error($self->cleanup . "$!: STDOUT");
-
-        }
-
-        while (<IN>) {
-          print OUT $_;
-
+          $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
         }
-
-        close(OUT);
-
-        seek IN, 0, 0;
       }
 
       close(IN);
@@ -1581,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");
@@ -1782,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|;
 
@@ -2622,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";
 
@@ -3030,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);