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