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