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