Link History zu EmailJournal
[kivitendo-erp.git] / SL / Form.pm
index 7a9c54e..3969cbf 100644 (file)
@@ -63,6 +63,7 @@ use SL::DB::Default;
 use SL::DB::PaymentTerm;
 use SL::DB::Vendor;
 use SL::DO;
+use SL::Helper::Flash qw();
 use SL::IC;
 use SL::IS;
 use SL::Layout::Dispatcher;
@@ -83,6 +84,8 @@ use URI;
 use List::Util qw(first max min sum);
 use List::MoreUtils qw(all any apply);
 use SL::DB::Tax;
+use SL::Helper::File qw(:all);
+use SL::Helper::CreatePDF qw(merge_pdfs);
 
 use strict;
 
@@ -343,13 +346,12 @@ sub numtextrows {
 }
 
 sub dberror {
-  $main::lxdebug->enter_sub();
-
   my ($self, $msg) = @_;
 
-  $self->error("$msg\n" . $DBI::errstr);
-
-  $main::lxdebug->leave_sub();
+  die SL::X::DBError->new(
+    msg   => $msg,
+    error => $DBI::errstr,
+  );
 }
 
 sub isblank {
@@ -681,20 +683,6 @@ sub show_generic_error {
     'label_error' => $error,
   };
 
-  if ($params{action}) {
-    my @vars;
-
-    map { delete($self->{$_}); } qw(action);
-    map { push @vars, { "name" => $_, "value" => $self->{$_} } if (!ref($self->{$_})); } keys %{ $self };
-
-    $add_params->{SHOW_BUTTON}  = 1;
-    $add_params->{BUTTON_LABEL} = $params{label} || $params{action};
-    $add_params->{VARIABLES}    = \@vars;
-
-  } elsif ($params{back_button}) {
-    $add_params->{SHOW_BACK_BUTTON} = 1;
-  }
-
   $self->{title} = $params{title} if $params{title};
 
   $self->header();
@@ -746,6 +734,7 @@ sub redirect {
     $self->info($msg);
 
   } else {
+    SL::Helper::Flash::flash_later('info', $msg) if $msg;
     $self->_store_redirect_info_in_session;
     print $::form->redirect_header($self->{callback});
   }
@@ -1089,9 +1078,18 @@ sub parse_template {
   # therefore copy to webdav, even if we do not have the webdav feature enabled (just archive)
   my $copy_to_webdav =  $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type};
 
+  if ( $ext_for_format eq 'pdf' && $::instance_conf->get_doc_storage ) {
+    $self->append_general_pdf_attachments(filepath =>  $self->{tmpdir}."/".$self->{tmpfile},
+                                          type     =>  $self->{type});
+  }
   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 (!$self->{preview} && $::instance_conf->get_doc_storage)
+    {
+      $self->{attachment_filename} ||= $self->generate_attachment_filename;
+      $self->store_pdf($self);
+    }
     $self->cleanup;
     chdir("$self->{cwd}");
 
@@ -1102,98 +1100,185 @@ sub parse_template {
 
   Common::copy_file_to_webdav_folder($self) if $copy_to_webdav;
 
+  if ( !$self->{preview} && $ext_for_format eq 'pdf' && $::instance_conf->get_doc_storage) {
+    $self->{attachment_filename} ||= $self->generate_attachment_filename;
+    $self->{print_file_id} = $self->store_pdf($self);
+  }
   if ($self->{media} eq 'email') {
+    if ( getcwd() eq $self->{"tmpdir"} ) {
+      # in the case of generating pdf we are in the tmpdir, but WHY ???
+      $self->{tmpfile} = $userspath."/".$self->{tmpfile};
+      chdir("$self->{cwd}");
+    }
+    $self->send_email(\%::myconfig,$ext_for_format);
+  }
+  else {
+    $self->{OUT}      = $out;
+    $self->{OUT_MODE} = $out_mode;
+    $self->output_file($template->get_mime_type,$command_formatter);
+  }
+  delete $self->{print_file_id};
 
-    my $mail = Mailer->new;
-
-    map { $mail->{$_} = $self->{$_} }
-      qw(cc bcc subject message version format);
-    $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
-    $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
-    $mail->{fileid} = time() . '.' . $$ . '.';
-    my $full_signature     =  $self->create_email_signature();
-    $full_signature        =~ s/\r//g;
-
-    # if we send html or plain text inline
-    if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
-      $mail->{contenttype}    =  "text/html";
-      $mail->{message}        =~ s/\r//g;
-      $mail->{message}        =~ s/\n/<br>\n/g;
-      $full_signature         =~ s/\n/<br>\n/g;
-      $mail->{message}       .=  $full_signature;
-
-      open(IN, "<:encoding(UTF-8)", $self->{tmpfile})
-        or $self->error($self->cleanup . "$self->{tmpfile} : $!");
-      $mail->{message} .= $_ while <IN>;
-      close(IN);
+  $self->cleanup;
 
-    } else {
+  chdir("$self->{cwd}");
+  $main::lxdebug->leave_sub();
+}
 
-      if (!$self->{"do_not_attach"}) {
-        my $attachment_name  =  $self->{attachment_filename} || $self->{tmpfile};
-        $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
-        $mail->{attachments} =  [{ "filename" => $self->{tmpfile},
-                                   "name"     => $attachment_name }];
-      }
+sub get_bcc_defaults {
+  my ($self, $myconfig, $mybcc) = @_;
+#  if (SL::DB::Default->get->bcc_to_login) {
+#    $mybcc .= ", " if $mybcc;
+#    $mybcc .= $myconfig->{email};
+#  }
+  my $otherbcc = SL::DB::Default->get->global_bcc;
+  if ($otherbcc) {
+    $mybcc .= ", " if $mybcc;
+    $mybcc .= $otherbcc;
+  }
+  return $mybcc;
+}
 
-      $mail->{message} .= $full_signature;
-    }
+sub send_email {
+  $main::lxdebug->enter_sub();
+  my ($self, $myconfig, $ext_for_format) = @_;
+  my $mail = Mailer->new;
 
-    my $err = $mail->send();
-    $self->error($self->cleanup . "$err") if ($err);
+  map { $mail->{$_} = $self->{$_} }
+    qw(cc subject message version format);
 
-  } else {
+  $mail->{bcc}    = $self->get_bcc_defaults($myconfig, $self->{bcc});
+  $mail->{to}     = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
+  $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
+  $mail->{fileid} = time() . '.' . $$ . '.';
+  my $full_signature     =  $self->create_email_signature();
+  $full_signature        =~ s/\r//g;
 
-    $self->{OUT}      = $out;
-    $self->{OUT_MODE} = $out_mode;
+  $mail->{attachments} =  [];
+  my @attfiles;
+  # if we send html or plain text inline
+  if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
+    $mail->{contenttype}    =  "text/html";
+    $mail->{message}        =~ s/\r//g;
+    $mail->{message}        =~ s/\n/<br>\n/g;
+    $full_signature         =~ s/\n/<br>\n/g;
+    $mail->{message}       .=  $full_signature;
 
-    my $numbytes = (-s $self->{tmpfile});
     open(IN, "<", $self->{tmpfile})
       or $self->error($self->cleanup . "$self->{tmpfile} : $!");
-    binmode IN;
+    $mail->{message} .= $_ while <IN>;
+    close(IN);
 
-    $self->{copies} = 1 unless $self->{media} eq 'printer';
+  } else {
+    $main::lxdebug->message(LXDebug->DEBUG2(),"action_oldfile=" . $self->{action_oldfile}." action_nofile=".$self->{action_nofile});
+    if (!$self->{"do_not_attach"} && !$self->{action_nofile}) {
+      my $attachment_name  =  $self->{attachment_filename}  || $self->{tmpfile};
+      $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
+      if ( $self->{action_oldfile} ) {
+        $main::lxdebug->message(LXDebug->DEBUG2(),"object_id =>". $self->{id}." object_type =>". $self->{formname});
+        my ( $attfile ) = SL::File->get_all(object_id   => $self->{id},
+                                            object_type => $self->{formname},
+                                            file_type   => 'document');
+        $main::lxdebug->message(LXDebug->DEBUG2(), "old file obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      } else {
+        push @{ $mail->{attachments} }, { path => $self->{tmpfile},
+                                          id   => $self->{print_file_id},
+                                          type => "application/pdf",
+                                          name => $attachment_name };
+      }
+    }
+  }
+  if (!$self->{"do_not_attach"}) {
+    for my $i (1 .. $self->{attfile_count}) {
+      if (  $self->{"attsel_$i"} ) {
+        my $attfile = SL::File->get(id => $self->{"attfile_$i"});
+        $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      }
+    }
+    for my $i (1 .. $self->{attfile_cv_count}) {
+      if (  $self->{"attsel_cv_$i"} ) {
+        my $attfile = SL::File->get(id => $self->{"attfile_cv_$i"});
+        $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      }
+    }
+    for my $i (1 .. $self->{attfile_part_count}) {
+      if (  $self->{"attsel_part_$i"} ) {
+        my $attfile = SL::File->get(id => $self->{"attfile_part_$i"});
+        $main::lxdebug->message(LXDebug->DEBUG2(), "att file=".$self->{"attfile_$i"}." obj=".$attfile);
+        push @attfiles, $attfile if $attfile;
+      }
+    }
+    foreach my $attfile ( @attfiles ) {
+      push @{ $mail->{attachments} }, { path => SL::File->get_file_path(dbfile => $attfile),
+                                        id   => $attfile->id,
+                                        type => $attfile->file_mime_type,
+                                        name => $attfile->file_name };
+    }
+  }
+  $mail->{message}  =~ s/\r//g;
+  $mail->{message} .= $full_signature;
+  $self->{emailerr} = $mail->send();
+  # $self->error($self->cleanup . "$err") if $self->{emailerr};
+  $self->{email_journal_id} = $mail->{journalentry};
+  $self->{snumbers}  = "emailjournal" . "_" . $self->{email_journal_id};
+  $self->{what_done} = $::form->{type};
+  $self->{addition}  = "MAILED";
+  $self->save_history;
 
-    chdir("$self->{cwd}");
-    #print(STDERR "Kopien $self->{copies}\n");
-    #print(STDERR "OUT $self->{OUT}\n");
-    for my $i (1 .. $self->{copies}) {
-      if ($self->{OUT}) {
-        $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
+  #write back for message info and mail journal
+  $self->{cc}  = $mail->{cc};
+  $self->{bcc} = $mail->{bcc};
+  $self->{email} = $mail->{to};
 
-        open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
-        print OUT $_ while <IN>;
-        close OUT;
-        seek  IN, 0, 0;
+  $main::lxdebug->leave_sub();
+}
 
-      } else {
-        my %headers = ('-type'       => $template->get_mime_type,
-                       '-connection' => 'close',
-                       '-charset'    => 'UTF-8');
-
-        $self->{attachment_filename} ||= $self->generate_attachment_filename;
-
-        if ($self->{attachment_filename}) {
-          %headers = (
-            %headers,
-            '-attachment'     => $self->{attachment_filename},
-            '-content-length' => $numbytes,
-            '-charset'        => '',
-          );
-        }
+sub output_file {
+  $main::lxdebug->enter_sub();
 
-        print $::request->cgi->header(%headers);
+  my ($self,$mimeType,$command_formatter) = @_;
+  my $numbytes = (-s $self->{tmpfile});
+  open(IN, "<", $self->{tmpfile})
+    or $self->error($self->cleanup . "$self->{tmpfile} : $!");
+  binmode IN;
 
-        $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
-      }
-    }
+  $self->{copies} = 1 unless $self->{media} eq 'printer';
 
-    close(IN);
-  }
+  chdir("$self->{cwd}");
+  for my $i (1 .. $self->{copies}) {
+    if ($self->{OUT}) {
+      $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
 
-  $self->cleanup;
+      open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
+      print OUT $_ while <IN>;
+      close OUT;
+      seek  IN, 0, 0;
 
-  chdir("$self->{cwd}");
+    } else {
+      my %headers = ('-type'       => $mimeType,
+                     '-connection' => 'close',
+                     '-charset'    => 'UTF-8');
+
+      $self->{attachment_filename} ||= $self->generate_attachment_filename;
+
+      if ($self->{attachment_filename}) {
+        %headers = (
+          %headers,
+          '-attachment'     => $self->{attachment_filename},
+          '-content-length' => $numbytes,
+          '-charset'        => '',
+        );
+      }
+
+      print $::request->cgi->header(%headers);
+
+      $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
+    }
+  }
+  close(IN);
   $main::lxdebug->leave_sub();
 }
 
@@ -2465,81 +2550,7 @@ sub get_name {
   return scalar(@{ $self->{name_list} });
 }
 
-# the selection sub is used in the AR, AP, IS, IR, DO and OE module
-#
-sub all_vc {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $myconfig, $table, $module) = @_;
-
-  my $ref;
-  my $dbh = $self->get_standard_dbh;
-
-  $table = $table eq "customer" ? "customer" : "vendor";
-
-  # build selection list
-  # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege
-  # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch
-  # nicht für veränderbare Belege (oe, do, ...)
-  my $obsolete = $self->{id} ? '' : "WHERE NOT obsolete";
-  my $query = qq|SELECT count(*) FROM $table $obsolete|;
-  my ($count) = selectrow_query($self, $dbh, $query);
-
-  if ($count <= $myconfig->{vclimit}) {
-    $query = qq|SELECT id, name, salesman_id
-                FROM $table $obsolete
-                ORDER BY name|;
-    $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
-  }
-
-  # get self
-  $self->get_employee($dbh);
-
-  # setup sales contacts
-  $query = qq|SELECT e.id, e.name
-              FROM employee e
-              WHERE (e.sales = '1') AND (NOT e.id = ?)
-              ORDER BY name|;
-  $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
-
-  # this is for self
-  push(@{ $self->{all_employees} },
-       { id   => $self->{employee_id},
-         name => $self->{employee} });
-
-    # prepare query for departments
-    $query = qq|SELECT id, description
-                FROM department
-                ORDER BY description|;
-
-  $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
-
-  # get languages
-  $query = qq|SELECT id, description
-              FROM language
-              ORDER BY id|;
-
-  $self->{languages} = selectall_hashref_query($self, $dbh, $query);
-
-  # get printer
-  $query = qq|SELECT printer_description, id
-              FROM printers
-              ORDER BY printer_description|;
-
-  $self->{printers} = selectall_hashref_query($self, $dbh, $query);
-
-  # get payment terms
-  $query = qq|SELECT id, description
-              FROM payment_terms
-              ORDER BY sortkey|;
-
-  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
-
-  $main::lxdebug->leave_sub();
-}
-
 sub new_lastmtime {
-  $main::lxdebug->enter_sub();
 
   my ($self, $table, $provided_dbh) = @_;
 
@@ -2551,9 +2562,7 @@ sub new_lastmtime {
   my $ref         = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
   $ref->{mtime} ||= $ref->{itime};
   $self->{lastmtime} = $ref->{mtime};
-  $main::lxdebug->message(LXDebug->DEBUG2(),"new lastmtime=".$self->{lastmtime});
 
-  $main::lxdebug->leave_sub();
 }
 
 sub mtime_ischanged {
@@ -2575,6 +2584,9 @@ sub mtime_ischanged {
   }
 }
 
+# language_payment duplicates some of the functionality of all_vc (language,
+# printer, payment_terms), and at least in the case of sales invoices both
+# all_vc and language_payment are called when adding new invoices
 sub language_payment {
   $main::lxdebug->enter_sub();
 
@@ -2598,9 +2610,9 @@ sub language_payment {
   # get payment terms
   $query = qq|SELECT id, description
               FROM payment_terms
-              ORDER BY sortkey|;
-
-  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
+              WHERE ( obsolete IS FALSE OR id = ? )
+              ORDER BY sortkey |;
+  $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef);
 
   # get buchungsgruppen
   $query = qq|SELECT id, description
@@ -2644,8 +2656,6 @@ sub create_links {
     $arap = "ap";
   }
 
-  $self->all_vc($myconfig, $table, $module);
-
   # get last customers or vendors
   my ($query, $sth, $ref);
 
@@ -2660,15 +2670,8 @@ sub create_links {
     }
 
     # now get the account numbers
-#    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
-#                FROM chart c, taxkeys tk
-#                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
-#                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
-#                ORDER BY c.accno|;
-
-#  same query as above, but without expensive subquery for each row. about 80% faster
     $query = qq|
-      SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id
+      SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id
         FROM chart c
         -- find newest entries in taxkeys
         INNER JOIN (
@@ -2698,6 +2701,7 @@ sub create_links {
 
           push @{ $self->{"${module}_links"}{$key} },
             { accno       => $ref->{accno},
+              chart_id    => $ref->{chart_id},
               description => $ref->{description},
               taxkey      => $ref->{taxkey_id},
               tax_id      => $ref->{tax_id} };
@@ -2751,7 +2755,7 @@ sub create_links {
     }
 
     # now get the account numbers
-    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
+    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id
                 FROM chart c
                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
                 WHERE c.link LIKE ?
@@ -2773,6 +2777,7 @@ sub create_links {
 
           push @{ $self->{"${module}_links"}{$key} },
             { accno       => $ref->{accno},
+              chart_id    => $ref->{chart_id},
               description => $ref->{description},
               taxkey      => $ref->{taxkey_id},
               tax_id      => $ref->{tax_id} };
@@ -2787,7 +2792,7 @@ sub create_links {
     $query =
       qq|SELECT
            c.accno, c.description,
-           a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey,
+           a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id,
            p.projectnumber,
            t.rate, t.id
          FROM acc_trans a
@@ -2924,6 +2929,22 @@ sub lastname_used {
   $main::lxdebug->leave_sub();
 }
 
+sub get_variable_content_types {
+  my %html_variables  = (
+      longdescription => 'html',
+      partnotes       => 'html',
+      notes           => 'html',
+      orignotes       => 'html',
+      notes1          => 'html',
+      notes2          => 'html',
+      notes3          => 'html',
+      notes4          => 'html',
+      header_text     => 'html',
+      footer_text     => 'html',
+  );
+  return \%html_variables;
+}
+
 sub current_date {
   $main::lxdebug->enter_sub();
 
@@ -3090,6 +3111,7 @@ sub save_status {
 
 #--- 4 locale ---#
 # $main::locale->text('SAVED')
+# $main::locale->text('SCREENED')
 # $main::locale->text('DELETED')
 # $main::locale->text('ADDED')
 # $main::locale->text('PAYMENT POSTED')
@@ -3102,6 +3124,8 @@ sub save_status {
 # $main::locale->text('MAILED')
 # $main::locale->text('SCREENED')
 # $main::locale->text('CANCELED')
+# $main::locale->text('IMPORT')
+# $main::locale->text('UNIMPORT')
 # $main::locale->text('invoice')
 # $main::locale->text('proforma')
 # $main::locale->text('sales_order')
@@ -3157,7 +3181,10 @@ sub get_history {
     while(my $hash_ref = $sth->fetchrow_hashref()) {
       $hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
       $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
-      $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g;
+      my ( $what, $number ) = split /_/, $hash_ref->{snumbers};
+      $hash_ref->{snumbers} = $number;
+      $hash_ref->{haslink}  = 'controller.pl?action=EmailJournal/show&id='.$number if $what eq 'emailjournal';
+      $hash_ref->{snumbers} = $main::locale->text("E-Mail").' '.$number if $what eq 'emailjournal';
       $tempArray[$i++] = $hash_ref;
     }
     $main::lxdebug->leave_sub() and return \@tempArray