SL/Form.pm

   1 #=====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (C) 1998-2002
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 # Contributors: Thomas Bayen <bayen@gmx.de>
  16 #               Antti Kaihola <akaihola@siba.fi>
  17 #               Moritz Bunkus (tex code)
  18 #
  19 # This program is free software; you can redistribute it and/or modify
  20 # it under the terms of the GNU General Public License as published by
  21 # the Free Software Foundation; either version 2 of the License, or
  22 # (at your option) any later version.
  23 #
  24 # This program is distributed in the hope that it will be useful,
  25 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  26 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27 # GNU General Public License for more details.
  28 # You should have received a copy of the GNU General Public License
  29 # along with this program; if not, write to the Free Software
  30 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  31 # MA 02110-1335, USA.
  32 #======================================================================
  33 # Utilities for parsing forms
  34 # and supporting routines for linking account numbers
  35 # used in AR, AP and IS, IR modules
  36 #
  37 #======================================================================
  38
  39 package Form;
  40
  41 use Carp;
  42 use Data::Dumper;
  43
  44 use Carp;
  45 use CGI;
  46 use Cwd;
  47 use Encode;
  48 use File::Copy;
  49 use File::Temp ();
  50 use IO::File;
  51 use Math::BigInt;
  52 use POSIX qw(strftime);
  53 use SL::Auth;
  54 use SL::Auth::DB;
  55 use SL::Auth::LDAP;
  56 use SL::AM;
  57 use SL::Common;
  58 use SL::CVar;
  59 use SL::DB;
  60 use SL::DBConnect;
  61 use SL::DBUtils;
  62 use SL::DB::Customer;
  63 use SL::DB::Default;
  64 use SL::DB::PaymentTerm;
  65 use SL::DB::Vendor;
  66 use SL::DO;
  67 use SL::Helper::Flash qw();
  68 use SL::IC;
  69 use SL::IS;
  70 use SL::Layout::Dispatcher;
  71 use SL::Locale;
  72 use SL::Locale::String;
  73 use SL::Mailer;
  74 use SL::Menu;
  75 use SL::MoreCommon qw(uri_encode uri_decode);
  76 use SL::OE;
  77 use SL::PrefixedNumber;
  78 use SL::Request;
  79 use SL::Template;
  80 use SL::User;
  81 use SL::Util;
  82 use SL::Version;
  83 use SL::X;
  84 use Template;
  85 use URI;
  86 use List::Util qw(first max min sum);
  87 use List::MoreUtils qw(all any apply);
  88 use SL::DB::Tax;
  89 use SL::Helper::File qw(:all);
  90 use SL::Helper::Number;
  91 use SL::Helper::CreatePDF qw(merge_pdfs);
  92
  93 use strict;
  94
  95 sub read_version {
  96   SL::Version->get_version;
  97 }
  98
  99 sub new {
 100   $main::lxdebug->enter_sub();
 101
 102   my $type = shift;
 103
 104   my $self = {};
 105
 106   no warnings 'once';
 107   if ($LXDebug::watch_form) {
 108     require SL::Watchdog;
 109     tie %{ $self }, 'SL::Watchdog';
 110   }
 111
 112   bless $self, $type;
 113
 114   $main::lxdebug->leave_sub();
 115
 116   return $self;
 117 }
 118
 119 sub _flatten_variables_rec {
 120   $main::lxdebug->enter_sub(2);
 121
 122   my $self   = shift;
 123   my $curr   = shift;
 124   my $prefix = shift;
 125   my $key    = shift;
 126
 127   my @result;
 128
 129   if ('' eq ref $curr->{$key}) {
 130     @result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} });
 131
 132   } elsif ('HASH' eq ref $curr->{$key}) {
 133     foreach my $hash_key (sort keys %{ $curr->{$key} }) {
 134       push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key);
 135     }
 136
 137   } else {
 138     foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) {
 139       my $first_array_entry = 1;
 140
 141       my $element = $curr->{$key}[$idx];
 142
 143       if ('HASH' eq ref $element) {
 144         foreach my $hash_key (sort keys %{ $element }) {
 145           push @result, $self->_flatten_variables_rec($element, $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key);
 146           $first_array_entry = 0;
 147         }
 148       } else {
 149         push @result, { 'key' => $prefix . $key . '[]', 'value' => $element };
 150       }
 151     }
 152   }
 153
 154   $main::lxdebug->leave_sub(2);
 155
 156   return @result;
 157 }
 158
 159 sub flatten_variables {
 160   $main::lxdebug->enter_sub(2);
 161
 162   my $self = shift;
 163   my @keys = @_;
 164
 165   my @variables;
 166
 167   foreach (@keys) {
 168     push @variables, $self->_flatten_variables_rec($self, '', $_);
 169   }
 170
 171   $main::lxdebug->leave_sub(2);
 172
 173   return @variables;
 174 }
 175
 176 sub flatten_standard_variables {
 177   $main::lxdebug->enter_sub(2);
 178
 179   my $self      = shift;
 180   my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar), @_);
 181
 182   my @variables;
 183
 184   foreach (grep { ! $skip_keys{$_} } keys %{ $self }) {
 185     push @variables, $self->_flatten_variables_rec($self, '', $_);
 186   }
 187
 188   $main::lxdebug->leave_sub(2);
 189
 190   return @variables;
 191 }
 192
 193 sub escape {
 194   my ($self, $str) = @_;
 195
 196   return uri_encode($str);
 197 }
 198
 199 sub unescape {
 200   my ($self, $str) = @_;
 201
 202   return uri_decode($str);
 203 }
 204
 205 sub quote {
 206   $main::lxdebug->enter_sub();
 207   my ($self, $str) = @_;
 208
 209   if ($str && !ref($str)) {
 210     $str =~ s/\"/&quot;/g;
 211   }
 212
 213   $main::lxdebug->leave_sub();
 214
 215   return $str;
 216 }
 217
 218 sub unquote {
 219   $main::lxdebug->enter_sub();
 220   my ($self, $str) = @_;
 221
 222   if ($str && !ref($str)) {
 223     $str =~ s/&quot;/\"/g;
 224   }
 225
 226   $main::lxdebug->leave_sub();
 227
 228   return $str;
 229 }
 230
 231 sub hide_form {
 232   $main::lxdebug->enter_sub();
 233   my $self = shift;
 234
 235   if (@_) {
 236     map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
 237   } else {
 238     for (sort keys %$self) {
 239       next if (($_ eq "header") || (ref($self->{$_}) ne ""));
 240       print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
 241     }
 242   }
 243   $main::lxdebug->leave_sub();
 244 }
 245
 246 sub throw_on_error {
 247   my ($self, $code) = @_;
 248   local $self->{__ERROR_HANDLER} = sub { SL::X::FormError->throw(error => $_[0]) };
 249   $code->();
 250 }
 251
 252 sub error {
 253   $main::lxdebug->enter_sub();
 254
 255   $main::lxdebug->show_backtrace();
 256
 257   my ($self, $msg) = @_;
 258
 259   if ($self->{__ERROR_HANDLER}) {
 260     $self->{__ERROR_HANDLER}->($msg);
 261
 262   } elsif ($ENV{HTTP_USER_AGENT}) {
 263     $msg =~ s/\n/<br>/g;
 264     $self->show_generic_error($msg);
 265
 266   } else {
 267     confess "Error: $msg\n";
 268   }
 269
 270   $main::lxdebug->leave_sub();
 271 }
 272
 273 sub info {
 274   $main::lxdebug->enter_sub();
 275
 276   my ($self, $msg) = @_;
 277
 278   if ($ENV{HTTP_USER_AGENT}) {
 279     $self->header;
 280     print $self->parse_html_template('generic/form_info', { message => $msg });
 281
 282   } elsif ($self->{info_function}) {
 283     &{ $self->{info_function} }($msg);
 284   } else {
 285     print "$msg\n";
 286   }
 287
 288   $main::lxdebug->leave_sub();
 289 }
 290
 291 # calculates the number of rows in a textarea based on the content and column number
 292 # can be capped with maxrows
 293 sub numtextrows {
 294   $main::lxdebug->enter_sub();
 295   my ($self, $str, $cols, $maxrows, $minrows) = @_;
 296
 297   $minrows ||= 1;
 298
 299   my $rows   = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
 300   $maxrows ||= $rows;
 301
 302   $main::lxdebug->leave_sub();
 303
 304   return max(min($rows, $maxrows), $minrows);
 305 }
 306
 307 sub dberror {
 308   my ($self, $msg) = @_;
 309
 310   SL::X::DBError->throw(
 311     msg      => $msg,
 312     db_error => $DBI::errstr,
 313   );
 314 }
 315
 316 sub isblank {
 317   $main::lxdebug->enter_sub();
 318
 319   my ($self, $name, $msg) = @_;
 320
 321   my $curr = $self;
 322   foreach my $part (split m/\./, $name) {
 323     if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
 324       $self->error($msg);
 325     }
 326     $curr = $curr->{$part};
 327   }
 328
 329   $main::lxdebug->leave_sub();
 330 }
 331
 332 sub _get_request_uri {
 333   my $self = shift;
 334
 335   return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
 336   return URI->new                                  if !$ENV{REQUEST_URI}; # for testing
 337
 338   my $scheme =  $::request->is_https ? 'https' : 'http';
 339   my $port   =  $ENV{SERVER_PORT};
 340   $port      =  undef if (($scheme eq 'http' ) && ($port == 80))
 341                       || (($scheme eq 'https') && ($port == 443));
 342
 343   my $uri    =  URI->new("${scheme}://");
 344   $uri->scheme($scheme);
 345   $uri->port($port);
 346   $uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR});
 347   $uri->path_query($ENV{REQUEST_URI});
 348   $uri->query('');
 349
 350   return $uri;
 351 }
 352
 353 sub _add_to_request_uri {
 354   my $self              = shift;
 355
 356   my $relative_new_path = shift;
 357   my $request_uri       = shift || $self->_get_request_uri;
 358   my $relative_new_uri  = URI->new($relative_new_path);
 359   my @request_segments  = $request_uri->path_segments;
 360
 361   my $new_uri           = $request_uri->clone;
 362   $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments);
 363
 364   return $new_uri;
 365 }
 366
 367 sub create_http_response {
 368   $main::lxdebug->enter_sub();
 369
 370   my $self     = shift;
 371   my %params   = @_;
 372
 373   my $cgi      = $::request->{cgi};
 374
 375   my $session_cookie;
 376   if (defined $main::auth) {
 377     my $uri      = $self->_get_request_uri;
 378     my @segments = $uri->path_segments;
 379     pop @segments;
 380     $uri->path_segments(@segments);
 381
 382     my $session_cookie_value = $main::auth->get_session_id();
 383
 384     if ($session_cookie_value) {
 385       $session_cookie = $cgi->cookie('-name'    => $main::auth->get_session_cookie_name(),
 386                                      '-value'   => $session_cookie_value,
 387                                      '-path'    => $uri->path,
 388                                      '-expires' => '+' . $::auth->{session_timeout} . 'm',
 389                                      '-secure'  => $::request->is_https);
 390     }
 391   }
 392
 393   my %cgi_params = ('-type' => $params{content_type});
 394   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
 395   $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 396
 397   map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
 398
 399   my $output = $cgi->header(%cgi_params);
 400
 401   $main::lxdebug->leave_sub();
 402
 403   return $output;
 404 }
 405
 406 sub header {
 407   $::lxdebug->enter_sub;
 408
 409   my ($self, %params) = @_;
 410   my @header;
 411
 412   $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
 413
 414   if ($params{no_layout}) {
 415     $::request->{layout} = SL::Layout::Dispatcher->new(style => 'none');
 416   }
 417
 418   my $layout = $::request->{layout};
 419
 420   # standard css for all
 421   # this should gradually move to the layouts that need it
 422   $layout->use_stylesheet("$_.css") for qw(
 423     common main menu list_accounts jquery.autocomplete
 424     jquery.multiselect2side
 425     ui-lightness/jquery-ui
 426     jquery-ui.custom
 427     tooltipster themes/tooltipster-light
 428   );
 429
 430   $layout->use_javascript("$_.js") for (qw(
 431     jquery jquery-ui jquery.cookie jquery.checkall jquery.download
 432     jquery/jquery.form jquery/fixes client_js
 433     jquery/jquery.tooltipster.min
 434     common part_selection
 435   ), "jquery/ui/i18n/jquery.ui.datepicker-$::myconfig{countrycode}");
 436
 437   $self->{favicon} ||= "favicon.ico";
 438   $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->read_version if $self->{title} || !$self->{titlebar};
 439
 440   # build includes
 441   if ($self->{refresh_url} || $self->{refresh_time}) {
 442     my $refresh_time = $self->{refresh_time} || 3;
 443     my $refresh_url  = $self->{refresh_url}  || $ENV{REFERER};
 444     push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
 445   }
 446
 447   my $auto_reload_resources_param = $layout->auto_reload_resources_param;
 448
 449   push @header, map { qq|<link rel="stylesheet" href="${_}${auto_reload_resources_param}" type="text/css" title="Stylesheet">| } $layout->stylesheets;
 450   push @header, "<style type='text/css'>\@page { size:landscape; }</style> "                     if $self->{landscape};
 451   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>"         if -f $self->{favicon};
 452   push @header, map { qq|<script type="text/javascript" src="${_}${auto_reload_resources_param}"></script>| }                    $layout->javascripts;
 453   push @header, '<meta name="viewport" content="width=device-width, initial-scale=1">';
 454   push @header, $self->{javascript} if $self->{javascript};
 455   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
 456
 457   my  %doctypes = (
 458     strict       => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|,
 459     transitional => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|,
 460     frameset     => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|,
 461     html5        => qq|<!DOCTYPE html>|,
 462   );
 463
 464   # output
 465   print $self->create_http_response(content_type => 'text/html', charset => 'UTF-8');
 466   print $doctypes{$params{doctype} || 'transitional'}, $/;
 467   print <<EOT;
 468 <html>
 469  <head>
 470   <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
 471   <title>$self->{titlebar}</title>
 472 EOT
 473   print "  $_\n" for @header;
 474   print <<EOT;
 475   <meta name="robots" content="noindex,nofollow">
 476  </head>
 477  <body>
 478
 479 EOT
 480   print $::request->{layout}->pre_content;
 481   print $::request->{layout}->start_content;
 482
 483   $layout->header_done;
 484
 485   $::lxdebug->leave_sub;
 486 }
 487
 488 sub footer {
 489   return unless $::request->{layout}->need_footer;
 490
 491   print $::request->{layout}->end_content;
 492   print $::request->{layout}->post_content;
 493
 494   if (my @inline_scripts = $::request->{layout}->javascripts_inline) {
 495     print "<script type='text/javascript'>" . join("; ", @inline_scripts) . "</script>\n";
 496   }
 497
 498   print <<EOL
 499  </body>
 500 </html>
 501 EOL
 502 }
 503
 504 sub ajax_response_header {
 505   $main::lxdebug->enter_sub();
 506
 507   my ($self) = @_;
 508
 509   my $output = $::request->{cgi}->header('-charset' => 'UTF-8');
 510
 511   $main::lxdebug->leave_sub();
 512
 513   return $output;
 514 }
 515
 516 sub redirect_header {
 517   my $self     = shift;
 518   my $new_url  = shift;
 519
 520   my $base_uri = $self->_get_request_uri;
 521   my $new_uri  = URI->new_abs($new_url, $base_uri);
 522
 523   die "Headers already sent" if $self->{header};
 524   $self->{header} = 1;
 525
 526   return $::request->{cgi}->redirect($new_uri);
 527 }
 528
 529 sub set_standard_title {
 530   $::lxdebug->enter_sub;
 531   my $self = shift;
 532
 533   $self->{titlebar}  = "kivitendo " . $::locale->text('Version') . " " . $self->read_version;
 534   $self->{titlebar} .= "- $::myconfig{name}"   if $::myconfig{name};
 535   $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
 536
 537   $::lxdebug->leave_sub;
 538 }
 539
 540 sub _prepare_html_template {
 541   $main::lxdebug->enter_sub();
 542
 543   my ($self, $file, $additional_params) = @_;
 544   my $language;
 545
 546   if (!%::myconfig || !$::myconfig{"countrycode"}) {
 547     $language = $::lx_office_conf{system}->{language};
 548   } else {
 549     $language = $main::myconfig{"countrycode"};
 550   }
 551   $language = "de" unless ($language);
 552
 553   my $webpages_path = $::request->layout->webpages_path;
 554
 555   if (-f "${webpages_path}/${file}.html") {
 556     $file = "${webpages_path}/${file}.html";
 557
 558   } elsif (ref $file eq 'SCALAR') {
 559     # file is a scalarref, use inline mode
 560   } else {
 561     my $info = "Web page template '${file}' not found.\n";
 562     $::form->header;
 563     print qq|<pre>$info</pre>|;
 564     $::dispatcher->end_request;
 565   }
 566
 567   $additional_params->{AUTH}          = $::auth;
 568   $additional_params->{INSTANCE_CONF} = $::instance_conf;
 569   $additional_params->{LOCALE}        = $::locale;
 570   $additional_params->{LXCONFIG}      = \%::lx_office_conf;
 571   $additional_params->{LXDEBUG}       = $::lxdebug;
 572   $additional_params->{MYCONFIG}      = \%::myconfig;
 573
 574   $main::lxdebug->leave_sub();
 575
 576   return $file;
 577 }
 578
 579 sub parse_html_template {
 580   $main::lxdebug->enter_sub();
 581
 582   my ($self, $file, $additional_params) = @_;
 583
 584   $additional_params ||= { };
 585
 586   my $real_file = $self->_prepare_html_template($file, $additional_params);
 587   my $template  = $self->template;
 588
 589   map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
 590
 591   my $output;
 592   $template->process($real_file, $additional_params, \$output) || die $template->error;
 593
 594   $main::lxdebug->leave_sub();
 595
 596   return $output;
 597 }
 598
 599 sub template { $::request->presenter->get_template }
 600
 601 sub show_generic_error {
 602   $main::lxdebug->enter_sub();
 603
 604   my ($self, $error, %params) = @_;
 605
 606   if ($self->{__ERROR_HANDLER}) {
 607     $self->{__ERROR_HANDLER}->($error);
 608     $main::lxdebug->leave_sub();
 609     return;
 610   }
 611
 612   if ($::request->is_ajax) {
 613     SL::ClientJS->new
 614       ->error($error)
 615       ->render(SL::Controller::Base->new);
 616     $::dispatcher->end_request;
 617   }
 618
 619   my $add_params = {
 620     'title_error' => $params{title},
 621     'label_error' => $error,
 622   };
 623
 624   $self->{title} = $params{title} if $params{title};
 625
 626   for my $bar ($::request->layout->get('actionbar')) {
 627     $bar->add(
 628       action => [
 629         t8('Back'),
 630         call      => [ 'kivi.history_back' ],
 631         accesskey => 'enter',
 632       ],
 633     );
 634   }
 635
 636   $self->header();
 637   print $self->parse_html_template("generic/error", $add_params);
 638
 639   print STDERR "Error: $error\n";
 640
 641   $main::lxdebug->leave_sub();
 642
 643   $::dispatcher->end_request;
 644 }
 645
 646 sub show_generic_information {
 647   $main::lxdebug->enter_sub();
 648
 649   my ($self, $text, $title) = @_;
 650
 651   my $add_params = {
 652     'title_information' => $title,
 653     'label_information' => $text,
 654   };
 655
 656   $self->{title} = $title if ($title);
 657
 658   $self->header();
 659   print $self->parse_html_template("generic/information", $add_params);
 660
 661   $main::lxdebug->leave_sub();
 662
 663   $::dispatcher->end_request;
 664 }
 665
 666 sub _store_redirect_info_in_session {
 667   my ($self) = @_;
 668
 669   return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x;
 670
 671   my ($controller, $params) = ($1, $2);
 672   my $form                  = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params };
 673   $self->{callback}         = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form);
 674 }
 675
 676 sub redirect {
 677   $main::lxdebug->enter_sub();
 678
 679   my ($self, $msg) = @_;
 680
 681   if (!$self->{callback}) {
 682     $self->info($msg);
 683
 684   } else {
 685     SL::Helper::Flash::flash_later('info', $msg) if $msg;
 686     $self->_store_redirect_info_in_session;
 687     print $::form->redirect_header($self->{callback});
 688   }
 689
 690   $::dispatcher->end_request;
 691
 692   $main::lxdebug->leave_sub();
 693 }
 694
 695 # sort of columns removed - empty sub
 696 sub sort_columns {
 697   $main::lxdebug->enter_sub();
 698
 699   my ($self, @columns) = @_;
 700
 701   $main::lxdebug->leave_sub();
 702
 703   return @columns;
 704 }
 705 #
 706
 707 sub format_amount {
 708   my ($self, $myconfig, $amount, $places, $dash) = @_;
 709   SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
 710 }
 711
 712 sub format_amount_units {
 713   $main::lxdebug->enter_sub();
 714
 715   my $self             = shift;
 716   my %params           = @_;
 717
 718   my $myconfig         = \%main::myconfig;
 719   my $amount           = $params{amount} * 1;
 720   my $places           = $params{places};
 721   my $part_unit_name   = $params{part_unit};
 722   my $amount_unit_name = $params{amount_unit};
 723   my $conv_units       = $params{conv_units};
 724   my $max_places       = $params{max_places};
 725
 726   if (!$part_unit_name) {
 727     $main::lxdebug->leave_sub();
 728     return '';
 729   }
 730
 731   my $all_units        = AM->retrieve_all_units;
 732
 733   if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
 734     $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
 735   }
 736
 737   if (!scalar @{ $conv_units }) {
 738     my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
 739     $main::lxdebug->leave_sub();
 740     return $result;
 741   }
 742
 743   my $part_unit  = $all_units->{$part_unit_name};
 744   my $conv_unit  = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;
 745
 746   $amount       *= $conv_unit->{factor};
 747
 748   my @values;
 749   my $num;
 750
 751   foreach my $unit (@$conv_units) {
 752     my $last = $unit->{name} eq $part_unit->{name};
 753     if (!$last) {
 754       $num     = int($amount / $unit->{factor});
 755       $amount -= $num * $unit->{factor};
 756     }
 757
 758     if ($last ? $amount : $num) {
 759       push @values, { "unit"   => $unit->{name},
 760                       "amount" => $last ? $amount / $unit->{factor} : $num,
 761                       "places" => $last ? $places : 0 };
 762     }
 763
 764     last if $last;
 765   }
 766
 767   if (!@values) {
 768     push @values, { "unit"   => $part_unit_name,
 769                     "amount" => 0,
 770                     "places" => 0 };
 771   }
 772
 773   my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;
 774
 775   $main::lxdebug->leave_sub();
 776
 777   return $result;
 778 }
 779
 780 sub format_string {
 781   $main::lxdebug->enter_sub(2);
 782
 783   my $self  = shift;
 784   my $input = shift;
 785
 786   $input =~ s/(^|[^\#]) \#  (\d+)  /$1$_[$2 - 1]/gx;
 787   $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
 788   $input =~ s/\#\#/\#/g;
 789
 790   $main::lxdebug->leave_sub(2);
 791
 792   return $input;
 793 }
 794
 795 #
 796
 797 sub parse_amount {
 798   my ($self, $myconfig, $amount) = @_;
 799   SL::Helper::Number::_parse_number($amount, %$myconfig);
 800 }
 801
 802 sub round_amount { shift; goto &SL::Helper::Number::_round_number; }
 803
 804 sub parse_template {
 805   $main::lxdebug->enter_sub();
 806
 807   my ($self, $myconfig) = @_;
 808   my ($out, $out_mode);
 809
 810   local (*IN, *OUT);
 811
 812   my $defaults        = SL::DB::Default->get;
 813
 814   my $keep_temp_files = $::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files};
 815   $self->{cwd}        = getcwd();
 816   my $temp_dir        = File::Temp->newdir(
 817     "kivitendo-print-XXXXXX",
 818     DIR     => $self->{cwd} . "/" . $::lx_office_conf{paths}->{userspath},
 819     CLEANUP => !$keep_temp_files,
 820   );
 821
 822   my $userspath   = File::Spec->abs2rel($temp_dir->dirname);
 823   $self->{tmpdir} = $temp_dir->dirname;
 824
 825   my $ext_for_format;
 826
 827   my $template_type;
 828   if ($self->{"format"} =~ /(opendocument|oasis)/i) {
 829     $template_type  = 'OpenDocument';
 830     $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
 831
 832   } elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
 833     $template_type    = 'LaTeX';
 834     $ext_for_format   = 'pdf';
 835
 836   } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
 837     $template_type  = 'HTML';
 838     $ext_for_format = 'html';
 839
 840   } elsif ( $self->{"format"} =~ /excel/i ) {
 841     $template_type  = 'Excel';
 842     $ext_for_format = 'xls';
 843
 844   } elsif ( defined $self->{'format'}) {
 845     $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
 846
 847   } elsif ( $self->{'format'} eq '' ) {
 848     $self->error("No Outputformat given: $self->{'format'}");
 849
 850   } else { #Catch the rest
 851     $self->error("Outputformat not defined: $self->{'format'}");
 852   }
 853
 854   my $template = SL::Template::create(type      => $template_type,
 855                                       file_name => $self->{IN},
 856                                       form      => $self,
 857                                       myconfig  => $myconfig,
 858                                       userspath => $userspath,
 859                                       %{ $self->{TEMPLATE_DRIVER_OPTIONS} || {} });
 860
 861   # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be.
 862   $self->{"notes"} = $self->{ $self->{"formname"} . "notes" } if exists $self->{ $self->{"formname"} . "notes" };
 863
 864   if (!$self->{employee_id}) {
 865     $self->{"employee_${_}"} = $myconfig->{$_} for qw(email tel fax name signature);
 866     $self->{"employee_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
 867   }
 868
 869   $self->{"myconfig_${_}"} = $myconfig->{$_} for grep { $_ ne 'dbpasswd' } keys %{ $myconfig };
 870   $self->{$_}              = $defaults->$_   for qw(co_ustid);
 871   $self->{"myconfig_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
 872   $self->{AUTH}            = $::auth;
 873   $self->{INSTANCE_CONF}   = $::instance_conf;
 874   $self->{LOCALE}          = $::locale;
 875   $self->{LXCONFIG}        = $::lx_office_conf;
 876   $self->{LXDEBUG}         = $::lxdebug;
 877   $self->{MYCONFIG}        = \%::myconfig;
 878
 879   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 880
 881   # OUT is used for the media, screen, printer, email
 882   # for postscript we store a copy in a temporary file
 883
 884   my ($temp_fh, $suffix);
 885   $suffix =  $self->{IN};
 886   $suffix =~ s/.*\.//;
 887   ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
 888     strftime('kivitendo-print-%Y%m%d%H%M%S-XXXXXX', localtime()),
 889     SUFFIX => '.' . ($suffix || 'tex'),
 890     DIR    => $userspath,
 891     UNLINK => $keep_temp_files ? 0 : 1,
 892   );
 893   close $temp_fh;
 894   chmod 0644, $self->{tmpfile} if $keep_temp_files;
 895   (undef, undef, $self->{template_meta}{tmpfile}) = File::Spec->splitpath( $self->{tmpfile} );
 896
 897   $out              = $self->{OUT};
 898   $out_mode         = $self->{OUT_MODE} || '>';
 899   $self->{OUT}      = "$self->{tmpfile}";
 900   $self->{OUT_MODE} = '>';
 901
 902   my $result;
 903   my $command_formatter = sub {
 904     my ($out_mode, $out) = @_;
 905     return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
 906   };
 907
 908   if ($self->{OUT}) {
 909     $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
 910     open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
 911   } else {
 912     *OUT = ($::dispatcher->get_standard_filehandles)[1];
 913     $self->header;
 914   }
 915
 916   if (!$template->parse(*OUT)) {
 917     $self->cleanup();
 918     $self->error("$self->{IN} : " . $template->get_error());
 919   }
 920
 921   close OUT if $self->{OUT};
 922   # check only one flag (webdav_documents)
 923   # therefore copy to webdav, even if we do not have the webdav feature enabled (just archive)
 924   my $copy_to_webdav =  $::instance_conf->get_webdav_documents && !$self->{preview} && $self->{tmpdir} && $self->{tmpfile} && $self->{type}
 925                         && $self->{type} ne 'statement';
 926   if ( $ext_for_format eq 'pdf' && $self->doc_storage_enabled ) {
 927     $self->append_general_pdf_attachments(filepath =>  $self->{tmpdir}."/".$self->{tmpfile},
 928                                           type     =>  $self->{type});
 929   }
 930   if ($self->{media} eq 'file') {
 931     copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
 932
 933     if ($copy_to_webdav) {
 934       if (my $error = Common::copy_file_to_webdav_folder($self)) {
 935         chdir("$self->{cwd}");
 936         $self->error($error);
 937       }
 938     }
 939
 940     if (!$self->{preview} && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled)
 941     {
 942       $self->{attachment_filename} ||= $self->generate_attachment_filename;
 943       $self->store_pdf($self);
 944     }
 945     $self->cleanup;
 946     chdir("$self->{cwd}");
 947
 948     $::lxdebug->leave_sub();
 949
 950     return;
 951   }
 952
 953   if ($copy_to_webdav) {
 954     if (my $error = Common::copy_file_to_webdav_folder($self)) {
 955       chdir("$self->{cwd}");
 956       $self->error($error);
 957     }
 958   }
 959
 960   if ( !$self->{preview} && $ext_for_format eq 'pdf' && $self->{attachment_type} !~ m{^dunning} && $self->doc_storage_enabled) {
 961     $self->{attachment_filename} ||= $self->generate_attachment_filename;
 962     my $file_obj = $self->store_pdf($self);
 963     $self->{print_file_id} = $file_obj->id if $file_obj;
 964   }
 965   if ($self->{media} eq 'email') {
 966     if ( getcwd() eq $self->{"tmpdir"} ) {
 967       # in the case of generating pdf we are in the tmpdir, but WHY ???
 968       $self->{tmpfile} = $userspath."/".$self->{tmpfile};
 969       chdir("$self->{cwd}");
 970     }
 971     $self->send_email(\%::myconfig,$ext_for_format);
 972   }
 973   else {
 974     $self->{OUT}      = $out;
 975     $self->{OUT_MODE} = $out_mode;
 976     $self->output_file($template->get_mime_type,$command_formatter);
 977   }
 978   delete $self->{print_file_id};
 979
 980   $self->cleanup;
 981
 982   chdir("$self->{cwd}");
 983   $main::lxdebug->leave_sub();
 984 }
 985
 986 sub get_bcc_defaults {
 987   my ($self, $myconfig, $mybcc) = @_;
 988   if (SL::DB::Default->get->bcc_to_login) {
 989     $mybcc .= ", " if $mybcc;
 990     $mybcc .= $myconfig->{email};
 991   }
 992   my $otherbcc = SL::DB::Default->get->global_bcc;
 993   if ($otherbcc) {
 994     $mybcc .= ", " if $mybcc;
 995     $mybcc .= $otherbcc;
 996   }
 997   return $mybcc;
 998 }
 999
1000 sub send_email {
1001   $main::lxdebug->enter_sub();
1002   my ($self, $myconfig, $ext_for_format) = @_;
1003   my $mail = Mailer->new;
1004
1005   map { $mail->{$_} = $self->{$_} }
1006     qw(cc subject message format);
1007
1008   if ($self->{cc_employee}) {
1009     my ($user, $my_emp_cc);
1010     $user        = SL::DB::Manager::AuthUser->find_by(login => $self->{cc_employee});
1011     $my_emp_cc   = $user->get_config_value('email') if ref $user eq 'SL::DB::AuthUser';
1012     $mail->{cc} .= ", "       if $mail->{cc};
1013     $mail->{cc} .= $my_emp_cc if $my_emp_cc;
1014   }
1015
1016   $mail->{bcc}    = $self->get_bcc_defaults($myconfig, $self->{bcc});
1017   $mail->{to}     = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
1018   $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1019   $mail->{fileid} = time() . '.' . $$ . '.';
1020   my $full_signature     =  $self->create_email_signature();
1021   $full_signature        =~ s/\r//g;
1022
1023   $mail->{attachments} =  [];
1024   my @attfiles;
1025   # if we send html or plain text inline
1026   if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
1027     $mail->{content_type}   =  "text/html";
1028     $mail->{message}        =~ s/\r//g;
1029     $mail->{message}        =~ s{\n}{<br>\n}g;
1030     $full_signature         =~ s{\n}{<br>\n}g;
1031     $mail->{message}       .=  $full_signature;
1032
1033     open(IN, "<", $self->{tmpfile})
1034       or $self->error($self->cleanup . "$self->{tmpfile} : $!");
1035     $mail->{message} .= $_ while <IN>;
1036     close(IN);
1037
1038   } elsif (($self->{attachment_policy} // '') ne 'no_file') {
1039     my $attachment_name  =  $self->{attachment_filename}  || $self->{tmpfile};
1040     $attachment_name     =~ s{\.(.+?)$}{.${ext_for_format}} if ($ext_for_format);
1041
1042     if (($self->{attachment_policy} // '') eq 'old_file') {
1043       my ( $attfile ) = SL::File->get_all(object_id   => $self->{id},
1044                                           object_type => $self->{formname},
1045                                           file_type   => 'document');
1046
1047       if ($attfile) {
1048         $attfile->{override_file_name} = $attachment_name if $attachment_name;
1049         push @attfiles, $attfile;
1050       }
1051
1052     } else {
1053       push @{ $mail->{attachments} }, { path => $self->{tmpfile},
1054                                         id   => $self->{print_file_id},
1055                                         type => "application/pdf",
1056                                         name => $attachment_name };
1057     }
1058   }
1059
1060   push @attfiles,
1061     grep { $_ }
1062     map  { SL::File->get(id => $_) }
1063     @{ $self->{attach_file_ids} // [] };
1064
1065   foreach my $attfile ( @attfiles ) {
1066     push @{ $mail->{attachments} }, {
1067       path    => $attfile->get_file,
1068       id      => $attfile->id,
1069       type    => $attfile->mime_type,
1070       name    => $attfile->{override_file_name} // $attfile->file_name,
1071       content => $attfile->get_content ? ${ $attfile->get_content } : undef,
1072     };
1073   }
1074
1075   $mail->{message}  =~ s/\r//g;
1076   $mail->{message} .= $full_signature;
1077   $self->{emailerr} = $mail->send();
1078
1079   if ($self->{emailerr}) {
1080     $self->cleanup;
1081     $self->error($::locale->text('The email was not sent due to the following error: #1.', $self->{emailerr}));
1082   }
1083
1084   $self->{email_journal_id} = $mail->{journalentry};
1085   $self->{snumbers}  = "emailjournal" . "_" . $self->{email_journal_id};
1086   $self->{what_done} = $::form->{type};
1087   $self->{addition}  = "MAILED";
1088   $self->save_history;
1089
1090   #write back for message info and mail journal
1091   $self->{cc}  = $mail->{cc};
1092   $self->{bcc} = $mail->{bcc};
1093   $self->{email} = $mail->{to};
1094
1095   $main::lxdebug->leave_sub();
1096 }
1097
1098 sub output_file {
1099   $main::lxdebug->enter_sub();
1100
1101   my ($self,$mimeType,$command_formatter) = @_;
1102   my $numbytes = (-s $self->{tmpfile});
1103   open(IN, "<", $self->{tmpfile})
1104     or $self->error($self->cleanup . "$self->{tmpfile} : $!");
1105   binmode IN;
1106
1107   $self->{copies} = 1 unless $self->{media} eq 'printer';
1108
1109   chdir("$self->{cwd}");
1110   for my $i (1 .. $self->{copies}) {
1111     if ($self->{OUT}) {
1112       $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
1113
1114       open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
1115       print OUT $_ while <IN>;
1116       close OUT;
1117       seek  IN, 0, 0;
1118
1119     } else {
1120       my %headers = ('-type'       => $mimeType,
1121                      '-connection' => 'close',
1122                      '-charset'    => 'UTF-8');
1123
1124       $self->{attachment_filename} ||= $self->generate_attachment_filename;
1125
1126       if ($self->{attachment_filename}) {
1127         %headers = (
1128           %headers,
1129           '-attachment'     => $self->{attachment_filename},
1130           '-content-length' => $numbytes,
1131           '-charset'        => '',
1132         );
1133       }
1134
1135       print $::request->cgi->header(%headers);
1136
1137       $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
1138     }
1139   }
1140   close(IN);
1141   $main::lxdebug->leave_sub();
1142 }
1143
1144 sub get_formname_translation {
1145   $main::lxdebug->enter_sub();
1146   my ($self, $formname) = @_;
1147
1148   $formname ||= $self->{formname};
1149
1150   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1151   local $::locale = Locale->new($self->{recipient_locale});
1152
1153   my %formname_translations = (
1154     bin_list                => $main::locale->text('Bin List'),
1155     credit_note             => $main::locale->text('Credit Note'),
1156     invoice                 => $main::locale->text('Invoice'),
1157     pick_list               => $main::locale->text('Pick List'),
1158     proforma                => $main::locale->text('Proforma Invoice'),
1159     purchase_order          => $main::locale->text('Purchase Order'),
1160     request_quotation       => $main::locale->text('RFQ'),
1161     sales_order             => $main::locale->text('Confirmation'),
1162     sales_quotation         => $main::locale->text('Quotation'),
1163     storno_invoice          => $main::locale->text('Storno Invoice'),
1164     sales_delivery_order    => $main::locale->text('Delivery Order'),
1165     purchase_delivery_order => $main::locale->text('Delivery Order'),
1166     dunning                 => $main::locale->text('Dunning'),
1167     dunning1                => $main::locale->text('Payment Reminder'),
1168     dunning2                => $main::locale->text('Dunning'),
1169     dunning3                => $main::locale->text('Last Dunning'),
1170     dunning_invoice         => $main::locale->text('Dunning Invoice'),
1171     letter                  => $main::locale->text('Letter'),
1172     ic_supply               => $main::locale->text('Intra-Community supply'),
1173     statement               => $main::locale->text('Statement'),
1174   );
1175
1176   $main::lxdebug->leave_sub();
1177   return $formname_translations{$formname};
1178 }
1179
1180 sub get_cusordnumber_translation {
1181   $main::lxdebug->enter_sub();
1182   my ($self, $formname) = @_;
1183
1184   $formname ||= $self->{formname};
1185
1186   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1187   local $::locale = Locale->new($self->{recipient_locale});
1188
1189
1190   $main::lxdebug->leave_sub();
1191   return $main::locale->text('Your Order');
1192 }
1193
1194 sub get_number_prefix_for_type {
1195   $main::lxdebug->enter_sub();
1196   my ($self) = @_;
1197
1198   my $prefix =
1199       (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
1200     : ($self->{type} =~ /_quotation$/)                        ? 'quo'
1201     : ($self->{type} =~ /_delivery_order$/)                   ? 'do'
1202     : ($self->{type} =~ /letter/)                             ? 'letter'
1203     :                                                           'ord';
1204
1205   # better default like this?
1206   # : ($self->{type} =~ /(sales|purcharse)_order/           :  'ord';
1207   # :                                                           'prefix_undefined';
1208
1209   $main::lxdebug->leave_sub();
1210   return $prefix;
1211 }
1212
1213 sub get_extension_for_format {
1214   $main::lxdebug->enter_sub();
1215   my ($self)    = @_;
1216
1217   my $extension = $self->{format} =~ /pdf/i          ? ".pdf"
1218                 : $self->{format} =~ /postscript/i   ? ".ps"
1219                 : $self->{format} =~ /opendocument/i ? ".odt"
1220                 : $self->{format} =~ /excel/i        ? ".xls"
1221                 : $self->{format} =~ /html/i         ? ".html"
1222                 :                                      "";
1223
1224   $main::lxdebug->leave_sub();
1225   return $extension;
1226 }
1227
1228 sub generate_attachment_filename {
1229   $main::lxdebug->enter_sub();
1230   my ($self) = @_;
1231
1232   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1233   my $recipient_locale = Locale->new($self->{recipient_locale});
1234
1235   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
1236   my $prefix              = $self->get_number_prefix_for_type();
1237
1238   if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
1239     $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
1240
1241   } elsif ($attachment_filename && $self->{"${prefix}number"}) {
1242     $attachment_filename .=  "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
1243
1244   } elsif ($attachment_filename) {
1245     $attachment_filename .=  $self->get_extension_for_format();
1246
1247   } else {
1248     $attachment_filename = "";
1249   }
1250
1251   $attachment_filename =  $main::locale->quote_special_chars('filenames', $attachment_filename);
1252   $attachment_filename =~ s|[\s/\\]+|_|g;
1253
1254   $main::lxdebug->leave_sub();
1255   return $attachment_filename;
1256 }
1257
1258 sub generate_email_subject {
1259   $main::lxdebug->enter_sub();
1260   my ($self) = @_;
1261
1262   my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
1263   my $prefix  = $self->get_number_prefix_for_type();
1264
1265   if ($subject && $self->{"${prefix}number"}) {
1266     $subject .= " " . $self->{"${prefix}number"}
1267   }
1268
1269   if ($self->{cusordnumber}) {
1270     $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject;
1271   }
1272
1273   $main::lxdebug->leave_sub();
1274   return $subject;
1275 }
1276
1277 sub generate_email_body {
1278   $main::lxdebug->enter_sub();
1279   my ($self, %params) = @_;
1280   # simple german and english will work grammatically (most european languages as well)
1281   # Dear Mr Alan Greenspan:
1282   # Sehr geehrte Frau Meyer,
1283   # A l’attention de Mme Villeroy,
1284   # Gentile Signora Ferrari,
1285   my $body = '';
1286
1287   if ($self->{cp_id} && !$params{record_email}) {
1288     my $givenname = SL::DB::Contact->load_cached($self->{cp_id})->cp_givenname; # for qw(gender givename name);
1289     my $name      = SL::DB::Contact->load_cached($self->{cp_id})->cp_name; # for qw(gender givename name);
1290     my $gender    = SL::DB::Contact->load_cached($self->{cp_id})->cp_gender; # for qw(gender givename name);
1291     my $mf = $gender eq 'f' ? 'female' : 'male';
1292     $body  = GenericTranslations->get(translation_type => "salutation_$mf", language_id => $self->{language_id});
1293     $body .= ' ' . $givenname . ' ' . $name if $body;
1294   } else {
1295     $body  = GenericTranslations->get(translation_type => "salutation_general", language_id => $self->{language_id});
1296   }
1297
1298   return undef unless $body;
1299
1300   my $translation_type = $params{translation_type} // "preset_text_$self->{formname}";
1301   my $main_body        = GenericTranslations->get(translation_type => $translation_type,                  language_id => $self->{language_id});
1302   $main_body           = GenericTranslations->get(translation_type => $params{fallback_translation_type}, language_id => $self->{language_id}) if !$main_body && $params{fallback_translation_type};
1303   $body               .= GenericTranslations->get(translation_type => "salutation_punctuation_mark",      language_id => $self->{language_id}) . "\n\n";
1304   $body               .= $main_body;
1305
1306   $body = $main::locale->unquote_special_chars('HTML', $body);
1307
1308   $main::lxdebug->leave_sub();
1309   return $body;
1310 }
1311
1312 sub cleanup {
1313   $main::lxdebug->enter_sub();
1314
1315   my ($self, $application) = @_;
1316
1317   my $error_code = $?;
1318
1319   chdir("$self->{tmpdir}");
1320
1321   my @err = ();
1322   if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
1323     push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');
1324
1325   } elsif (-f "$self->{tmpfile}.err") {
1326     open(FH, "<:encoding(UTF-8)", "$self->{tmpfile}.err");
1327     @err = <FH>;
1328     close(FH);
1329   }
1330
1331   if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
1332     $self->{tmpfile} =~ s|.*/||g;
1333     # strip extension
1334     $self->{tmpfile} =~ s/\.\w+$//g;
1335     my $tmpfile = $self->{tmpfile};
1336     unlink(<$tmpfile.*>);
1337   }
1338
1339   chdir("$self->{cwd}");
1340
1341   $main::lxdebug->leave_sub();
1342
1343   return "@err";
1344 }
1345
1346 sub datetonum {
1347   $main::lxdebug->enter_sub();
1348
1349   my ($self, $date, $myconfig) = @_;
1350   my ($yy, $mm, $dd);
1351
1352   if ($date && $date =~ /\D/) {
1353
1354     if ($myconfig->{dateformat} =~ /^yy/) {
1355       ($yy, $mm, $dd) = split /\D/, $date;
1356     }
1357     if ($myconfig->{dateformat} =~ /^mm/) {
1358       ($mm, $dd, $yy) = split /\D/, $date;
1359     }
1360     if ($myconfig->{dateformat} =~ /^dd/) {
1361       ($dd, $mm, $yy) = split /\D/, $date;
1362     }
1363
1364     $dd *= 1;
1365     $mm *= 1;
1366     $yy = ($yy < 70) ? $yy + 2000 : $yy;
1367     $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
1368
1369     $dd = "0$dd" if ($dd < 10);
1370     $mm = "0$mm" if ($mm < 10);
1371
1372     $date = "$yy$mm$dd";
1373   }
1374
1375   $main::lxdebug->leave_sub();
1376
1377   return $date;
1378 }
1379
1380 # Database routines used throughout
1381 # DB Handling got moved to SL::DB, these are only shims for compatibility
1382
1383 sub dbconnect {
1384   SL::DB->client->dbh;
1385 }
1386
1387 sub get_standard_dbh {
1388   my $dbh = SL::DB->client->dbh;
1389
1390   if ($dbh && !$dbh->{Active}) {
1391     $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$dbh is defined but not Active anymore");
1392     SL::DB->client->dbh(undef);
1393   }
1394
1395   SL::DB->client->dbh;
1396 }
1397
1398 sub disconnect_standard_dbh {
1399   SL::DB->client->dbh->rollback;
1400 }
1401
1402 # /database
1403
1404 sub date_closed {
1405   $main::lxdebug->enter_sub();
1406
1407   my ($self, $date, $myconfig) = @_;
1408   my $dbh = $self->get_standard_dbh;
1409
1410   my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
1411   my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
1412
1413   # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
1414   # es ist sicher ein conv_date vorher IMMER auszuführen.
1415   # Testfälle ohne definiertes closedto:
1416   #   Leere Datumseingabe i.O.
1417   #     SELECT 1 FROM defaults WHERE '' < closedto
1418   #   normale Zahlungsbuchung über Rechnungsmaske i.O.
1419   #     SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
1420   # Testfälle mit definiertem closedto (30.04.2011):
1421   #  Leere Datumseingabe i.O.
1422   #   SELECT 1 FROM defaults WHERE '' < closedto
1423   # normale Buchung im geschloßenem Zeitraum i.O.
1424   #   SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
1425   #     Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
1426   # normale Buchung in aktiver Buchungsperiode i.O.
1427   #   SELECT 1 FROM defaults WHERE '01.05.2011' < closedto
1428
1429   my ($closed) = $sth->fetchrow_array;
1430
1431   $main::lxdebug->leave_sub();
1432
1433   return $closed;
1434 }
1435
1436 # prevents bookings to the to far away future
1437 sub date_max_future {
1438   $main::lxdebug->enter_sub();
1439
1440   my ($self, $date, $myconfig) = @_;
1441   my $dbh = $self->get_standard_dbh;
1442
1443   my $query = "SELECT 1 FROM defaults WHERE ? - current_date > max_future_booking_interval";
1444   my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
1445
1446   my ($max_future_booking_interval) = $sth->fetchrow_array;
1447
1448   $main::lxdebug->leave_sub();
1449
1450   return $max_future_booking_interval;
1451 }
1452
1453
1454 sub update_balance {
1455   $main::lxdebug->enter_sub();
1456
1457   my ($self, $dbh, $table, $field, $where, $value, @values) = @_;
1458
1459   # if we have a value, go do it
1460   if ($value != 0) {
1461
1462     # retrieve balance from table
1463     my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
1464     my $sth = prepare_execute_query($self, $dbh, $query, @values);
1465     my ($balance) = $sth->fetchrow_array;
1466     $sth->finish;
1467
1468     $balance += $value;
1469
1470     # update balance
1471     $query = "UPDATE $table SET $field = $balance WHERE $where";
1472     do_query($self, $dbh, $query, @values);
1473   }
1474   $main::lxdebug->leave_sub();
1475 }
1476
1477 sub update_exchangerate {
1478   $main::lxdebug->enter_sub();
1479
1480   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
1481   my ($query);
1482   # some sanity check for currency
1483   if ($curr eq '') {
1484     $main::lxdebug->leave_sub();
1485     return;
1486   }
1487   $query = qq|SELECT name AS curr FROM currencies WHERE id=(SELECT currency_id FROM defaults)|;
1488
1489   my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
1490
1491   if ($curr eq $defaultcurrency) {
1492     $main::lxdebug->leave_sub();
1493     return;
1494   }
1495
1496   $query = qq|SELECT e.currency_id FROM exchangerate e
1497                  WHERE e.currency_id = (SELECT cu.id FROM currencies cu WHERE cu.name=?) AND e.transdate = ?
1498                  FOR UPDATE|;
1499   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
1500
1501   if ($buy == 0) {
1502     $buy = "";
1503   }
1504   if ($sell == 0) {
1505     $sell = "";
1506   }
1507
1508   $buy = conv_i($buy, "NULL");
1509   $sell = conv_i($sell, "NULL");
1510
1511   my $set;
1512   if ($buy != 0 && $sell != 0) {
1513     $set = "buy = $buy, sell = $sell";
1514   } elsif ($buy != 0) {
1515     $set = "buy = $buy";
1516   } elsif ($sell != 0) {
1517     $set = "sell = $sell";
1518   }
1519
1520   if ($sth->fetchrow_array) {
1521     $query = qq|UPDATE exchangerate
1522                 SET $set
1523                 WHERE currency_id = (SELECT id FROM currencies WHERE name = ?)
1524                 AND transdate = ?|;
1525
1526   } else {
1527     $query = qq|INSERT INTO exchangerate (currency_id, buy, sell, transdate)
1528                 VALUES ((SELECT id FROM currencies WHERE name = ?), $buy, $sell, ?)|;
1529   }
1530   $sth->finish;
1531   do_query($self, $dbh, $query, $curr, $transdate);
1532
1533   $main::lxdebug->leave_sub();
1534 }
1535
1536 sub save_exchangerate {
1537   $main::lxdebug->enter_sub();
1538
1539   my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
1540
1541   SL::DB->client->with_transaction(sub {
1542     my $dbh = SL::DB->client->dbh;
1543
1544     my ($buy, $sell);
1545
1546     $buy  = $rate if $fld eq 'buy';
1547     $sell = $rate if $fld eq 'sell';
1548
1549
1550     $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
1551     1;
1552   }) or do { die SL::DB->client->error };
1553
1554   $main::lxdebug->leave_sub();
1555 }
1556
1557 sub get_exchangerate {
1558   $main::lxdebug->enter_sub();
1559
1560   my ($self, $dbh, $curr, $transdate, $fld) = @_;
1561   my ($query);
1562
1563   unless ($transdate && $curr) {
1564     $main::lxdebug->leave_sub();
1565     return 1;
1566   }
1567
1568   $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|;
1569
1570   my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
1571
1572   if ($curr eq $defaultcurrency) {
1573     $main::lxdebug->leave_sub();
1574     return 1;
1575   }
1576
1577   $query = qq|SELECT e.$fld FROM exchangerate e
1578                  WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|;
1579   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
1580
1581
1582
1583   $main::lxdebug->leave_sub();
1584
1585   return $exchangerate;
1586 }
1587
1588 sub check_exchangerate {
1589   $main::lxdebug->enter_sub();
1590
1591   my ($self, $myconfig, $currency, $transdate, $fld) = @_;
1592
1593   if ($fld !~/^buy|sell$/) {
1594     $self->error('Fatal: check_exchangerate called with invalid buy/sell argument');
1595   }
1596
1597   unless ($transdate) {
1598     $main::lxdebug->leave_sub();
1599     return "";
1600   }
1601
1602   my ($defaultcurrency) = $self->get_default_currency($myconfig);
1603
1604   if ($currency eq $defaultcurrency) {
1605     $main::lxdebug->leave_sub();
1606     return 1;
1607   }
1608
1609   my $dbh   = $self->get_standard_dbh($myconfig);
1610   my $query = qq|SELECT e.$fld FROM exchangerate e
1611                  WHERE e.currency_id = (SELECT id FROM currencies WHERE name = ?) AND e.transdate = ?|;
1612
1613   my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
1614
1615   $main::lxdebug->leave_sub();
1616
1617   return $exchangerate;
1618 }
1619
1620 sub get_all_currencies {
1621   $main::lxdebug->enter_sub();
1622
1623   my $self     = shift;
1624   my $myconfig = shift || \%::myconfig;
1625   my $dbh      = $self->get_standard_dbh($myconfig);
1626
1627   my $query = qq|SELECT name FROM currencies|;
1628   my @currencies = map { $_->{name} } selectall_hashref_query($self, $dbh, $query);
1629
1630   $main::lxdebug->leave_sub();
1631
1632   return @currencies;
1633 }
1634
1635 sub get_default_currency {
1636   $main::lxdebug->enter_sub();
1637
1638   my ($self, $myconfig) = @_;
1639   my $dbh      = $self->get_standard_dbh($myconfig);
1640   my $query = qq|SELECT name AS curr FROM currencies WHERE id = (SELECT currency_id FROM defaults)|;
1641
1642   my ($defaultcurrency) = selectrow_query($self, $dbh, $query);
1643
1644   $main::lxdebug->leave_sub();
1645
1646   return $defaultcurrency;
1647 }
1648
1649 sub set_payment_options {
1650   my ($self, $myconfig, $transdate, $type) = @_;
1651
1652   my $terms = $self->{payment_id} ? SL::DB::PaymentTerm->new(id => $self->{payment_id})->load : undef;
1653   return if !$terms;
1654
1655   my $is_invoice                = $type =~ m{invoice}i;
1656
1657   $transdate                  ||= $self->{invdate} || $self->{transdate};
1658   my $due_date                  = $self->{duedate} || $self->{reqdate};
1659
1660   $self->{$_}                   = $terms->$_ for qw(terms_netto terms_skonto percent_skonto);
1661   $self->{payment_description}  = $terms->description;
1662   $self->{netto_date}           = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'net')->to_kivitendo;
1663   $self->{skonto_date}          = $terms->calc_date(reference_date => $transdate, due_date => $due_date, terms => 'discount')->to_kivitendo;
1664
1665   my ($invtotal, $total);
1666   my (%amounts, %formatted_amounts);
1667
1668   if ($self->{type} =~ /_order$/) {
1669     $amounts{invtotal} = $self->{ordtotal};
1670     $amounts{total}    = $self->{ordtotal};
1671
1672   } elsif ($self->{type} =~ /_quotation$/) {
1673     $amounts{invtotal} = $self->{quototal};
1674     $amounts{total}    = $self->{quototal};
1675
1676   } else {
1677     $amounts{invtotal} = $self->{invtotal};
1678     $amounts{total}    = $self->{total};
1679   }
1680   map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
1681
1682   $amounts{skonto_in_percent}  = 100.0 * $self->{percent_skonto};
1683   $amounts{skonto_amount}      = $amounts{invtotal} * $self->{percent_skonto};
1684   $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
1685   $amounts{total_wo_skonto}    = $amounts{total}    * (1 - $self->{percent_skonto});
1686
1687   foreach (keys %amounts) {
1688     $amounts{$_}           = $self->round_amount($amounts{$_}, 2);
1689     $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
1690   }
1691
1692   if ($self->{"language_id"}) {
1693     my $language             = SL::DB::Language->new(id => $self->{language_id})->load;
1694
1695     $self->{payment_terms}   = $type =~ m{invoice}i ? $terms->translated_attribute('description_long_invoice', $language->id) : undef;
1696     $self->{payment_terms} ||= $terms->translated_attribute('description_long', $language->id);
1697
1698     if ($language->output_dateformat) {
1699       foreach my $key (qw(netto_date skonto_date)) {
1700         $self->{$key} = $::locale->reformat_date($myconfig, $self->{$key}, $language->output_dateformat, $language->output_longdates);
1701       }
1702     }
1703
1704     if ($language->output_numberformat && ($language->output_numberformat ne $myconfig->{numberformat})) {
1705       local $myconfig->{numberformat};
1706       $myconfig->{"numberformat"} = $language->output_numberformat;
1707       $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) for keys %amounts;
1708     }
1709   }
1710
1711   $self->{payment_terms} =  $self->{payment_terms} || ($is_invoice ? $terms->description_long_invoice : undef) || $terms->description_long;
1712
1713   $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
1714   $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
1715   $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
1716   $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
1717   $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
1718   $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
1719   $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
1720   $self->{payment_terms} =~ s/<\%bic\%>/$self->{bic}/g;
1721   $self->{payment_terms} =~ s/<\%iban\%>/$self->{iban}/g;
1722   $self->{payment_terms} =~ s/<\%mandate_date_of_signature\%>/$self->{mandate_date_of_signature}/g;
1723   $self->{payment_terms} =~ s/<\%mandator_id\%>/$self->{mandator_id}/g;
1724
1725   map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
1726
1727   $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
1728
1729 }
1730
1731 sub get_template_language {
1732   $main::lxdebug->enter_sub();
1733
1734   my ($self, $myconfig) = @_;
1735
1736   my $template_code = "";
1737
1738   if ($self->{language_id}) {
1739     my $dbh = $self->get_standard_dbh($myconfig);
1740     my $query = qq|SELECT template_code FROM language WHERE id = ?|;
1741     ($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id});
1742   }
1743
1744   $main::lxdebug->leave_sub();
1745
1746   return $template_code;
1747 }
1748
1749 sub get_printer_code {
1750   $main::lxdebug->enter_sub();
1751
1752   my ($self, $myconfig) = @_;
1753
1754   my $template_code = "";
1755
1756   if ($self->{printer_id}) {
1757     my $dbh = $self->get_standard_dbh($myconfig);
1758     my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|;
1759     ($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id});
1760   }
1761
1762   $main::lxdebug->leave_sub();
1763
1764   return $template_code;
1765 }
1766
1767 sub get_shipto {
1768   $main::lxdebug->enter_sub();
1769
1770   my ($self, $myconfig) = @_;
1771
1772   my $template_code = "";
1773
1774   if ($self->{shipto_id}) {
1775     my $dbh = $self->get_standard_dbh($myconfig);
1776     my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
1777     my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id});
1778     map({ $self->{$_} = $ref->{$_} } keys(%$ref));
1779
1780     my $cvars = CVar->get_custom_variables(
1781       dbh      => $dbh,
1782       module   => 'ShipTo',
1783       trans_id => $self->{shipto_id},
1784     );
1785     $self->{"shiptocvar_$_->{name}"} = $_->{value} for @{ $cvars };
1786   }
1787
1788   $main::lxdebug->leave_sub();
1789 }
1790
1791 sub add_shipto {
1792   my ($self, $dbh, $id, $module) = @_;
1793
1794   my $shipto;
1795   my @values;
1796
1797   foreach my $item (qw(name department_1 department_2 street zipcode city country gln
1798                        contact phone fax email)) {
1799     if ($self->{"shipto$item"}) {
1800       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
1801     }
1802     push(@values, $self->{"shipto${item}"});
1803   }
1804
1805   return if !$shipto;
1806
1807   # shiptocp_gender only makes sense, if any other shipto attribute is set.
1808   # Because shiptocp_gender is set to 'm' by default in forms
1809   # it must not be considered above to decide if shiptos has to be added or
1810   # updated, but must be inserted or updated as well in case.
1811   push(@values, $self->{shiptocp_gender});
1812
1813   my $shipto_id = $self->{shipto_id};
1814
1815   if ($self->{shipto_id}) {
1816     my $query = qq|UPDATE shipto set
1817                      shiptoname = ?,
1818                      shiptodepartment_1 = ?,
1819                      shiptodepartment_2 = ?,
1820                      shiptostreet = ?,
1821                      shiptozipcode = ?,
1822                      shiptocity = ?,
1823                      shiptocountry = ?,
1824                      shiptogln = ?,
1825                      shiptocontact = ?,
1826                      shiptophone = ?,
1827                      shiptofax = ?,
1828                      shiptoemail = ?
1829                      shiptocp_gender = ?,
1830                    WHERE shipto_id = ?|;
1831     do_query($self, $dbh, $query, @values, $self->{shipto_id});
1832   } else {
1833     my $query = qq|SELECT * FROM shipto
1834                    WHERE shiptoname = ? AND
1835                      shiptodepartment_1 = ? AND
1836                      shiptodepartment_2 = ? AND
1837                      shiptostreet = ? AND
1838                      shiptozipcode = ? AND
1839                      shiptocity = ? AND
1840                      shiptocountry = ? AND
1841                      shiptogln = ? AND
1842                      shiptocontact = ? AND
1843                      shiptophone = ? AND
1844                      shiptofax = ? AND
1845                      shiptoemail = ? AND
1846                      shiptocp_gender = ? AND
1847                      module = ? AND
1848                      trans_id = ?|;
1849     my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
1850     if(!$insert_check){
1851       my $insert_query =
1852         qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
1853                                shiptostreet, shiptozipcode, shiptocity, shiptocountry, shiptogln,
1854                                shiptocontact, shiptophone, shiptofax, shiptoemail, shiptocp_gender, module)
1855            VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
1856       do_query($self, $dbh, $insert_query, $id, @values, $module);
1857
1858       $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
1859     }
1860
1861     $shipto_id = $insert_check->{shipto_id};
1862   }
1863
1864   return unless $shipto_id;
1865
1866   CVar->save_custom_variables(
1867     dbh         => $dbh,
1868     module      => 'ShipTo',
1869     trans_id    => $shipto_id,
1870     variables   => $self,
1871     name_prefix => 'shipto',
1872   );
1873 }
1874
1875 sub get_employee {
1876   $main::lxdebug->enter_sub();
1877
1878   my ($self, $dbh) = @_;
1879
1880   $dbh ||= $self->get_standard_dbh(\%main::myconfig);
1881
1882   my $query = qq|SELECT id, name FROM employee WHERE login = ?|;
1883   ($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login});
1884   $self->{"employee_id"} *= 1;
1885
1886   $main::lxdebug->leave_sub();
1887 }
1888
1889 sub get_employee_data {
1890   $main::lxdebug->enter_sub();
1891
1892   my $self     = shift;
1893   my %params   = @_;
1894   my $defaults = SL::DB::Default->get;
1895
1896   Common::check_params(\%params, qw(prefix));
1897   Common::check_params_x(\%params, qw(id));
1898
1899   if (!$params{id}) {
1900     $main::lxdebug->leave_sub();
1901     return;
1902   }
1903
1904   my $myconfig = \%main::myconfig;
1905   my $dbh      = $params{dbh} || $self->get_standard_dbh($myconfig);
1906
1907   my ($login, $deleted)  = selectrow_query($self, $dbh, qq|SELECT login,deleted FROM employee WHERE id = ?|, conv_i($params{id}));
1908
1909   if ($login) {
1910     # login already fetched and still the same client (mandant) | same for both cases (delete|!delete)
1911     $self->{$params{prefix} . '_login'}   = $login;
1912     $self->{$params{prefix} . "_${_}"}    = $defaults->$_ for qw(address businessnumber co_ustid company duns taxnumber);
1913
1914     if (!$deleted) {
1915       # get employee data from auth.user_config
1916       my $user = User->new(login => $login);
1917       $self->{$params{prefix} . "_${_}"} = $user->{$_} for qw(email fax name signature tel);
1918     } else {
1919       # get saved employee data from employee
1920       my $employee = SL::DB::Manager::Employee->find_by(id => conv_i($params{id}));
1921       $self->{$params{prefix} . "_${_}"} = $employee->{"deleted_$_"} for qw(email fax signature tel);
1922       $self->{$params{prefix} . "_name"} = $employee->name;
1923     }
1924  }
1925   $main::lxdebug->leave_sub();
1926 }
1927
1928 sub _get_contacts {
1929   $main::lxdebug->enter_sub();
1930
1931   my ($self, $dbh, $id, $key) = @_;
1932
1933   $key = "all_contacts" unless ($key);
1934
1935   if (!$id) {
1936     $self->{$key} = [];
1937     $main::lxdebug->leave_sub();
1938     return;
1939   }
1940
1941   my $query =
1942     qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
1943     qq|FROM contacts | .
1944     qq|WHERE cp_cv_id = ? | .
1945     qq|ORDER BY lower(cp_name)|;
1946
1947   $self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);
1948
1949   $main::lxdebug->leave_sub();
1950 }
1951
1952 sub _get_projects {
1953   $main::lxdebug->enter_sub();
1954
1955   my ($self, $dbh, $key) = @_;
1956
1957   my ($all, $old_id, $where, @values);
1958
1959   if (ref($key) eq "HASH") {
1960     my $params = $key;
1961
1962     $key = "ALL_PROJECTS";
1963
1964     foreach my $p (keys(%{$params})) {
1965       if ($p eq "all") {
1966         $all = $params->{$p};
1967       } elsif ($p eq "old_id") {
1968         $old_id = $params->{$p};
1969       } elsif ($p eq "key") {
1970         $key = $params->{$p};
1971       }
1972     }
1973   }
1974
1975   if (!$all) {
1976     $where = "WHERE active ";
1977     if ($old_id) {
1978       if (ref($old_id) eq "ARRAY") {
1979         my @ids = grep({ $_ } @{$old_id});
1980         if (@ids) {
1981           $where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
1982           push(@values, @ids);
1983         }
1984       } else {
1985         $where .= " OR (id = ?) ";
1986         push(@values, $old_id);
1987       }
1988     }
1989   }
1990
1991   my $query =
1992     qq|SELECT id, projectnumber, description, active | .
1993     qq|FROM project | .
1994     $where .
1995     qq|ORDER BY lower(projectnumber)|;
1996
1997   $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
1998
1999   $main::lxdebug->leave_sub();
2000 }
2001
2002 sub _get_printers {
2003   $main::lxdebug->enter_sub();
2004
2005   my ($self, $dbh, $key) = @_;
2006
2007   $key = "all_printers" unless ($key);
2008
2009   my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;
2010
2011   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2012
2013   $main::lxdebug->leave_sub();
2014 }
2015
2016 sub _get_charts {
2017   $main::lxdebug->enter_sub();
2018
2019   my ($self, $dbh, $params) = @_;
2020   my ($key);
2021
2022   $key = $params->{key};
2023   $key = "all_charts" unless ($key);
2024
2025   my $transdate = quote_db_date($params->{transdate});
2026
2027   my $query =
2028     qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
2029     qq|FROM chart c | .
2030     qq|LEFT JOIN taxkeys tk ON | .
2031     qq|(tk.id = (SELECT id FROM taxkeys | .
2032     qq|          WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
2033     qq|          ORDER BY startdate DESC LIMIT 1)) | .
2034     qq|ORDER BY c.accno|;
2035
2036   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2037
2038   $main::lxdebug->leave_sub();
2039 }
2040
2041 sub _get_taxzones {
2042   $main::lxdebug->enter_sub();
2043
2044   my ($self, $dbh, $key) = @_;
2045
2046   $key = "all_taxzones" unless ($key);
2047   my $tzfilter = "";
2048   $tzfilter = "WHERE obsolete is FALSE" if $key eq 'ALL_ACTIVE_TAXZONES';
2049
2050   my $query = qq|SELECT * FROM tax_zones $tzfilter ORDER BY sortkey|;
2051
2052   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2053
2054   $main::lxdebug->leave_sub();
2055 }
2056
2057 sub _get_employees {
2058   $main::lxdebug->enter_sub();
2059
2060   my ($self, $dbh, $params) = @_;
2061
2062   my $deleted = 0;
2063
2064   my $key;
2065   if (ref $params eq 'HASH') {
2066     $key     = $params->{key};
2067     $deleted = $params->{deleted};
2068
2069   } else {
2070     $key = $params;
2071   }
2072
2073   $key     ||= "all_employees";
2074   my $filter = $deleted ? '' : 'WHERE NOT COALESCE(deleted, FALSE)';
2075   $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee $filter ORDER BY lower(name)|);
2076
2077   $main::lxdebug->leave_sub();
2078 }
2079
2080 sub _get_business_types {
2081   $main::lxdebug->enter_sub();
2082
2083   my ($self, $dbh, $key) = @_;
2084
2085   my $options       = ref $key eq 'HASH' ? $key : { key => $key };
2086   $options->{key} ||= "all_business_types";
2087   my $where         = '';
2088
2089   if (exists $options->{salesman}) {
2090     $where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
2091   }
2092
2093   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
2094
2095   $main::lxdebug->leave_sub();
2096 }
2097
2098 sub _get_languages {
2099   $main::lxdebug->enter_sub();
2100
2101   my ($self, $dbh, $key) = @_;
2102
2103   $key = "all_languages" unless ($key);
2104
2105   my $query = qq|SELECT * FROM language ORDER BY id|;
2106
2107   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2108
2109   $main::lxdebug->leave_sub();
2110 }
2111
2112 sub _get_dunning_configs {
2113   $main::lxdebug->enter_sub();
2114
2115   my ($self, $dbh, $key) = @_;
2116
2117   $key = "all_dunning_configs" unless ($key);
2118
2119   my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;
2120
2121   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2122
2123   $main::lxdebug->leave_sub();
2124 }
2125
2126 sub _get_currencies {
2127 $main::lxdebug->enter_sub();
2128
2129   my ($self, $dbh, $key) = @_;
2130
2131   $key = "all_currencies" unless ($key);
2132
2133   $self->{$key} = [$self->get_all_currencies()];
2134
2135   $main::lxdebug->leave_sub();
2136 }
2137
2138 sub _get_payments {
2139 $main::lxdebug->enter_sub();
2140
2141   my ($self, $dbh, $key) = @_;
2142
2143   $key = "all_payments" unless ($key);
2144
2145   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
2146
2147   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2148
2149   $main::lxdebug->leave_sub();
2150 }
2151
2152 sub _get_customers {
2153   $main::lxdebug->enter_sub();
2154
2155   my ($self, $dbh, $key) = @_;
2156
2157   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
2158   $options->{key}  ||= "all_customers";
2159   my $limit_clause   = $options->{limit} ? "LIMIT $options->{limit}" : '';
2160
2161   my @where;
2162   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
2163   push @where, qq|NOT obsolete|                                            if !$options->{with_obsolete};
2164   my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';
2165
2166   my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
2167   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
2168
2169   $main::lxdebug->leave_sub();
2170 }
2171
2172 sub _get_vendors {
2173   $main::lxdebug->enter_sub();
2174
2175   my ($self, $dbh, $key) = @_;
2176
2177   $key = "all_vendors" unless ($key);
2178
2179   my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;
2180
2181   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2182
2183   $main::lxdebug->leave_sub();
2184 }
2185
2186 sub _get_departments {
2187   $main::lxdebug->enter_sub();
2188
2189   my ($self, $dbh, $key) = @_;
2190
2191   $key = "all_departments" unless ($key);
2192
2193   my $query = qq|SELECT * FROM department ORDER BY description|;
2194
2195   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2196
2197   $main::lxdebug->leave_sub();
2198 }
2199
2200 sub _get_warehouses {
2201   $main::lxdebug->enter_sub();
2202
2203   my ($self, $dbh, $param) = @_;
2204
2205   my ($key, $bins_key);
2206
2207   if ('' eq ref $param) {
2208     $key = $param;
2209
2210   } else {
2211     $key      = $param->{key};
2212     $bins_key = $param->{bins};
2213   }
2214
2215   my $query = qq|SELECT w.* FROM warehouse w
2216                  WHERE (NOT w.invalid) AND
2217                    ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
2218                  ORDER BY w.sortkey|;
2219
2220   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2221
2222   if ($bins_key) {
2223     $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
2224                 ORDER BY description|;
2225     my $sth = prepare_query($self, $dbh, $query);
2226
2227     foreach my $warehouse (@{ $self->{$key} }) {
2228       do_statement($self, $sth, $query, $warehouse->{id});
2229       $warehouse->{$bins_key} = [];
2230
2231       while (my $ref = $sth->fetchrow_hashref()) {
2232         push @{ $warehouse->{$bins_key} }, $ref;
2233       }
2234     }
2235     $sth->finish();
2236   }
2237
2238   $main::lxdebug->leave_sub();
2239 }
2240
2241 sub _get_simple {
2242   $main::lxdebug->enter_sub();
2243
2244   my ($self, $dbh, $table, $key, $sortkey) = @_;
2245
2246   my $query  = qq|SELECT * FROM $table|;
2247   $query    .= qq| ORDER BY $sortkey| if ($sortkey);
2248
2249   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2250
2251   $main::lxdebug->leave_sub();
2252 }
2253
2254 sub get_lists {
2255   $main::lxdebug->enter_sub();
2256
2257   my $self = shift;
2258   my %params = @_;
2259
2260   croak "get_lists: shipto is no longer supported" if $params{shipto};
2261
2262   my $dbh = $self->get_standard_dbh(\%main::myconfig);
2263   my ($sth, $query, $ref);
2264
2265   my ($vc, $vc_id);
2266   if ($params{contacts}) {
2267     $vc = 'customer' if $self->{"vc"} eq "customer";
2268     $vc = 'vendor'   if $self->{"vc"} eq "vendor";
2269     die "invalid use of get_lists, need 'vc'" unless $vc;
2270     $vc_id = $self->{"${vc}_id"};
2271   }
2272
2273   if ($params{"contacts"}) {
2274     $self->_get_contacts($dbh, $vc_id, $params{"contacts"});
2275   }
2276
2277   if ($params{"projects"} || $params{"all_projects"}) {
2278     $self->_get_projects($dbh, $params{"all_projects"} ?
2279                          $params{"all_projects"} : $params{"projects"},
2280                          $params{"all_projects"} ? 1 : 0);
2281   }
2282
2283   if ($params{"printers"}) {
2284     $self->_get_printers($dbh, $params{"printers"});
2285   }
2286
2287   if ($params{"languages"}) {
2288     $self->_get_languages($dbh, $params{"languages"});
2289   }
2290
2291   if ($params{"charts"}) {
2292     $self->_get_charts($dbh, $params{"charts"});
2293   }
2294
2295   if ($params{"taxzones"}) {
2296     $self->_get_taxzones($dbh, $params{"taxzones"});
2297   }
2298
2299   if ($params{"employees"}) {
2300     $self->_get_employees($dbh, $params{"employees"});
2301   }
2302
2303   if ($params{"salesmen"}) {
2304     $self->_get_employees($dbh, $params{"salesmen"});
2305   }
2306
2307   if ($params{"business_types"}) {
2308     $self->_get_business_types($dbh, $params{"business_types"});
2309   }
2310
2311   if ($params{"dunning_configs"}) {
2312     $self->_get_dunning_configs($dbh, $params{"dunning_configs"});
2313   }
2314
2315   if($params{"currencies"}) {
2316     $self->_get_currencies($dbh, $params{"currencies"});
2317   }
2318
2319   if($params{"customers"}) {
2320     $self->_get_customers($dbh, $params{"customers"});
2321   }
2322
2323   if($params{"vendors"}) {
2324     if (ref $params{"vendors"} eq 'HASH') {
2325       $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
2326     } else {
2327       $self->_get_vendors($dbh, $params{"vendors"});
2328     }
2329   }
2330
2331   if($params{"payments"}) {
2332     $self->_get_payments($dbh, $params{"payments"});
2333   }
2334
2335   if($params{"departments"}) {
2336     $self->_get_departments($dbh, $params{"departments"});
2337   }
2338
2339   if ($params{price_factors}) {
2340     $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
2341   }
2342
2343   if ($params{warehouses}) {
2344     $self->_get_warehouses($dbh, $params{warehouses});
2345   }
2346
2347   if ($params{partsgroup}) {
2348     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
2349   }
2350
2351   $main::lxdebug->leave_sub();
2352 }
2353
2354 # this sub gets the id and name from $table
2355 sub get_name {
2356   $main::lxdebug->enter_sub();
2357
2358   my ($self, $myconfig, $table) = @_;
2359
2360   # connect to database
2361   my $dbh = $self->get_standard_dbh($myconfig);
2362
2363   $table = $table eq "customer" ? "customer" : "vendor";
2364   my $arap = $self->{arap} eq "ar" ? "ar" : "ap";
2365
2366   my ($query, @values);
2367
2368   if (!$self->{openinvoices}) {
2369     my $where;
2370     if ($self->{customernumber} ne "") {
2371       $where = qq|(vc.customernumber ILIKE ?)|;
2372       push(@values, like($self->{customernumber}));
2373     } else {
2374       $where = qq|(vc.name ILIKE ?)|;
2375       push(@values, like($self->{$table}));
2376     }
2377
2378     $query =
2379       qq~SELECT vc.id, vc.name,
2380            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2381          FROM $table vc
2382          WHERE $where AND (NOT vc.obsolete)
2383          ORDER BY vc.name~;
2384   } else {
2385     $query =
2386       qq~SELECT DISTINCT vc.id, vc.name,
2387            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2388          FROM $arap a
2389          JOIN $table vc ON (a.${table}_id = vc.id)
2390          WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
2391          ORDER BY vc.name~;
2392     push(@values, like($self->{$table}));
2393   }
2394
2395   $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
2396
2397   $main::lxdebug->leave_sub();
2398
2399   return scalar(@{ $self->{name_list} });
2400 }
2401
2402 sub new_lastmtime {
2403
2404   my ($self, $table, $provided_dbh) = @_;
2405
2406   my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh;
2407   return                                       unless $self->{id};
2408   croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;
2409
2410   my $query       = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
2411   my $ref         = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
2412   $ref->{mtime} ||= $ref->{itime};
2413   $self->{lastmtime} = $ref->{mtime};
2414
2415 }
2416
2417 sub mtime_ischanged {
2418   my ($self, $table, $option) = @_;
2419
2420   return                                       unless $self->{id};
2421   croak ("wrong call, no valid table defined") unless $table =~ /^(oe|ar|ap|delivery_orders|parts)$/;
2422
2423   my $query       = "SELECT mtime, itime FROM " . $table . " WHERE id = ?";
2424   my $ref         = selectfirst_hashref_query($self, $self->get_standard_dbh, $query, $self->{id});
2425   $ref->{mtime} ||= $ref->{itime};
2426
2427   if ($self->{lastmtime} && $self->{lastmtime} ne $ref->{mtime} ) {
2428       $self->error(($option eq 'mail') ?
2429         t8("The document has been changed by another user. No mail was sent. Please reopen it in another window and copy the changes to the new window") :
2430         t8("The document has been changed by another user. Please reopen it in another window and copy the changes to the new window")
2431       );
2432     $::dispatcher->end_request;
2433   }
2434 }
2435
2436 # language_payment duplicates some of the functionality of all_vc (language,
2437 # printer, payment_terms), and at least in the case of sales invoices both
2438 # all_vc and language_payment are called when adding new invoices
2439 sub language_payment {
2440   $main::lxdebug->enter_sub();
2441
2442   my ($self, $myconfig) = @_;
2443
2444   my $dbh = $self->get_standard_dbh($myconfig);
2445   # get languages
2446   my $query = qq|SELECT id, description
2447                  FROM language
2448                  ORDER BY id|;
2449
2450   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2451
2452   # get printer
2453   $query = qq|SELECT printer_description, id
2454               FROM printers
2455               ORDER BY printer_description|;
2456
2457   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2458
2459   # get payment terms
2460   $query = qq|SELECT id, description
2461               FROM payment_terms
2462               WHERE ( obsolete IS FALSE OR id = ? )
2463               ORDER BY sortkey |;
2464   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query, $self->{payment_id} || undef);
2465
2466   # get buchungsgruppen
2467   $query = qq|SELECT id, description
2468               FROM buchungsgruppen|;
2469
2470   $self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);
2471
2472   $main::lxdebug->leave_sub();
2473 }
2474
2475 # this is only used for reports
2476 sub all_departments {
2477   $main::lxdebug->enter_sub();
2478
2479   my ($self, $myconfig, $table) = @_;
2480
2481   my $dbh = $self->get_standard_dbh($myconfig);
2482
2483   my $query = qq|SELECT id, description
2484                  FROM department
2485                  ORDER BY description|;
2486   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2487
2488   delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });
2489
2490   $main::lxdebug->leave_sub();
2491 }
2492
2493 sub create_links {
2494   $main::lxdebug->enter_sub();
2495
2496   my ($self, $module, $myconfig, $table, $provided_dbh) = @_;
2497
2498   my ($fld, $arap);
2499   if ($table eq "customer") {
2500     $fld = "buy";
2501     $arap = "ar";
2502   } else {
2503     $table = "vendor";
2504     $fld = "sell";
2505     $arap = "ap";
2506   }
2507
2508   # get last customers or vendors
2509   my ($query, $sth, $ref);
2510
2511   my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
2512   my %xkeyref = ();
2513
2514   if (!$self->{id}) {
2515
2516     my $transdate = "current_date";
2517     if ($self->{transdate}) {
2518       $transdate = $dbh->quote($self->{transdate});
2519     }
2520
2521     # now get the account numbers
2522     $query = qq|
2523       SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk2.tax_id
2524         FROM chart c
2525         -- find newest entries in taxkeys
2526         INNER JOIN (
2527           SELECT chart_id, MAX(startdate) AS startdate
2528           FROM taxkeys
2529           WHERE (startdate <= $transdate)
2530           GROUP BY chart_id
2531         ) tk ON (c.id = tk.chart_id)
2532         -- and load all of those entries
2533         INNER JOIN taxkeys tk2
2534            ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
2535        WHERE (c.link LIKE ?)
2536       ORDER BY c.accno|;
2537
2538     $sth = $dbh->prepare($query);
2539
2540     do_statement($self, $sth, $query, like($module));
2541
2542     $self->{accounts} = "";
2543     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2544
2545       foreach my $key (split(/:/, $ref->{link})) {
2546         if ($key =~ /\Q$module\E/) {
2547
2548           # cross reference for keys
2549           $xkeyref{ $ref->{accno} } = $key;
2550
2551           push @{ $self->{"${module}_links"}{$key} },
2552             { accno       => $ref->{accno},
2553               chart_id    => $ref->{chart_id},
2554               description => $ref->{description},
2555               taxkey      => $ref->{taxkey_id},
2556               tax_id      => $ref->{tax_id} };
2557
2558           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2559         }
2560       }
2561     }
2562   }
2563
2564   # get taxkeys and description
2565   $query = qq|SELECT id, taxkey, taxdescription FROM tax|;
2566   $self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);
2567
2568   if (($module eq "AP") || ($module eq "AR")) {
2569     # get tax rates and description
2570     $query = qq|SELECT * FROM tax|;
2571     $self->{TAX} = selectall_hashref_query($self, $dbh, $query);
2572   }
2573
2574   my $extra_columns = '';
2575   $extra_columns   .= 'a.direct_debit, ' if ($module eq 'AR') || ($module eq 'AP');
2576
2577   if ($self->{id}) {
2578     $query =
2579       qq|SELECT
2580            a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid, a.deliverydate,
2581            a.duedate, a.tax_point, a.ordnumber, a.taxincluded, (SELECT cu.name FROM currencies cu WHERE cu.id=a.currency_id) AS currency, a.notes,
2582            a.mtime, a.itime,
2583            a.intnotes, a.department_id, a.amount AS oldinvtotal,
2584            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
2585            a.globalproject_id, ${extra_columns}
2586            c.name AS $table,
2587            d.description AS department,
2588            e.name AS employee
2589          FROM $arap a
2590          JOIN $table c ON (a.${table}_id = c.id)
2591          LEFT JOIN employee e ON (e.id = a.employee_id)
2592          LEFT JOIN department d ON (d.id = a.department_id)
2593          WHERE a.id = ?|;
2594     $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
2595
2596     foreach my $key (keys %$ref) {
2597       $self->{$key} = $ref->{$key};
2598     }
2599     $self->{mtime}   ||= $self->{itime};
2600     $self->{lastmtime} = $self->{mtime};
2601     my $transdate = "current_date";
2602     if ($self->{transdate}) {
2603       $transdate = $dbh->quote($self->{transdate});
2604     }
2605
2606     # now get the account numbers
2607     $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, c.id AS chart_id, tk.tax_id
2608                 FROM chart c
2609                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
2610                 WHERE c.link LIKE ?
2611                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
2612                     OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
2613                 ORDER BY c.accno|;
2614
2615     $sth = $dbh->prepare($query);
2616     do_statement($self, $sth, $query, like($module));
2617
2618     $self->{accounts} = "";
2619     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2620
2621       foreach my $key (split(/:/, $ref->{link})) {
2622         if ($key =~ /\Q$module\E/) {
2623
2624           # cross reference for keys
2625           $xkeyref{ $ref->{accno} } = $key;
2626
2627           push @{ $self->{"${module}_links"}{$key} },
2628             { accno       => $ref->{accno},
2629               chart_id    => $ref->{chart_id},
2630               description => $ref->{description},
2631               taxkey      => $ref->{taxkey_id},
2632               tax_id      => $ref->{tax_id} };
2633
2634           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2635         }
2636       }
2637     }
2638
2639
2640     # get amounts from individual entries
2641     $query =
2642       qq|SELECT
2643            c.accno, c.description,
2644            a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey, a.chart_id,
2645            p.projectnumber,
2646            t.rate, t.id
2647          FROM acc_trans a
2648          LEFT JOIN chart c ON (c.id = a.chart_id)
2649          LEFT JOIN project p ON (p.id = a.project_id)
2650          LEFT JOIN tax t ON (t.id= a.tax_id)
2651          WHERE a.trans_id = ?
2652          AND a.fx_transaction = '0'
2653          ORDER BY a.acc_trans_id, a.transdate|;
2654     $sth = $dbh->prepare($query);
2655     do_statement($self, $sth, $query, $self->{id});
2656
2657     # get exchangerate for currency
2658     $self->{exchangerate} =
2659       $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2660     my $index = 0;
2661
2662     # store amounts in {acc_trans}{$key} for multiple accounts
2663     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
2664       $ref->{exchangerate} =
2665         $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
2666       if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
2667         $index++;
2668       }
2669       if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
2670         $ref->{amount} *= -1;
2671       }
2672       $ref->{index} = $index;
2673
2674       push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
2675     }
2676
2677     $sth->finish;
2678     #check das:
2679     $query =
2680       qq|SELECT
2681            d.closedto, d.revtrans,
2682            (SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
2683            (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2684            (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno,
2685            (SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno,
2686            (SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno
2687          FROM defaults d|;
2688     $ref = selectfirst_hashref_query($self, $dbh, $query);
2689     map { $self->{$_} = $ref->{$_} } keys %$ref;
2690
2691   } else {
2692
2693     # get date
2694     $query =
2695        qq|SELECT
2696             current_date AS transdate, d.closedto, d.revtrans,
2697             (SELECT cu.name FROM currencies cu WHERE cu.id=d.currency_id) AS defaultcurrency,
2698             (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2699             (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno,
2700             (SELECT c.accno FROM chart c WHERE d.rndgain_accno_id = c.id) AS rndgain_accno,
2701             (SELECT c.accno FROM chart c WHERE d.rndloss_accno_id = c.id) AS rndloss_accno
2702           FROM defaults d|;
2703     $ref = selectfirst_hashref_query($self, $dbh, $query);
2704     map { $self->{$_} = $ref->{$_} } keys %$ref;
2705
2706     if ($self->{"$self->{vc}_id"}) {
2707
2708       # only setup currency
2709       ($self->{currency}) = $self->{defaultcurrency} if !$self->{currency};
2710
2711     } else {
2712
2713       $self->lastname_used($dbh, $myconfig, $table, $module);
2714
2715       # get exchangerate for currency
2716       $self->{exchangerate} =
2717         $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2718
2719     }
2720
2721   }
2722
2723   $main::lxdebug->leave_sub();
2724 }
2725
2726 sub lastname_used {
2727   $main::lxdebug->enter_sub();
2728
2729   my ($self, $dbh, $myconfig, $table, $module) = @_;
2730
2731   my ($arap, $where);
2732
2733   $table         = $table eq "customer" ? "customer" : "vendor";
2734   my %column_map = ("a.${table}_id"           => "${table}_id",
2735                     "a.department_id"         => "department_id",
2736                     "d.description"           => "department",
2737                     "ct.name"                 => $table,
2738                     "cu.name"                 => "currency",
2739     );
2740
2741   if ($self->{type} =~ /delivery_order/) {
2742     $arap  = 'delivery_orders';
2743     delete $column_map{"cu.currency"};
2744
2745   } elsif ($self->{type} =~ /_order/) {
2746     $arap  = 'oe';
2747     $where = "quotation = '0'";
2748
2749   } elsif ($self->{type} =~ /_quotation/) {
2750     $arap  = 'oe';
2751     $where = "quotation = '1'";
2752
2753   } elsif ($table eq 'customer') {
2754     $arap  = 'ar';
2755
2756   } else {
2757     $arap  = 'ap';
2758
2759   }
2760
2761   $where           = "($where) AND" if ($where);
2762   my $query        = qq|SELECT MAX(id) FROM $arap
2763                         WHERE $where ${table}_id > 0|;
2764   my ($trans_id)   = selectrow_query($self, $dbh, $query);
2765   $trans_id       *= 1;
2766
2767   my $column_spec  = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
2768   $query           = qq|SELECT $column_spec
2769                         FROM $arap a
2770                         LEFT JOIN $table     ct ON (a.${table}_id = ct.id)
2771                         LEFT JOIN department d  ON (a.department_id = d.id)
2772                         LEFT JOIN currencies cu ON (cu.id=ct.currency_id)
2773                         WHERE a.id = ?|;
2774   my $ref          = selectfirst_hashref_query($self, $dbh, $query, $trans_id);
2775
2776   map { $self->{$_} = $ref->{$_} } values %column_map;
2777
2778   $main::lxdebug->leave_sub();
2779 }
2780
2781 sub get_variable_content_types {
2782   my %html_variables  = (
2783       longdescription => 'html',
2784       partnotes       => 'html',
2785       notes           => 'html',
2786       orignotes       => 'html',
2787       notes1          => 'html',
2788       notes2          => 'html',
2789       notes3          => 'html',
2790       notes4          => 'html',
2791       header_text     => 'html',
2792       footer_text     => 'html',
2793   );
2794   return \%html_variables;
2795 }
2796
2797 sub current_date {
2798   $main::lxdebug->enter_sub();
2799
2800   my $self     = shift;
2801   my $myconfig = shift || \%::myconfig;
2802   my ($thisdate, $days) = @_;
2803
2804   my $dbh = $self->get_standard_dbh($myconfig);
2805   my $query;
2806
2807   $days *= 1;
2808   if ($thisdate) {
2809     my $dateformat = $myconfig->{dateformat};
2810     $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
2811     $thisdate = $dbh->quote($thisdate);
2812     $query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
2813   } else {
2814     $query = qq|SELECT current_date AS thisdate|;
2815   }
2816
2817   ($thisdate) = selectrow_query($self, $dbh, $query);
2818
2819   $main::lxdebug->leave_sub();
2820
2821   return $thisdate;
2822 }
2823
2824 sub redo_rows {
2825   $main::lxdebug->enter_sub();
2826
2827   my ($self, $flds, $new, $count, $numrows) = @_;
2828
2829   my @ndx = ();
2830
2831   map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
2832
2833   my $i = 0;
2834
2835   # fill rows
2836   foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
2837     $i++;
2838     my $j = $item->{ndx} - 1;
2839     map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
2840   }
2841
2842   # delete empty rows
2843   for $i ($count + 1 .. $numrows) {
2844     map { delete $self->{"${_}_$i"} } @{$flds};
2845   }
2846
2847   $main::lxdebug->leave_sub();
2848 }
2849
2850 sub update_status {
2851   $main::lxdebug->enter_sub();
2852
2853   my ($self, $myconfig) = @_;
2854
2855   my ($i, $id);
2856
2857   SL::DB->client->with_transaction(sub {
2858     my $dbh = SL::DB->client->dbh;
2859
2860     my $query = qq|DELETE FROM status
2861                    WHERE (formname = ?) AND (trans_id = ?)|;
2862     my $sth = prepare_query($self, $dbh, $query);
2863
2864     if ($self->{formname} =~ /(check|receipt)/) {
2865       for $i (1 .. $self->{rowcount}) {
2866         do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
2867       }
2868     } else {
2869       do_statement($self, $sth, $query, $self->{formname}, $self->{id});
2870     }
2871     $sth->finish();
2872
2873     my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
2874     my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
2875
2876     my %queued = split / /, $self->{queued};
2877     my @values;
2878
2879     if ($self->{formname} =~ /(check|receipt)/) {
2880
2881       # this is a check or receipt, add one entry for each lineitem
2882       my ($accno) = split /--/, $self->{account};
2883       $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
2884                   VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
2885       @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
2886       $sth = prepare_query($self, $dbh, $query);
2887
2888       for $i (1 .. $self->{rowcount}) {
2889         if ($self->{"checked_$i"}) {
2890           do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
2891         }
2892       }
2893       $sth->finish();
2894
2895     } else {
2896       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
2897                   VALUES (?, ?, ?, ?, ?)|;
2898       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
2899                $queued{$self->{formname}}, $self->{formname});
2900     }
2901     1;
2902   }) or do { die SL::DB->client->error };
2903
2904   $main::lxdebug->leave_sub();
2905 }
2906
2907 sub save_status {
2908   $main::lxdebug->enter_sub();
2909
2910   my ($self, $dbh) = @_;
2911
2912   my ($query, $printed, $emailed);
2913
2914   my $formnames  = $self->{printed};
2915   my $emailforms = $self->{emailed};
2916
2917   $query = qq|DELETE FROM status
2918                  WHERE (formname = ?) AND (trans_id = ?)|;
2919   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
2920
2921   # this only applies to the forms
2922   # checks and receipts are posted when printed or queued
2923
2924   if ($self->{queued}) {
2925     my %queued = split / /, $self->{queued};
2926
2927     foreach my $formname (keys %queued) {
2928       $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
2929       $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
2930
2931       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
2932                   VALUES (?, ?, ?, ?, ?)|;
2933       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
2934
2935       $formnames  =~ s/\Q$self->{formname}\E//;
2936       $emailforms =~ s/\Q$self->{formname}\E//;
2937
2938     }
2939   }
2940
2941   # save printed, emailed info
2942   $formnames  =~ s/^ +//g;
2943   $emailforms =~ s/^ +//g;
2944
2945   my %status = ();
2946   map { $status{$_}{printed} = 1 } split / +/, $formnames;
2947   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
2948
2949   foreach my $formname (keys %status) {
2950     $printed = ($formnames  =~ /\Q$self->{formname}\E/) ? "1" : "0";
2951     $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
2952
2953     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
2954                 VALUES (?, ?, ?, ?)|;
2955     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
2956   }
2957
2958   $main::lxdebug->leave_sub();
2959 }
2960
2961 #--- 4 locale ---#
2962 # $main::locale->text('SAVED')
2963 # $main::locale->text('SCREENED')
2964 # $main::locale->text('DELETED')
2965 # $main::locale->text('ADDED')
2966 # $main::locale->text('PAYMENT POSTED')
2967 # $main::locale->text('POSTED')
2968 # $main::locale->text('POSTED AS NEW')
2969 # $main::locale->text('ELSE')
2970 # $main::locale->text('SAVED FOR DUNNING')
2971 # $main::locale->text('DUNNING STARTED')
2972 # $main::locale->text('PREVIEWED')
2973 # $main::locale->text('PRINTED')
2974 # $main::locale->text('MAILED')
2975 # $main::locale->text('SCREENED')
2976 # $main::locale->text('CANCELED')
2977 # $main::locale->text('IMPORT')
2978 # $main::locale->text('UNDO TRANSFER')
2979 # $main::locale->text('UNIMPORT')
2980 # $main::locale->text('invoice')
2981 # $main::locale->text('proforma')
2982 # $main::locale->text('sales_order')
2983 # $main::locale->text('pick_list')
2984 # $main::locale->text('purchase_order')
2985 # $main::locale->text('bin_list')
2986 # $main::locale->text('sales_quotation')
2987 # $main::locale->text('request_quotation')
2988
2989 sub save_history {
2990   $main::lxdebug->enter_sub();
2991
2992   my $self = shift;
2993   my $dbh  = shift || SL::DB->client->dbh;
2994   SL::DB->client->with_transaction(sub {
2995
2996     if(!exists $self->{employee_id}) {
2997       &get_employee($self, $dbh);
2998     }
2999
3000     my $query =
3001      qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
3002      qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
3003     my @values = (conv_i($self->{id}), $self->{login},
3004                   $self->{addition}, $self->{what_done}, "$self->{snumbers}");
3005     do_query($self, $dbh, $query, @values);
3006     1;
3007   }) or do { die SL::DB->client->error };
3008
3009   $main::lxdebug->leave_sub();
3010 }
3011
3012 sub get_history {
3013   $main::lxdebug->enter_sub();
3014
3015   my ($self, $dbh, $trans_id, $restriction, $order) = @_;
3016   my ($orderBy, $desc) = split(/\-\-/, $order);
3017   $order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
3018   my @tempArray;
3019   my $i = 0;
3020   if ($trans_id ne "") {
3021     my $query =
3022       qq|SELECT h.employee_id, h.itime::timestamp(0) AS itime, h.addition, h.what_done, emp.name, h.snumbers, h.trans_id AS id | .
3023       qq|FROM history_erp h | .
3024       qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
3025       qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | .
3026       $order;
3027
3028     my $sth = $dbh->prepare($query) || $self->dberror($query);
3029
3030     $sth->execute() || $self->dberror("$query");
3031
3032     while(my $hash_ref = $sth->fetchrow_hashref()) {
3033       $hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
3034       $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
3035       my ( $what, $number ) = split /_/, $hash_ref->{snumbers};
3036       $hash_ref->{snumbers} = $number;
3037       $hash_ref->{haslink}  = 'controller.pl?action=EmailJournal/show&id='.$number if $what eq 'emailjournal';
3038       $hash_ref->{snumbers} = $main::locale->text("E-Mail").' '.$number if $what eq 'emailjournal';
3039       $tempArray[$i++] = $hash_ref;
3040     }
3041     $main::lxdebug->leave_sub() and return \@tempArray
3042       if ($i > 0 && $tempArray[0] ne "");
3043   }
3044   $main::lxdebug->leave_sub();
3045   return 0;
3046 }
3047
3048 sub get_partsgroup {
3049   $main::lxdebug->enter_sub();
3050
3051   my ($self, $myconfig, $p) = @_;
3052   my $target = $p->{target} || 'all_partsgroup';
3053
3054   my $dbh = $self->get_standard_dbh($myconfig);
3055
3056   my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
3057                  FROM partsgroup pg
3058                  JOIN parts p ON (p.partsgroup_id = pg.id) |;
3059   my @values;
3060
3061   if ($p->{searchitems} eq 'part') {
3062     $query .= qq|WHERE p.part_type = 'part'|;
3063   }
3064   if ($p->{searchitems} eq 'service') {
3065     $query .= qq|WHERE p.part_type = 'service'|;
3066   }
3067   if ($p->{searchitems} eq 'assembly') {
3068     $query .= qq|WHERE p.part_type = 'assembly'|;
3069   }
3070
3071   $query .= qq|ORDER BY partsgroup|;
3072
3073   if ($p->{all}) {
3074     $query = qq|SELECT id, partsgroup FROM partsgroup
3075                 ORDER BY partsgroup|;
3076   }
3077
3078   if ($p->{language_code}) {
3079     $query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
3080                   t.description AS translation
3081                 FROM partsgroup pg
3082                 JOIN parts p ON (p.partsgroup_id = pg.id)
3083                 LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
3084                 ORDER BY translation|;
3085     @values = ($p->{language_code});
3086   }
3087
3088   $self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);
3089
3090   $main::lxdebug->leave_sub();
3091 }
3092
3093 sub get_pricegroup {
3094   $main::lxdebug->enter_sub();
3095
3096   my ($self, $myconfig, $p) = @_;
3097
3098   my $dbh = $self->get_standard_dbh($myconfig);
3099
3100   my $query = qq|SELECT p.id, p.pricegroup
3101                  FROM pricegroup p|;
3102
3103   $query .= qq| ORDER BY pricegroup|;
3104
3105   if ($p->{all}) {
3106     $query = qq|SELECT id, pricegroup FROM pricegroup
3107                 ORDER BY pricegroup|;
3108   }
3109
3110   $self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);
3111
3112   $main::lxdebug->leave_sub();
3113 }
3114
3115 sub all_years {
3116 # usage $form->all_years($myconfig, [$dbh])
3117 # return list of all years where bookings found
3118 # (@all_years)
3119
3120   $main::lxdebug->enter_sub();
3121
3122   my ($self, $myconfig, $dbh) = @_;
3123
3124   $dbh ||= $self->get_standard_dbh($myconfig);
3125
3126   # get years
3127   my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
3128                    (SELECT MAX(transdate) FROM acc_trans)|;
3129   my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);
3130
3131   if ($myconfig->{dateformat} =~ /^yy/) {
3132     ($startdate) = split /\W/, $startdate;
3133     ($enddate) = split /\W/, $enddate;
3134   } else {
3135     (@_) = split /\W/, $startdate;
3136     $startdate = $_[2];
3137     (@_) = split /\W/, $enddate;
3138     $enddate = $_[2];
3139   }
3140
3141   my @all_years;
3142   $startdate = substr($startdate,0,4);
3143   $enddate = substr($enddate,0,4);
3144
3145   while ($enddate >= $startdate) {
3146     push @all_years, $enddate--;
3147   }
3148
3149   return @all_years;
3150
3151   $main::lxdebug->leave_sub();
3152 }
3153
3154 sub backup_vars {
3155   $main::lxdebug->enter_sub();
3156   my $self = shift;
3157   my @vars = @_;
3158
3159   map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;
3160
3161   $main::lxdebug->leave_sub();
3162 }
3163
3164 sub restore_vars {
3165   $main::lxdebug->enter_sub();
3166
3167   my $self = shift;
3168   my @vars = @_;
3169
3170   map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;
3171
3172   $main::lxdebug->leave_sub();
3173 }
3174
3175 sub prepare_for_printing {
3176   my ($self) = @_;
3177
3178   my $defaults         = SL::DB::Default->get;
3179
3180   $self->{templates} ||= $defaults->templates;
3181   $self->{formname}  ||= $self->{type};
3182   $self->{media}     ||= 'email';
3183
3184   die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
3185
3186   # Several fields that used to reside in %::myconfig (stored in
3187   # auth.user_config) are now stored in defaults. Copy them over for
3188   # compatibility.
3189   $self->{$_} = $defaults->$_ for qw(company address taxnumber co_ustid duns sepa_creditor_id);
3190
3191   $self->{"myconfig_${_}"} = $::myconfig{$_} for grep { $_ ne 'dbpasswd' } keys %::myconfig;
3192
3193   if (!$self->{employee_id}) {
3194     $self->{"employee_${_}"} = $::myconfig{$_} for qw(email tel fax name signature);
3195     $self->{"employee_${_}"} = $defaults->$_   for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
3196   }
3197
3198   my $language = $self->{language} ? '_' . $self->{language} : '';
3199
3200   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
3201   if ($self->{language_id}) {
3202     ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
3203   }
3204
3205   $output_dateformat   ||= $::myconfig{dateformat};
3206   $output_numberformat ||= $::myconfig{numberformat};
3207   $output_longdates    //= 1;
3208
3209   $self->{myconfig_output_dateformat}   = $output_dateformat   // $::myconfig{dateformat};
3210   $self->{myconfig_output_longdates}    = $output_longdates    // 1;
3211   $self->{myconfig_output_numberformat} = $output_numberformat // $::myconfig{numberformat};
3212
3213   # Retrieve accounts for tax calculation.
3214   IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});
3215
3216   if ($self->{type} =~ /_delivery_order$/) {
3217     DO->order_details(\%::myconfig, $self);
3218   } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) {
3219     OE->order_details(\%::myconfig, $self);
3220   } else {
3221     IS->invoice_details(\%::myconfig, $self, $::locale);
3222   }
3223
3224   # Chose extension & set source file name
3225   my $extension = 'html';
3226   if ($self->{format} eq 'postscript') {
3227     $self->{postscript}   = 1;
3228     $extension            = 'tex';
3229   } elsif ($self->{"format"} =~ /pdf/) {
3230     $self->{pdf}          = 1;
3231     $extension            = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
3232   } elsif ($self->{"format"} =~ /opendocument/) {
3233     $self->{opendocument} = 1;
3234     $extension            = 'odt';
3235   } elsif ($self->{"format"} =~ /excel/) {
3236     $self->{excel}        = 1;
3237     $extension            = 'xls';
3238   }
3239
3240   my $printer_code    = $self->{printer_code} ? '_' . $self->{printer_code} : '';
3241   my $email_extension = $self->{media} eq 'email' && -f ($defaults->templates . "/$self->{formname}_email${language}.${extension}") ? '_email' : '';
3242   $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
3243
3244   # Format dates.
3245   $self->format_dates($output_dateformat, $output_longdates,
3246                       qw(invdate orddate quodate pldate duedate reqdate transdate tax_point shippingdate deliverydate validitydate paymentdate datepaid
3247                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
3248                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
3249
3250   $self->reformat_numbers($output_numberformat, 2,
3251                           qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
3252                           grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));
3253
3254   $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));
3255
3256   my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');
3257
3258   if (scalar @{ $cvar_date_fields }) {
3259     $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
3260   }
3261
3262   while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
3263     $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
3264   }
3265
3266   # Translate units
3267   if (($self->{language} // '') ne '') {
3268     my $template_arrays = $self->{TEMPLATE_ARRAYS} || $self;
3269     for my $idx (0..scalar(@{ $template_arrays->{unit} }) - 1) {
3270       $template_arrays->{unit}->[$idx] = AM->translate_units($self, $self->{language}, $template_arrays->{unit}->[$idx], $template_arrays->{qty}->[$idx])
3271     }
3272   }
3273
3274   $self->{template_meta} = {
3275     formname  => $self->{formname},
3276     language  => SL::DB::Manager::Language->find_by_or_create(id => $self->{language_id} || undef),
3277     format    => $self->{format},
3278     media     => $self->{media},
3279     extension => $extension,
3280     printer   => SL::DB::Manager::Printer->find_by_or_create(id => $self->{printer_id} || undef),
3281     today     => DateTime->today,
3282   };
3283
3284   return $self;
3285 }
3286
3287 sub calculate_arap {
3288   my ($self,$buysell,$taxincluded,$exchangerate,$roundplaces) = @_;
3289
3290   # this function is used to calculate netamount, total_tax and amount for AP and
3291   # AR transactions (Kreditoren-/Debitorenbuchungen) by going over all lines
3292   # (1..$rowcount)
3293   # Thus it needs a fully prepared $form to work on.
3294   # calculate_arap assumes $form->{amount_$i} entries still need to be parsed
3295
3296   # The calculated total values are all rounded (default is to 2 places) and
3297   # returned as parameters rather than directly modifying form.  The aim is to
3298   # make the calculation of AP and AR behave identically.  There is a test-case
3299   # for this function in t/form/arap.t
3300
3301   # While calculating the totals $form->{amount_$i} and $form->{tax_$i} are
3302   # modified and formatted and receive the correct sign for writing straight to
3303   # acc_trans, depending on whether they are ar or ap.
3304
3305   # check parameters
3306   die "taxincluded needed in Form->calculate_arap" unless defined $taxincluded;
3307   die "exchangerate needed in Form->calculate_arap" unless defined $exchangerate;
3308   die 'illegal buysell parameter, has to be \"buy\" or \"sell\" in Form->calculate_arap\n' unless $buysell =~ /^(buy|sell)$/;
3309   $roundplaces = 2 unless $roundplaces;
3310
3311   my $sign = 1;  # adjust final results for writing amount to acc_trans
3312   $sign = -1 if $buysell eq 'buy';
3313
3314   my ($netamount,$total_tax,$amount);
3315
3316   my $tax;
3317
3318   # parse and round amounts, setting correct sign for writing to acc_trans
3319   for my $i (1 .. $self->{rowcount}) {
3320     $self->{"amount_$i"} = $self->round_amount($self->parse_amount(\%::myconfig, $self->{"amount_$i"}) * $exchangerate * $sign, $roundplaces);
3321
3322     $amount += $self->{"amount_$i"} * $sign;
3323   }
3324
3325   for my $i (1 .. $self->{rowcount}) {
3326     next unless $self->{"amount_$i"};
3327     ($self->{"tax_id_$i"}) = split /--/, $self->{"taxchart_$i"};
3328     my $tax_id = $self->{"tax_id_$i"};
3329
3330     my $selected_tax = SL::DB::Manager::Tax->find_by(id => "$tax_id");
3331
3332     if ( $selected_tax ) {
3333
3334       if ( $buysell eq 'sell' ) {
3335         $self->{AR_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
3336       } else {
3337         $self->{AP_amounts}{"tax_$i"} = $selected_tax->chart->accno if defined $selected_tax->chart;
3338       };
3339
3340       $self->{"taxkey_$i"} = $selected_tax->taxkey;
3341       $self->{"taxrate_$i"} = $selected_tax->rate;
3342     };
3343
3344     ($self->{"amount_$i"}, $self->{"tax_$i"}) = $self->calculate_tax($self->{"amount_$i"},$self->{"taxrate_$i"},$taxincluded,$roundplaces);
3345
3346     $netamount  += $self->{"amount_$i"};
3347     $total_tax  += $self->{"tax_$i"};
3348
3349   }
3350   $amount = $netamount + $total_tax;
3351
3352   # due to $sign amount_$i und tax_$i already have the right sign for acc_trans
3353   # but reverse sign of totals for writing amounts to ar
3354   if ( $buysell eq 'buy' ) {
3355     $netamount *= -1;
3356     $amount    *= -1;
3357     $total_tax *= -1;
3358   };
3359
3360   return($netamount,$total_tax,$amount);
3361 }
3362
3363 sub format_dates {
3364   my ($self, $dateformat, $longformat, @indices) = @_;
3365
3366   $dateformat ||= $::myconfig{dateformat};
3367
3368   foreach my $idx (@indices) {
3369     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3370       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3371         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
3372       }
3373     }
3374
3375     next unless defined $self->{$idx};
3376
3377     if (!ref($self->{$idx})) {
3378       $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);
3379
3380     } elsif (ref($self->{$idx}) eq "ARRAY") {
3381       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3382         $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
3383       }
3384     }
3385   }
3386 }
3387
3388 sub reformat_numbers {
3389   my ($self, $numberformat, $places, @indices) = @_;
3390
3391   return if !$numberformat || ($numberformat eq $::myconfig{numberformat});
3392
3393   foreach my $idx (@indices) {
3394     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3395       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3396         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
3397       }
3398     }
3399
3400     next unless defined $self->{$idx};
3401
3402     if (!ref($self->{$idx})) {
3403       $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});
3404
3405     } elsif (ref($self->{$idx}) eq "ARRAY") {
3406       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3407         $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
3408       }
3409     }
3410   }
3411
3412   my $saved_numberformat    = $::myconfig{numberformat};
3413   $::myconfig{numberformat} = $numberformat;
3414
3415   foreach my $idx (@indices) {
3416     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3417       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3418         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
3419       }
3420     }
3421
3422     next unless defined $self->{$idx};
3423
3424     if (!ref($self->{$idx})) {
3425       $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);
3426
3427     } elsif (ref($self->{$idx}) eq "ARRAY") {
3428       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3429         $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
3430       }
3431     }
3432   }
3433
3434   $::myconfig{numberformat} = $saved_numberformat;
3435 }
3436
3437 sub create_email_signature {
3438
3439   my $client_signature = $::instance_conf->get_signature;
3440   my $user_signature   = $::myconfig{signature};
3441
3442   my $signature = '';
3443   if ( $client_signature or $user_signature ) {
3444     $signature  = "\n\n-- \n";
3445     $signature .= $user_signature   . "\n" if $user_signature;
3446     $signature .= $client_signature . "\n" if $client_signature;
3447   };
3448   return $signature;
3449
3450 };
3451
3452 sub calculate_tax {
3453   # this function calculates the net amount and tax for the lines in ar, ap and
3454   # gl and is used for update as well as post. When used with update the return
3455   # value of amount isn't needed
3456
3457   # calculate_tax should always work with positive values, or rather as the user inputs them
3458   # calculate_tax uses db/perl numberformat, i.e. parsed numbers
3459   # convert to negative numbers (when necessary) only when writing to acc_trans
3460   # the amount from $form for ap/ar/gl is currently always rounded to 2 decimals before it reaches here
3461   # for post_transaction amount already contains exchangerate and correct sign and is rounded
3462   # calculate_tax doesn't (need to) know anything about exchangerate
3463
3464   my ($self,$amount,$taxrate,$taxincluded,$roundplaces) = @_;
3465
3466   $roundplaces //= 2;
3467   $taxincluded //= 0;
3468
3469   my $tax;
3470
3471   if ($taxincluded) {
3472     # calculate tax (unrounded), subtract from amount, round amount and round tax
3473     $tax       = $amount - ($amount / ($taxrate + 1)); # equivalent to: taxrate * amount / (taxrate + 1)
3474     $amount    = $self->round_amount($amount - $tax, $roundplaces);
3475     $tax       = $self->round_amount($tax, $roundplaces);
3476   } else {
3477     $tax       = $amount * $taxrate;
3478     $tax       = $self->round_amount($tax, $roundplaces);
3479   }
3480
3481   $tax = 0 unless $tax;
3482
3483   return ($amount,$tax);
3484 };
3485
3486 1;
3487
3488 __END__
3489
3490 =head1 NAME
3491
3492 SL::Form.pm - main data object.
3493
3494 =head1 SYNOPSIS
3495
3496 This is the main data object of kivitendo.
3497 Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
3498 Points of interest for a beginner are:
3499
3500  - $form->error            - renders a generic error in html. accepts an error message
3501  - $form->get_standard_dbh - returns a database connection for the
3502
3503 =head1 SPECIAL FUNCTIONS
3504
3505 =head2 C<redirect_header> $url
3506
3507 Generates a HTTP redirection header for the new C<$url>. Constructs an
3508 absolute URL including scheme, host name and port. If C<$url> is a
3509 relative URL then it is considered relative to kivitendo base URL.
3510
3511 This function C<die>s if headers have already been created with
3512 C<$::form-E<gt>header>.
3513
3514 Examples:
3515
3516   print $::form->redirect_header('oe.pl?action=edit&id=1234');
3517   print $::form->redirect_header('http://www.lx-office.org/');
3518
3519 =head2 C<header>
3520
3521 Generates a general purpose http/html header and includes most of the scripts
3522 and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.
3523
3524 Only one header will be generated. If the method was already called in this
3525 request it will not output anything and return undef. Also if no
3526 HTTP_USER_AGENT is found, no header is generated.
3527
3528 Although header does not accept parameters itself, it will honor special
3529 hashkeys of its Form instance:
3530
3531 =over 4
3532
3533 =item refresh_time
3534
3535 =item refresh_url
3536
3537 If one of these is set, a http-equiv refresh is generated. Missing parameters
3538 default to 3 seconds and the refering url.
3539
3540 =item stylesheet
3541
3542 Either a scalar or an array ref. Will be inlined into the header. Add
3543 stylesheets with the L<use_stylesheet> function.
3544
3545 =item landscape
3546
3547 If true, a css snippet will be generated that sets the page in landscape mode.
3548
3549 =item favicon
3550
3551 Used to override the default favicon.
3552
3553 =item title
3554
3555 A html page title will be generated from this
3556
3557 =item mtime_ischanged
3558
3559 Tries to avoid concurrent write operations to records by checking the database mtime with a fetched one.
3560
3561 Can be used / called with any table, that has itime and mtime attributes.
3562 Valid C<table> names are: oe, ar, ap, delivery_orders, parts.
3563 Can be called wit C<option> mail to generate a different error message.
3564
3565 Returns undef if no save operation has been done yet ($self->{id} not present).
3566 Returns undef if no concurrent write process is detected otherwise a error message.
3567
3568 =back
3569
3570 =cut