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