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