MT940 Import aqbanking Version 6 benötigt andere Parameter
[kivitendo-erp.git] / SL / Form.pm
index da46843..e814351 100644 (file)
@@ -47,6 +47,7 @@ use CGI;
 use Cwd;
 use Encode;
 use File::Copy;
+use File::Temp ();
 use IO::File;
 use Math::BigInt;
 use POSIX qw(strftime);
@@ -115,11 +116,6 @@ sub new {
   return $self;
 }
 
-sub read_cgi_input {
-  my ($self) = @_;
-  SL::Request::read_cgi_input($self);
-}
-
 sub _flatten_variables_rec {
   $main::lxdebug->enter_sub(2);
 
@@ -249,7 +245,7 @@ sub hide_form {
 
 sub throw_on_error {
   my ($self, $code) = @_;
-  local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) };
+  local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) };
   $code->();
 }
 
@@ -311,9 +307,9 @@ sub numtextrows {
 sub dberror {
   my ($self, $msg) = @_;
 
-  die SL::X::DBError->new(
-    msg   => $msg,
-    error => $DBI::errstr,
+  SL::X::DBError->throw(
+    msg      => $msg,
+    db_error => $DBI::errstr,
   );
 }
 
@@ -397,7 +393,7 @@ sub create_http_response {
   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
   $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 
-  map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length);
+  map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
 
   my $output = $cgi->header(%cgi_params);
 
@@ -914,11 +910,18 @@ sub parse_template {
 
   local (*IN, *OUT);
 
-  my $defaults  = SL::DB::Default->get;
-  my $userspath = $::lx_office_conf{paths}->{userspath};
+  my $defaults        = SL::DB::Default->get;
+
+  my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files};
+  $self->{cwd}        = getcwd();
+  my $temp_dir        = File::Temp->newdir(
+    "kivitendo-print-XXXXXX",
+    DIR     => $self->{cwd} . "/" . $::lx_office_conf{paths}->{userspath},
+    CLEANUP => !$keep_temp_files,
+  );
 
-  $self->{"cwd"} = getcwd();
-  $self->{"tmpdir"} = $self->{cwd} . "/${userspath}";
+  my $userspath   = File::Spec->abs2rel($temp_dir->dirname);
+  $self->{tmpdir} = $temp_dir->dirname;
 
   my $ext_for_format;
 
@@ -935,13 +938,6 @@ sub parse_template {
     $template_type  = 'HTML';
     $ext_for_format = 'html';
 
-  } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) {
-    $template_type  = 'XML';
-    $ext_for_format = 'xml';
-
-  } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
-    $template_type = 'XML';
-
   } elsif ( $self->{"format"} =~ /excel/i ) {
     $template_type  = 'Excel';
     $ext_for_format = 'xls';
@@ -985,7 +981,6 @@ sub parse_template {
 
   # OUT is used for the media, screen, printer, email
   # for postscript we store a copy in a temporary file
-  my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files};
 
   my ($temp_fh, $suffix);
   $suffix =  $self->{IN};
@@ -1035,7 +1030,14 @@ sub parse_template {
   }
   if ($self->{media} eq 'file') {
     copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
-    Common::copy_file_to_webdav_folder($self)                                                                         if $copy_to_webdav;
+
+    if ($copy_to_webdav) {
+      if (my $error = Common::copy_file_to_webdav_folder($self)) {
+        chdir("$self->{cwd}");
+        $self->error($error);
+      }
+    }
+
     if (!$self->{preview} && $self->doc_storage_enabled)
     {
       $self->{attachment_filename} ||= $self->generate_attachment_filename;
@@ -1049,7 +1051,12 @@ sub parse_template {
     return;
   }
 
-  Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
+  if ($copy_to_webdav) {
+    if (my $error = Common::copy_file_to_webdav_folder($self)) {
+      chdir("$self->{cwd}");
+      $self->error($error);
+    }
+  }
 
   if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->doc_storage_enabled) {
     $self->{attachment_filename} ||= $self->generate_attachment_filename;
@@ -1112,8 +1119,8 @@ sub send_email {
   if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
     $mail->{content_type}   =  "text/html";
     $mail->{message}        =~ s/\r//g;
-    $mail->{message}        =~ s/\n/<br>\n/g;
-    $full_signature         =~ s/\n/<br>\n/g;
+    $mail->{message}        =~ s{\n}{<br>\n}g;
+    $full_signature         =~ s{\n}{<br>\n}g;
     $mail->{message}       .=  $full_signature;
 
     open(IN, "<", $self->{tmpfile})
@@ -1123,7 +1130,7 @@ sub send_email {
 
   } elsif (($self->{attachment_policy} // '') ne 'no_file') {
     my $attachment_name  =  $self->{attachment_filename}  || $self->{tmpfile};
-    $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
+    $attachment_name     =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format);
 
     if (($self->{attachment_policy} // '') eq 'old_file') {
       my ( $attfile ) = SL::File->get_all(object_id   => $self->{id},
@@ -1344,7 +1351,7 @@ sub generate_email_subject {
 
 sub generate_email_body {
   $main::lxdebug->enter_sub();
-  my ($self) = @_;
+  my ($self, %params) = @_;
   # simple german and english will work grammatically (most european languages as well)
   # Dear Mr Alan Greenspan:
   # Sehr geehrte Frau Meyer,
@@ -1352,7 +1359,7 @@ sub generate_email_body {
   # Gentile Signora Ferrari,
   my $body = '';
 
-  if ($self->{cp_id}) {
+  if ($self->{cp_id} && !$params{record_email}) {
     my $givenname = SL::DB::Contact->load_cached($self->{cp_id})->cp_givenname; # for qw(gender givename name);
     my $name      = SL::DB::Contact->load_cached($self->{cp_id})->cp_name; # for qw(gender givename name);
     my $gender    = SL::DB::Contact->load_cached($self->{cp_id})->cp_gender; # for qw(gender givename name);
@@ -1860,7 +1867,7 @@ sub add_shipto {
   my @values;
 
   foreach my $item (qw(name department_1 department_2 street zipcode city country gln
-                       contact cp_gender phone fax email)) {
+                       contact phone fax email)) {
     if ($self->{"shipto$item"}) {
       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
     }
@@ -1869,6 +1876,12 @@ sub add_shipto {
 
   return if !$shipto;
 
+  # shiptocp_gender only makes sense, if any other shipto attribute is set.
+  # Because shiptocp_gender is set to 'm' by default in forms
+  # it must not be considered above to decide if shiptos has to be added or
+  # updated, but must be inserted or updated as well in case.
+  push(@values, $self->{shiptocp_gender});
+
   my $shipto_id = $self->{shipto_id};
 
   if ($self->{shipto_id}) {
@@ -2058,26 +2071,6 @@ sub _get_projects {
   $main::lxdebug->leave_sub();
 }
 
-sub _get_shipto {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $dbh, $vc_id, $key) = @_;
-
-  $key = "all_shipto" unless ($key);
-
-  if ($vc_id) {
-    # get shipping addresses
-    my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
-
-    $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
-
-  } else {
-    $self->{$key} = [];
-  }
-
-  $main::lxdebug->leave_sub();
-}
-
 sub _get_printers {
   $main::lxdebug->enter_sub();
 
@@ -2360,31 +2353,19 @@ sub _get_simple {
   $main::lxdebug->leave_sub();
 }
 
-#sub _get_groups {
-#  $main::lxdebug->enter_sub();
-#
-#  my ($self, $dbh, $key) = @_;
-#
-#  $key ||= "all_groups";
-#
-#  my $groups = $main::auth->read_groups();
-#
-#  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
-#
-#  $main::lxdebug->leave_sub();
-#}
-
 sub get_lists {
   $main::lxdebug->enter_sub();
 
   my $self = shift;
   my %params = @_;
 
+  croak "get_lists: shipto is no longer supported" if $params{shipto};
+
   my $dbh = $self->get_standard_dbh(\%main::myconfig);
   my ($sth, $query, $ref);
 
   my ($vc, $vc_id);
-  if ($params{contacts} || $params{shipto}) {
+  if ($params{contacts}) {
     $vc = 'customer' if $self->{"vc"} eq "customer";
     $vc = 'vendor'   if $self->{"vc"} eq "vendor";
     die "invalid use of get_lists, need 'vc'" unless $vc;
@@ -2395,10 +2376,6 @@ sub get_lists {
     $self->_get_contacts($dbh, $vc_id, $params{"contacts"});
   }
 
-  if ($params{"shipto"}) {
-    $self->_get_shipto($dbh, $vc_id, $params{"shipto"});
-  }
-
   if ($params{"projects"} || $params{"all_projects"}) {
     $self->_get_projects($dbh, $params{"all_projects"} ?
                          $params{"all_projects"} : $params{"projects"},
@@ -2473,10 +2450,6 @@ sub get_lists {
     $self->_get_warehouses($dbh, $params{warehouses});
   }
 
-#  if ($params{groups}) {
-#    $self->_get_groups($dbh, $params{groups});
-#  }
-
   if ($params{partsgroup}) {
     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
   }
@@ -3407,6 +3380,14 @@ sub prepare_for_printing {
     $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
   }
 
+  # Translate units
+  if (($self->{language} // '') ne '') {
+    my $template_arrays = $self->{TEMPLATE_ARRAYS} || $self;
+    for my $idx (0..scalar(@{ $template_arrays->{unit} }) - 1) {
+      $template_arrays->{unit}->[$idx] = AM->translate_units($self, $self->{language}, $template_arrays->{unit}->[$idx], $template_arrays->{qty}->[$idx])
+    }
+  }
+
   $self->{template_meta} = {
     formname  => $self->{formname},
     language  => SL::DB::Manager::Language->find_by_or_create(id => $self->{language_id} || undef),