SL/Form.pm

   1 #====================================================================
   2 # LX-Office ERP
   3 # Copyright (C) 2004
   4 # Based on SQL-Ledger Version 2.1.9
   5 # Web http://www.lx-office.org
   6 #
   7 #=====================================================================
   8 # SQL-Ledger Accounting
   9 # Copyright (C) 1998-2002
  10 #
  11 #  Author: Dieter Simader
  12 #   Email: dsimader@sql-ledger.org
  13 #     Web: http://www.sql-ledger.org
  14 #
  15 # Contributors: Thomas Bayen <bayen@gmx.de>
  16 #               Antti Kaihola <akaihola@siba.fi>
  17 #               Moritz Bunkus (tex code)
  18 #
  19 # This program is free software; you can redistribute it and/or modify
  20 # it under the terms of the GNU General Public License as published by
  21 # the Free Software Foundation; either version 2 of the License, or
  22 # (at your option) any later version.
  23 #
  24 # This program is distributed in the hope that it will be useful,
  25 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  26 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  27 # GNU General Public License for more details.
  28 # You should have received a copy of the GNU General Public License
  29 # along with this program; if not, write to the Free Software
  30 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  31 #======================================================================
  32 # Utilities for parsing forms
  33 # and supporting routines for linking account numbers
  34 # used in AR, AP and IS, IR modules
  35 #
  36 #======================================================================
  37
  38 package Form;
  39
  40 use Data::Dumper;
  41
  42 use CGI;
  43 use Cwd;
  44 use Encode;
  45 use File::Copy;
  46 use IO::File;
  47 use SL::Auth;
  48 use SL::Auth::DB;
  49 use SL::Auth::LDAP;
  50 use SL::AM;
  51 use SL::Common;
  52 use SL::CVar;
  53 use SL::DB;
  54 use SL::DBConnect;
  55 use SL::DBUtils;
  56 use SL::DO;
  57 use SL::IC;
  58 use SL::IS;
  59 use SL::Layout::Dispatcher;
  60 use SL::Locale;
  61 use SL::Mailer;
  62 use SL::Menu;
  63 use SL::MoreCommon qw(uri_encode uri_decode);
  64 use SL::OE;
  65 use SL::Request;
  66 use SL::Template;
  67 use SL::User;
  68 use SL::X;
  69 use Template;
  70 use URI;
  71 use List::Util qw(first max min sum);
  72 use List::MoreUtils qw(all any apply);
  73
  74 use strict;
  75
  76 my $standard_dbh;
  77
  78 END {
  79   disconnect_standard_dbh();
  80 }
  81
  82 sub disconnect_standard_dbh {
  83   return unless $standard_dbh;
  84   $standard_dbh->disconnect();
  85   undef $standard_dbh;
  86 }
  87
  88 sub new {
  89   $main::lxdebug->enter_sub();
  90
  91   my $type = shift;
  92
  93   my $self = {};
  94
  95   no warnings 'once';
  96   if ($LXDebug::watch_form) {
  97     require SL::Watchdog;
  98     tie %{ $self }, 'SL::Watchdog';
  99   }
 100
 101   bless $self, $type;
 102
 103   open VERSION_FILE, "VERSION";                 # New but flexible code reads version from VERSION-file
 104   $self->{version} =  <VERSION_FILE>;
 105   close VERSION_FILE;
 106   $self->{version}  =~ s/[^0-9A-Za-z\.\_\-]//g; # only allow numbers, letters, points, underscores and dashes. Prevents injecting of malicious code.
 107
 108   $main::lxdebug->leave_sub();
 109
 110   return $self;
 111 }
 112
 113 sub read_cgi_input {
 114   my ($self) = @_;
 115   SL::Request::read_cgi_input($self);
 116 }
 117
 118 sub _flatten_variables_rec {
 119   $main::lxdebug->enter_sub(2);
 120
 121   my $self   = shift;
 122   my $curr   = shift;
 123   my $prefix = shift;
 124   my $key    = shift;
 125
 126   my @result;
 127
 128   if ('' eq ref $curr->{$key}) {
 129     @result = ({ 'key' => $prefix . $key, 'value' => $curr->{$key} });
 130
 131   } elsif ('HASH' eq ref $curr->{$key}) {
 132     foreach my $hash_key (sort keys %{ $curr->{$key} }) {
 133       push @result, $self->_flatten_variables_rec($curr->{$key}, $prefix . $key . '.', $hash_key);
 134     }
 135
 136   } else {
 137     foreach my $idx (0 .. scalar @{ $curr->{$key} } - 1) {
 138       my $first_array_entry = 1;
 139
 140       foreach my $hash_key (sort keys %{ $curr->{$key}->[$idx] }) {
 141         push @result, $self->_flatten_variables_rec($curr->{$key}->[$idx], $prefix . $key . ($first_array_entry ? '[+].' : '[].'), $hash_key);
 142         $first_array_entry = 0;
 143       }
 144     }
 145   }
 146
 147   $main::lxdebug->leave_sub(2);
 148
 149   return @result;
 150 }
 151
 152 sub flatten_variables {
 153   $main::lxdebug->enter_sub(2);
 154
 155   my $self = shift;
 156   my @keys = @_;
 157
 158   my @variables;
 159
 160   foreach (@keys) {
 161     push @variables, $self->_flatten_variables_rec($self, '', $_);
 162   }
 163
 164   $main::lxdebug->leave_sub(2);
 165
 166   return @variables;
 167 }
 168
 169 sub flatten_standard_variables {
 170   $main::lxdebug->enter_sub(2);
 171
 172   my $self      = shift;
 173   my %skip_keys = map { $_ => 1 } (qw(login password header stylesheet titlebar version), @_);
 174
 175   my @variables;
 176
 177   foreach (grep { ! $skip_keys{$_} } keys %{ $self }) {
 178     push @variables, $self->_flatten_variables_rec($self, '', $_);
 179   }
 180
 181   $main::lxdebug->leave_sub(2);
 182
 183   return @variables;
 184 }
 185
 186 sub debug {
 187   $main::lxdebug->enter_sub();
 188
 189   my ($self) = @_;
 190
 191   print "\n";
 192
 193   map { print "$_ = $self->{$_}\n" } (sort keys %{$self});
 194
 195   $main::lxdebug->leave_sub();
 196 }
 197
 198 sub dumper {
 199   $main::lxdebug->enter_sub(2);
 200
 201   my $self          = shift;
 202   my $password      = $self->{password};
 203
 204   $self->{password} = 'X' x 8;
 205
 206   local $Data::Dumper::Sortkeys = 1;
 207   my $output                    = Dumper($self);
 208
 209   $self->{password} = $password;
 210
 211   $main::lxdebug->leave_sub(2);
 212
 213   return $output;
 214 }
 215
 216 sub escape {
 217   my ($self, $str) = @_;
 218
 219   return uri_encode($str);
 220 }
 221
 222 sub unescape {
 223   my ($self, $str) = @_;
 224
 225   return uri_decode($str);
 226 }
 227
 228 sub quote {
 229   $main::lxdebug->enter_sub();
 230   my ($self, $str) = @_;
 231
 232   if ($str && !ref($str)) {
 233     $str =~ s/\"/&quot;/g;
 234   }
 235
 236   $main::lxdebug->leave_sub();
 237
 238   return $str;
 239 }
 240
 241 sub unquote {
 242   $main::lxdebug->enter_sub();
 243   my ($self, $str) = @_;
 244
 245   if ($str && !ref($str)) {
 246     $str =~ s/&quot;/\"/g;
 247   }
 248
 249   $main::lxdebug->leave_sub();
 250
 251   return $str;
 252 }
 253
 254 sub hide_form {
 255   $main::lxdebug->enter_sub();
 256   my $self = shift;
 257
 258   if (@_) {
 259     map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
 260   } else {
 261     for (sort keys %$self) {
 262       next if (($_ eq "header") || (ref($self->{$_}) ne ""));
 263       print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
 264     }
 265   }
 266   $main::lxdebug->leave_sub();
 267 }
 268
 269 sub throw_on_error {
 270   my ($self, $code) = @_;
 271   local $self->{__ERROR_HANDLER} = sub { die SL::X::FormError->new($_[0]) };
 272   $code->();
 273 }
 274
 275 sub error {
 276   $main::lxdebug->enter_sub();
 277
 278   $main::lxdebug->show_backtrace();
 279
 280   my ($self, $msg) = @_;
 281
 282   if ($self->{__ERROR_HANDLER}) {
 283     $self->{__ERROR_HANDLER}->($msg);
 284
 285   } elsif ($ENV{HTTP_USER_AGENT}) {
 286     $msg =~ s/\n/<br>/g;
 287     $self->show_generic_error($msg);
 288
 289   } else {
 290     print STDERR "Error: $msg\n";
 291     ::end_of_request();
 292   }
 293
 294   $main::lxdebug->leave_sub();
 295 }
 296
 297 sub info {
 298   $main::lxdebug->enter_sub();
 299
 300   my ($self, $msg) = @_;
 301
 302   if ($ENV{HTTP_USER_AGENT}) {
 303     $msg =~ s/\n/<br>/g;
 304
 305     if (!$self->{header}) {
 306       $self->header;
 307       print qq|<body>|;
 308     }
 309
 310     print qq|
 311     <p class="message_ok"><b>$msg</b></p>
 312
 313     <script type="text/javascript">
 314     <!--
 315     // If JavaScript is enabled, the whole thing will be reloaded.
 316     // The reason is: When one changes his menu setup (HTML / CSS ...)
 317     // it now loads the correct code into the browser instead of do nothing.
 318     setTimeout("top.frames.location.href='login.pl'",500);
 319     //-->
 320     </script>
 321
 322 </body>
 323     |;
 324
 325   } else {
 326
 327     if ($self->{info_function}) {
 328       &{ $self->{info_function} }($msg);
 329     } else {
 330       print "$msg\n";
 331     }
 332   }
 333
 334   $main::lxdebug->leave_sub();
 335 }
 336
 337 # calculates the number of rows in a textarea based on the content and column number
 338 # can be capped with maxrows
 339 sub numtextrows {
 340   $main::lxdebug->enter_sub();
 341   my ($self, $str, $cols, $maxrows, $minrows) = @_;
 342
 343   $minrows ||= 1;
 344
 345   my $rows   = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str;
 346   $maxrows ||= $rows;
 347
 348   $main::lxdebug->leave_sub();
 349
 350   return max(min($rows, $maxrows), $minrows);
 351 }
 352
 353 sub dberror {
 354   $main::lxdebug->enter_sub();
 355
 356   my ($self, $msg) = @_;
 357
 358   $self->error("$msg\n" . $DBI::errstr);
 359
 360   $main::lxdebug->leave_sub();
 361 }
 362
 363 sub isblank {
 364   $main::lxdebug->enter_sub();
 365
 366   my ($self, $name, $msg) = @_;
 367
 368   my $curr = $self;
 369   foreach my $part (split m/\./, $name) {
 370     if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
 371       $self->error($msg);
 372     }
 373     $curr = $curr->{$part};
 374   }
 375
 376   $main::lxdebug->leave_sub();
 377 }
 378
 379 sub _get_request_uri {
 380   my $self = shift;
 381
 382   return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
 383   return URI->new                                  if !$ENV{REQUEST_URI}; # for testing
 384
 385   my $scheme =  $ENV{HTTPS} && (lc $ENV{HTTPS} eq 'on') ? 'https' : 'http';
 386   my $port   =  $ENV{SERVER_PORT};
 387   $port      =  undef if (($scheme eq 'http' ) && ($port == 80))
 388                       || (($scheme eq 'https') && ($port == 443));
 389
 390   my $uri    =  URI->new("${scheme}://");
 391   $uri->scheme($scheme);
 392   $uri->port($port);
 393   $uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR});
 394   $uri->path_query($ENV{REQUEST_URI});
 395   $uri->query('');
 396
 397   return $uri;
 398 }
 399
 400 sub _add_to_request_uri {
 401   my $self              = shift;
 402
 403   my $relative_new_path = shift;
 404   my $request_uri       = shift || $self->_get_request_uri;
 405   my $relative_new_uri  = URI->new($relative_new_path);
 406   my @request_segments  = $request_uri->path_segments;
 407
 408   my $new_uri           = $request_uri->clone;
 409   $new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments);
 410
 411   return $new_uri;
 412 }
 413
 414 sub create_http_response {
 415   $main::lxdebug->enter_sub();
 416
 417   my $self     = shift;
 418   my %params   = @_;
 419
 420   my $cgi      = $::request->{cgi};
 421
 422   my $session_cookie;
 423   if (defined $main::auth) {
 424     my $uri      = $self->_get_request_uri;
 425     my @segments = $uri->path_segments;
 426     pop @segments;
 427     $uri->path_segments(@segments);
 428
 429     my $session_cookie_value = $main::auth->get_session_id();
 430
 431     if ($session_cookie_value) {
 432       $session_cookie = $cgi->cookie('-name'   => $main::auth->get_session_cookie_name(),
 433                                      '-value'  => $session_cookie_value,
 434                                      '-path'   => $uri->path,
 435                                      '-secure' => $ENV{HTTPS});
 436     }
 437   }
 438
 439   my %cgi_params = ('-type' => $params{content_type});
 440   $cgi_params{'-charset'} = $params{charset} if ($params{charset});
 441   $cgi_params{'-cookie'}  = $session_cookie  if ($session_cookie);
 442
 443   map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length);
 444
 445   my $output = $cgi->header(%cgi_params);
 446
 447   $main::lxdebug->leave_sub();
 448
 449   return $output;
 450 }
 451
 452 sub header {
 453   $::lxdebug->enter_sub;
 454
 455   my ($self, %params) = @_;
 456   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
 457   my @header;
 458
 459   $::lxdebug->leave_sub and return if !$ENV{HTTP_USER_AGENT} || $self->{header}++;
 460
 461   if ($params{no_layout}) {
 462     $::request->{layout} = SL::Layout::Dispatcher->new(style => 'none');
 463   }
 464
 465   my $layout = $::request->{layout};
 466
 467   # standard css for all
 468   # this should gradually move to the layouts that need it
 469   $layout->use_stylesheet("$_.css") for qw(
 470     main menu tabcontent list_accounts jquery.autocomplete
 471     jquery.multiselect2side frame_header/header
 472     ui-lightness/jquery-ui-1.8.12.custom
 473     js/jscalendar/calendar-win2k-1
 474   );
 475
 476   $layout->use_javascript("$_.js") for qw(
 477     jquery common jscalendar/calendar jscalendar/lang/calendar-de
 478     jscalendar/calendar-setup part_selection jquery-ui jquery.cookie jqModal
 479     switchmenuframe
 480   );
 481
 482   $self->{favicon} ||= "favicon.ico";
 483   $self->{titlebar} = join ' - ', grep $_, $self->{title}, $self->{login}, $::myconfig{dbname}, $self->{version} if $self->{title} || !$self->{titlebar};
 484
 485   # build includes
 486   if ($self->{refresh_url} || $self->{refresh_time}) {
 487     my $refresh_time = $self->{refresh_time} || 3;
 488     my $refresh_url  = $self->{refresh_url}  || $ENV{REFERER};
 489     push @header, "<meta http-equiv='refresh' content='$refresh_time;$refresh_url'>";
 490   }
 491
 492   push @header, map { qq|<link rel="stylesheet" href="$_" type="text/css" title="Stylesheet">| } $layout->stylesheets;
 493   push @header, "<style type='text/css'>\@page { size:landscape; }</style> "                     if $self->{landscape};
 494   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>"         if -f $self->{favicon};
 495   push @header, map { qq|<script type="text/javascript" src="$_"></script>| }                    $layout->javascripts;
 496   push @header, $self->{javascript} if $self->{javascript};
 497   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
 498
 499   my  %doctypes = (
 500     strict       => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|,
 501     transitional => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|,
 502     frameset     => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|,
 503     html5        => qq|<!DOCTYPE html>|,
 504   );
 505
 506   # output
 507   print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
 508   print $doctypes{$params{doctype} || 'transitional'}, $/;
 509   print <<EOT;
 510 <html>
 511  <head>
 512   <meta http-equiv="Content-Type" content="text/html; charset=$db_charset">
 513   <title>$self->{titlebar}</title>
 514 EOT
 515   print "  $_\n" for @header;
 516   print <<EOT;
 517   <meta name="robots" content="noindex,nofollow">
 518   <script type="text/javascript" src="js/tabcontent.js">
 519
 520   /***********************************************
 521    * Tab Content script v2.2- © Dynamic Drive DHTML code library (www.dynamicdrive.com)
 522    * This notice MUST stay intact for legal use
 523    * Visit Dynamic Drive at http://www.dynamicdrive.com/ for full source code
 524    ***********************************************/
 525
 526   </script>
 527  </head>
 528  <body>
 529
 530 EOT
 531   print $::request->{layout}->pre_content;
 532   print $::request->{layout}->start_content;
 533
 534   $layout->header_done;
 535
 536   $::lxdebug->leave_sub;
 537 }
 538
 539 sub footer {
 540   return unless $::request->{layout}->need_footer;
 541
 542   print $::request->{layout}->end_content;
 543   print $::request->{layout}->post_content;
 544
 545   if (my @inline_scripts = $::request->{layout}->javascripts_inline) {
 546     print "<script type='text/javascript'>@inline_scripts</script>\n";
 547   }
 548
 549   print <<EOL
 550  </body>
 551 </html>
 552 EOL
 553 }
 554
 555 sub ajax_response_header {
 556   $main::lxdebug->enter_sub();
 557
 558   my ($self) = @_;
 559
 560   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
 561   my $output     = $::request->{cgi}->header('-charset' => $db_charset);
 562
 563   $main::lxdebug->leave_sub();
 564
 565   return $output;
 566 }
 567
 568 sub redirect_header {
 569   my $self     = shift;
 570   my $new_url  = shift;
 571
 572   my $base_uri = $self->_get_request_uri;
 573   my $new_uri  = URI->new_abs($new_url, $base_uri);
 574
 575   die "Headers already sent" if $self->{header};
 576   $self->{header} = 1;
 577
 578   return $::request->{cgi}->redirect($new_uri);
 579 }
 580
 581 sub set_standard_title {
 582   $::lxdebug->enter_sub;
 583   my $self = shift;
 584
 585   $self->{titlebar}  = "kivitendo " . $::locale->text('Version') . " $self->{version}";
 586   $self->{titlebar} .= "- $::myconfig{name}"   if $::myconfig{name};
 587   $self->{titlebar} .= "- $::myconfig{dbname}" if $::myconfig{name};
 588
 589   $::lxdebug->leave_sub;
 590 }
 591
 592 sub _prepare_html_template {
 593   $main::lxdebug->enter_sub();
 594
 595   my ($self, $file, $additional_params) = @_;
 596   my $language;
 597
 598   if (!%::myconfig || !$::myconfig{"countrycode"}) {
 599     $language = $::lx_office_conf{system}->{language};
 600   } else {
 601     $language = $main::myconfig{"countrycode"};
 602   }
 603   $language = "de" unless ($language);
 604
 605   if (-f "templates/webpages/${file}.html") {
 606     $file = "templates/webpages/${file}.html";
 607
 608   } else {
 609     my $info = "Web page template '${file}' not found.\n";
 610     print qq|<pre>$info</pre>|;
 611     ::end_of_request();
 612   }
 613
 614   if ($self->{"DEBUG"}) {
 615     $additional_params->{"DEBUG"} = $self->{"DEBUG"};
 616   }
 617
 618   if ($additional_params->{"DEBUG"}) {
 619     $additional_params->{"DEBUG"} =
 620       "<br><em>DEBUG INFORMATION:</em><pre>" . $additional_params->{"DEBUG"} . "</pre>";
 621   }
 622
 623   if (%main::myconfig) {
 624     $::myconfig{jsc_dateformat} = apply {
 625       s/d+/\%d/gi;
 626       s/m+/\%m/gi;
 627       s/y+/\%Y/gi;
 628     } $::myconfig{"dateformat"};
 629     $additional_params->{"myconfig"} ||= \%::myconfig;
 630     map { $additional_params->{"myconfig_${_}"} = $main::myconfig{$_}; } keys %::myconfig;
 631   }
 632
 633   $additional_params->{"conf_dbcharset"}              = $::lx_office_conf{system}->{dbcharset};
 634   $additional_params->{"conf_webdav"}                 = $::lx_office_conf{features}->{webdav};
 635   $additional_params->{"conf_latex_templates"}        = $::lx_office_conf{print_templates}->{latex};
 636   $additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument};
 637   $additional_params->{"conf_vertreter"}              = $::lx_office_conf{features}->{vertreter};
 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 && $curr) {
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, $duedate);
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   if ($payment_id) {
1984     my $query  = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|;
1985     ($duedate) = selectrow_query($self, $dbh, $query, $payment_id);
1986   }
1987
1988   $main::lxdebug->leave_sub();
1989
1990   return $duedate;
1991 }
1992
1993 sub _get_contacts {
1994   $main::lxdebug->enter_sub();
1995
1996   my ($self, $dbh, $id, $key) = @_;
1997
1998   $key = "all_contacts" unless ($key);
1999
2000   if (!$id) {
2001     $self->{$key} = [];
2002     $main::lxdebug->leave_sub();
2003     return;
2004   }
2005
2006   my $query =
2007     qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
2008     qq|FROM contacts | .
2009     qq|WHERE cp_cv_id = ? | .
2010     qq|ORDER BY lower(cp_name)|;
2011
2012   $self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);
2013
2014   $main::lxdebug->leave_sub();
2015 }
2016
2017 sub _get_projects {
2018   $main::lxdebug->enter_sub();
2019
2020   my ($self, $dbh, $key) = @_;
2021
2022   my ($all, $old_id, $where, @values);
2023
2024   if (ref($key) eq "HASH") {
2025     my $params = $key;
2026
2027     $key = "ALL_PROJECTS";
2028
2029     foreach my $p (keys(%{$params})) {
2030       if ($p eq "all") {
2031         $all = $params->{$p};
2032       } elsif ($p eq "old_id") {
2033         $old_id = $params->{$p};
2034       } elsif ($p eq "key") {
2035         $key = $params->{$p};
2036       }
2037     }
2038   }
2039
2040   if (!$all) {
2041     $where = "WHERE active ";
2042     if ($old_id) {
2043       if (ref($old_id) eq "ARRAY") {
2044         my @ids = grep({ $_ } @{$old_id});
2045         if (@ids) {
2046           $where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
2047           push(@values, @ids);
2048         }
2049       } else {
2050         $where .= " OR (id = ?) ";
2051         push(@values, $old_id);
2052       }
2053     }
2054   }
2055
2056   my $query =
2057     qq|SELECT id, projectnumber, description, active | .
2058     qq|FROM project | .
2059     $where .
2060     qq|ORDER BY lower(projectnumber)|;
2061
2062   $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
2063
2064   $main::lxdebug->leave_sub();
2065 }
2066
2067 sub _get_shipto {
2068   $main::lxdebug->enter_sub();
2069
2070   my ($self, $dbh, $vc_id, $key) = @_;
2071
2072   $key = "all_shipto" unless ($key);
2073
2074   if ($vc_id) {
2075     # get shipping addresses
2076     my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
2077
2078     $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
2079
2080   } else {
2081     $self->{$key} = [];
2082   }
2083
2084   $main::lxdebug->leave_sub();
2085 }
2086
2087 sub _get_printers {
2088   $main::lxdebug->enter_sub();
2089
2090   my ($self, $dbh, $key) = @_;
2091
2092   $key = "all_printers" unless ($key);
2093
2094   my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;
2095
2096   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2097
2098   $main::lxdebug->leave_sub();
2099 }
2100
2101 sub _get_charts {
2102   $main::lxdebug->enter_sub();
2103
2104   my ($self, $dbh, $params) = @_;
2105   my ($key);
2106
2107   $key = $params->{key};
2108   $key = "all_charts" unless ($key);
2109
2110   my $transdate = quote_db_date($params->{transdate});
2111
2112   my $query =
2113     qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
2114     qq|FROM chart c | .
2115     qq|LEFT JOIN taxkeys tk ON | .
2116     qq|(tk.id = (SELECT id FROM taxkeys | .
2117     qq|          WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
2118     qq|          ORDER BY startdate DESC LIMIT 1)) | .
2119     qq|ORDER BY c.accno|;
2120
2121   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2122
2123   $main::lxdebug->leave_sub();
2124 }
2125
2126 sub _get_taxcharts {
2127   $main::lxdebug->enter_sub();
2128
2129   my ($self, $dbh, $params) = @_;
2130
2131   my $key = "all_taxcharts";
2132   my @where;
2133
2134   if (ref $params eq 'HASH') {
2135     $key = $params->{key} if ($params->{key});
2136     if ($params->{module} eq 'AR') {
2137       push @where, 'taxkey NOT IN (8, 9, 18, 19)';
2138
2139     } elsif ($params->{module} eq 'AP') {
2140       push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)';
2141     }
2142
2143   } elsif ($params) {
2144     $key = $params;
2145   }
2146
2147   my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
2148
2149   my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
2150
2151   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2152
2153   $main::lxdebug->leave_sub();
2154 }
2155
2156 sub _get_taxzones {
2157   $main::lxdebug->enter_sub();
2158
2159   my ($self, $dbh, $key) = @_;
2160
2161   $key = "all_taxzones" unless ($key);
2162
2163   my $query = qq|SELECT * FROM tax_zones ORDER BY id|;
2164
2165   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2166
2167   $main::lxdebug->leave_sub();
2168 }
2169
2170 sub _get_employees {
2171   $main::lxdebug->enter_sub();
2172
2173   my ($self, $dbh, $default_key, $key) = @_;
2174
2175   $key = $default_key unless ($key);
2176   $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|);
2177
2178   $main::lxdebug->leave_sub();
2179 }
2180
2181 sub _get_business_types {
2182   $main::lxdebug->enter_sub();
2183
2184   my ($self, $dbh, $key) = @_;
2185
2186   my $options       = ref $key eq 'HASH' ? $key : { key => $key };
2187   $options->{key} ||= "all_business_types";
2188   my $where         = '';
2189
2190   if (exists $options->{salesman}) {
2191     $where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
2192   }
2193
2194   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
2195
2196   $main::lxdebug->leave_sub();
2197 }
2198
2199 sub _get_languages {
2200   $main::lxdebug->enter_sub();
2201
2202   my ($self, $dbh, $key) = @_;
2203
2204   $key = "all_languages" unless ($key);
2205
2206   my $query = qq|SELECT * FROM language ORDER BY id|;
2207
2208   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2209
2210   $main::lxdebug->leave_sub();
2211 }
2212
2213 sub _get_dunning_configs {
2214   $main::lxdebug->enter_sub();
2215
2216   my ($self, $dbh, $key) = @_;
2217
2218   $key = "all_dunning_configs" unless ($key);
2219
2220   my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;
2221
2222   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2223
2224   $main::lxdebug->leave_sub();
2225 }
2226
2227 sub _get_currencies {
2228 $main::lxdebug->enter_sub();
2229
2230   my ($self, $dbh, $key) = @_;
2231
2232   $key = "all_currencies" unless ($key);
2233
2234   my $query = qq|SELECT curr AS currency FROM defaults|;
2235
2236   $self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})];
2237
2238   $main::lxdebug->leave_sub();
2239 }
2240
2241 sub _get_payments {
2242 $main::lxdebug->enter_sub();
2243
2244   my ($self, $dbh, $key) = @_;
2245
2246   $key = "all_payments" unless ($key);
2247
2248   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
2249
2250   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2251
2252   $main::lxdebug->leave_sub();
2253 }
2254
2255 sub _get_customers {
2256   $main::lxdebug->enter_sub();
2257
2258   my ($self, $dbh, $key) = @_;
2259
2260   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
2261   $options->{key}  ||= "all_customers";
2262   my $limit_clause   = $options->{limit} ? "LIMIT $options->{limit}" : '';
2263
2264   my @where;
2265   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
2266   push @where, qq|NOT obsolete|                                            if !$options->{with_obsolete};
2267   my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';
2268
2269   my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
2270   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
2271
2272   $main::lxdebug->leave_sub();
2273 }
2274
2275 sub _get_vendors {
2276   $main::lxdebug->enter_sub();
2277
2278   my ($self, $dbh, $key) = @_;
2279
2280   $key = "all_vendors" unless ($key);
2281
2282   my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;
2283
2284   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2285
2286   $main::lxdebug->leave_sub();
2287 }
2288
2289 sub _get_departments {
2290   $main::lxdebug->enter_sub();
2291
2292   my ($self, $dbh, $key) = @_;
2293
2294   $key = "all_departments" unless ($key);
2295
2296   my $query = qq|SELECT * FROM department ORDER BY description|;
2297
2298   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2299
2300   $main::lxdebug->leave_sub();
2301 }
2302
2303 sub _get_warehouses {
2304   $main::lxdebug->enter_sub();
2305
2306   my ($self, $dbh, $param) = @_;
2307
2308   my ($key, $bins_key);
2309
2310   if ('' eq ref $param) {
2311     $key = $param;
2312
2313   } else {
2314     $key      = $param->{key};
2315     $bins_key = $param->{bins};
2316   }
2317
2318   my $query = qq|SELECT w.* FROM warehouse w
2319                  WHERE (NOT w.invalid) AND
2320                    ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
2321                  ORDER BY w.sortkey|;
2322
2323   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2324
2325   if ($bins_key) {
2326     $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
2327                 ORDER BY description|;
2328     my $sth = prepare_query($self, $dbh, $query);
2329
2330     foreach my $warehouse (@{ $self->{$key} }) {
2331       do_statement($self, $sth, $query, $warehouse->{id});
2332       $warehouse->{$bins_key} = [];
2333
2334       while (my $ref = $sth->fetchrow_hashref()) {
2335         push @{ $warehouse->{$bins_key} }, $ref;
2336       }
2337     }
2338     $sth->finish();
2339   }
2340
2341   $main::lxdebug->leave_sub();
2342 }
2343
2344 sub _get_simple {
2345   $main::lxdebug->enter_sub();
2346
2347   my ($self, $dbh, $table, $key, $sortkey) = @_;
2348
2349   my $query  = qq|SELECT * FROM $table|;
2350   $query    .= qq| ORDER BY $sortkey| if ($sortkey);
2351
2352   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2353
2354   $main::lxdebug->leave_sub();
2355 }
2356
2357 #sub _get_groups {
2358 #  $main::lxdebug->enter_sub();
2359 #
2360 #  my ($self, $dbh, $key) = @_;
2361 #
2362 #  $key ||= "all_groups";
2363 #
2364 #  my $groups = $main::auth->read_groups();
2365 #
2366 #  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2367 #
2368 #  $main::lxdebug->leave_sub();
2369 #}
2370
2371 sub get_lists {
2372   $main::lxdebug->enter_sub();
2373
2374   my $self = shift;
2375   my %params = @_;
2376
2377   my $dbh = $self->get_standard_dbh(\%main::myconfig);
2378   my ($sth, $query, $ref);
2379
2380   my $vc = $self->{"vc"} eq "customer" ? "customer" : "vendor";
2381   my $vc_id = $self->{"${vc}_id"};
2382
2383   if ($params{"contacts"}) {
2384     $self->_get_contacts($dbh, $vc_id, $params{"contacts"});
2385   }
2386
2387   if ($params{"shipto"}) {
2388     $self->_get_shipto($dbh, $vc_id, $params{"shipto"});
2389   }
2390
2391   if ($params{"projects"} || $params{"all_projects"}) {
2392     $self->_get_projects($dbh, $params{"all_projects"} ?
2393                          $params{"all_projects"} : $params{"projects"},
2394                          $params{"all_projects"} ? 1 : 0);
2395   }
2396
2397   if ($params{"printers"}) {
2398     $self->_get_printers($dbh, $params{"printers"});
2399   }
2400
2401   if ($params{"languages"}) {
2402     $self->_get_languages($dbh, $params{"languages"});
2403   }
2404
2405   if ($params{"charts"}) {
2406     $self->_get_charts($dbh, $params{"charts"});
2407   }
2408
2409   if ($params{"taxcharts"}) {
2410     $self->_get_taxcharts($dbh, $params{"taxcharts"});
2411   }
2412
2413   if ($params{"taxzones"}) {
2414     $self->_get_taxzones($dbh, $params{"taxzones"});
2415   }
2416
2417   if ($params{"employees"}) {
2418     $self->_get_employees($dbh, "all_employees", $params{"employees"});
2419   }
2420
2421   if ($params{"salesmen"}) {
2422     $self->_get_employees($dbh, "all_salesmen", $params{"salesmen"});
2423   }
2424
2425   if ($params{"business_types"}) {
2426     $self->_get_business_types($dbh, $params{"business_types"});
2427   }
2428
2429   if ($params{"dunning_configs"}) {
2430     $self->_get_dunning_configs($dbh, $params{"dunning_configs"});
2431   }
2432
2433   if($params{"currencies"}) {
2434     $self->_get_currencies($dbh, $params{"currencies"});
2435   }
2436
2437   if($params{"customers"}) {
2438     $self->_get_customers($dbh, $params{"customers"});
2439   }
2440
2441   if($params{"vendors"}) {
2442     if (ref $params{"vendors"} eq 'HASH') {
2443       $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
2444     } else {
2445       $self->_get_vendors($dbh, $params{"vendors"});
2446     }
2447   }
2448
2449   if($params{"payments"}) {
2450     $self->_get_payments($dbh, $params{"payments"});
2451   }
2452
2453   if($params{"departments"}) {
2454     $self->_get_departments($dbh, $params{"departments"});
2455   }
2456
2457   if ($params{price_factors}) {
2458     $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
2459   }
2460
2461   if ($params{warehouses}) {
2462     $self->_get_warehouses($dbh, $params{warehouses});
2463   }
2464
2465 #  if ($params{groups}) {
2466 #    $self->_get_groups($dbh, $params{groups});
2467 #  }
2468
2469   if ($params{partsgroup}) {
2470     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
2471   }
2472
2473   $main::lxdebug->leave_sub();
2474 }
2475
2476 # this sub gets the id and name from $table
2477 sub get_name {
2478   $main::lxdebug->enter_sub();
2479
2480   my ($self, $myconfig, $table) = @_;
2481
2482   # connect to database
2483   my $dbh = $self->get_standard_dbh($myconfig);
2484
2485   $table = $table eq "customer" ? "customer" : "vendor";
2486   my $arap = $self->{arap} eq "ar" ? "ar" : "ap";
2487
2488   my ($query, @values);
2489
2490   if (!$self->{openinvoices}) {
2491     my $where;
2492     if ($self->{customernumber} ne "") {
2493       $where = qq|(vc.customernumber ILIKE ?)|;
2494       push(@values, '%' . $self->{customernumber} . '%');
2495     } else {
2496       $where = qq|(vc.name ILIKE ?)|;
2497       push(@values, '%' . $self->{$table} . '%');
2498     }
2499
2500     $query =
2501       qq~SELECT vc.id, vc.name,
2502            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2503          FROM $table vc
2504          WHERE $where AND (NOT vc.obsolete)
2505          ORDER BY vc.name~;
2506   } else {
2507     $query =
2508       qq~SELECT DISTINCT vc.id, vc.name,
2509            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2510          FROM $arap a
2511          JOIN $table vc ON (a.${table}_id = vc.id)
2512          WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
2513          ORDER BY vc.name~;
2514     push(@values, '%' . $self->{$table} . '%');
2515   }
2516
2517   $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
2518
2519   $main::lxdebug->leave_sub();
2520
2521   return scalar(@{ $self->{name_list} });
2522 }
2523
2524 # the selection sub is used in the AR, AP, IS, IR, DO and OE module
2525 #
2526 sub all_vc {
2527   $main::lxdebug->enter_sub();
2528
2529   my ($self, $myconfig, $table, $module) = @_;
2530
2531   my $ref;
2532   my $dbh = $self->get_standard_dbh;
2533
2534   $table = $table eq "customer" ? "customer" : "vendor";
2535
2536   # build selection list
2537   # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege
2538   # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch
2539   # nicht für veränderbare Belege (oe, do, ...)
2540   my $obsolete = "WHERE NOT obsolete" unless $self->{id};
2541   my $query = qq|SELECT count(*) FROM $table $obsolete|;
2542   my ($count) = selectrow_query($self, $dbh, $query);
2543
2544   if ($count < $myconfig->{vclimit}) {
2545     $query = qq|SELECT id, name, salesman_id
2546                 FROM $table $obsolete
2547                 ORDER BY name|;
2548     $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
2549   }
2550
2551   # get self
2552   $self->get_employee($dbh);
2553
2554   # setup sales contacts
2555   $query = qq|SELECT e.id, e.name
2556               FROM employee e
2557               WHERE (e.sales = '1') AND (NOT e.id = ?)
2558               ORDER BY name|;
2559   $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
2560
2561   # this is for self
2562   push(@{ $self->{all_employees} },
2563        { id   => $self->{employee_id},
2564          name => $self->{employee} });
2565
2566     # prepare query for departments
2567     $query = qq|SELECT id, description
2568                 FROM department
2569                 ORDER BY description|;
2570
2571   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2572
2573   # get languages
2574   $query = qq|SELECT id, description
2575               FROM language
2576               ORDER BY id|;
2577
2578   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2579
2580   # get printer
2581   $query = qq|SELECT printer_description, id
2582               FROM printers
2583               ORDER BY printer_description|;
2584
2585   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2586
2587   # get payment terms
2588   $query = qq|SELECT id, description
2589               FROM payment_terms
2590               ORDER BY sortkey|;
2591
2592   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
2593
2594   $main::lxdebug->leave_sub();
2595 }
2596
2597 sub language_payment {
2598   $main::lxdebug->enter_sub();
2599
2600   my ($self, $myconfig) = @_;
2601
2602   my $dbh = $self->get_standard_dbh($myconfig);
2603   # get languages
2604   my $query = qq|SELECT id, description
2605                  FROM language
2606                  ORDER BY id|;
2607
2608   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2609
2610   # get printer
2611   $query = qq|SELECT printer_description, id
2612               FROM printers
2613               ORDER BY printer_description|;
2614
2615   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2616
2617   # get payment terms
2618   $query = qq|SELECT id, description
2619               FROM payment_terms
2620               ORDER BY sortkey|;
2621
2622   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
2623
2624   # get buchungsgruppen
2625   $query = qq|SELECT id, description
2626               FROM buchungsgruppen|;
2627
2628   $self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);
2629
2630   $main::lxdebug->leave_sub();
2631 }
2632
2633 # this is only used for reports
2634 sub all_departments {
2635   $main::lxdebug->enter_sub();
2636
2637   my ($self, $myconfig, $table) = @_;
2638
2639   my $dbh = $self->get_standard_dbh($myconfig);
2640
2641   my $query = qq|SELECT id, description
2642                  FROM department
2643                  ORDER BY description|;
2644   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2645
2646   delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });
2647
2648   $main::lxdebug->leave_sub();
2649 }
2650
2651 sub create_links {
2652   $main::lxdebug->enter_sub();
2653
2654   my ($self, $module, $myconfig, $table, $provided_dbh) = @_;
2655
2656   my ($fld, $arap);
2657   if ($table eq "customer") {
2658     $fld = "buy";
2659     $arap = "ar";
2660   } else {
2661     $table = "vendor";
2662     $fld = "sell";
2663     $arap = "ap";
2664   }
2665
2666   $self->all_vc($myconfig, $table, $module);
2667
2668   # get last customers or vendors
2669   my ($query, $sth, $ref);
2670
2671   my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
2672   my %xkeyref = ();
2673
2674   if (!$self->{id}) {
2675
2676     my $transdate = "current_date";
2677     if ($self->{transdate}) {
2678       $transdate = $dbh->quote($self->{transdate});
2679     }
2680
2681     # now get the account numbers
2682 #    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
2683 #                FROM chart c, taxkeys tk
2684 #                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
2685 #                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
2686 #                ORDER BY c.accno|;
2687
2688 #  same query as above, but without expensive subquery for each row. about 80% faster
2689     $query = qq|
2690       SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id
2691         FROM chart c
2692         -- find newest entries in taxkeys
2693         INNER JOIN (
2694           SELECT chart_id, MAX(startdate) AS startdate
2695           FROM taxkeys
2696           WHERE (startdate <= $transdate)
2697           GROUP BY chart_id
2698         ) tk ON (c.id = tk.chart_id)
2699         -- and load all of those entries
2700         INNER JOIN taxkeys tk2
2701            ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
2702        WHERE (c.link LIKE ?)
2703       ORDER BY c.accno|;
2704
2705     $sth = $dbh->prepare($query);
2706
2707     do_statement($self, $sth, $query, '%' . $module . '%');
2708
2709     $self->{accounts} = "";
2710     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2711
2712       foreach my $key (split(/:/, $ref->{link})) {
2713         if ($key =~ /\Q$module\E/) {
2714
2715           # cross reference for keys
2716           $xkeyref{ $ref->{accno} } = $key;
2717
2718           push @{ $self->{"${module}_links"}{$key} },
2719             { accno       => $ref->{accno},
2720               description => $ref->{description},
2721               taxkey      => $ref->{taxkey_id},
2722               tax_id      => $ref->{tax_id} };
2723
2724           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2725         }
2726       }
2727     }
2728   }
2729
2730   # get taxkeys and description
2731   $query = qq|SELECT id, taxkey, taxdescription FROM tax|;
2732   $self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);
2733
2734   if (($module eq "AP") || ($module eq "AR")) {
2735     # get tax rates and description
2736     $query = qq|SELECT * FROM tax|;
2737     $self->{TAX} = selectall_hashref_query($self, $dbh, $query);
2738   }
2739
2740   my $extra_columns = '';
2741   $extra_columns   .= 'a.direct_debit, ' if $module eq 'AR';
2742
2743   if ($self->{id}) {
2744     $query =
2745       qq|SELECT
2746            a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid,
2747            a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
2748            a.intnotes, a.department_id, a.amount AS oldinvtotal,
2749            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
2750            a.globalproject_id, ${extra_columns}
2751            c.name AS $table,
2752            d.description AS department,
2753            e.name AS employee
2754          FROM $arap a
2755          JOIN $table c ON (a.${table}_id = c.id)
2756          LEFT JOIN employee e ON (e.id = a.employee_id)
2757          LEFT JOIN department d ON (d.id = a.department_id)
2758          WHERE a.id = ?|;
2759     $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
2760
2761     foreach my $key (keys %$ref) {
2762       $self->{$key} = $ref->{$key};
2763     }
2764
2765     # remove any trailing whitespace
2766     $self->{currency} =~ s/\s*$//;
2767
2768     my $transdate = "current_date";
2769     if ($self->{transdate}) {
2770       $transdate = $dbh->quote($self->{transdate});
2771     }
2772
2773     # now get the account numbers
2774     $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
2775                 FROM chart c
2776                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
2777                 WHERE c.link LIKE ?
2778                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
2779                     OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
2780                 ORDER BY c.accno|;
2781
2782     $sth = $dbh->prepare($query);
2783     do_statement($self, $sth, $query, "%$module%");
2784
2785     $self->{accounts} = "";
2786     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2787
2788       foreach my $key (split(/:/, $ref->{link})) {
2789         if ($key =~ /\Q$module\E/) {
2790
2791           # cross reference for keys
2792           $xkeyref{ $ref->{accno} } = $key;
2793
2794           push @{ $self->{"${module}_links"}{$key} },
2795             { accno       => $ref->{accno},
2796               description => $ref->{description},
2797               taxkey      => $ref->{taxkey_id},
2798               tax_id      => $ref->{tax_id} };
2799
2800           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2801         }
2802       }
2803     }
2804
2805
2806     # get amounts from individual entries
2807     $query =
2808       qq|SELECT
2809            c.accno, c.description,
2810            a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey,
2811            p.projectnumber,
2812            t.rate, t.id
2813          FROM acc_trans a
2814          LEFT JOIN chart c ON (c.id = a.chart_id)
2815          LEFT JOIN project p ON (p.id = a.project_id)
2816          LEFT JOIN tax t ON (t.id= (SELECT tk.tax_id FROM taxkeys tk
2817                                     WHERE (tk.taxkey_id=a.taxkey) AND
2818                                       ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id = a.taxkey)
2819                                         THEN tk.chart_id = a.chart_id
2820                                         ELSE 1 = 1
2821                                         END)
2822                                        OR (c.link='%tax%')) AND
2823                                       (startdate <= a.transdate) ORDER BY startdate DESC LIMIT 1))
2824          WHERE a.trans_id = ?
2825          AND a.fx_transaction = '0'
2826          ORDER BY a.acc_trans_id, a.transdate|;
2827     $sth = $dbh->prepare($query);
2828     do_statement($self, $sth, $query, $self->{id});
2829
2830     # get exchangerate for currency
2831     $self->{exchangerate} =
2832       $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2833     my $index = 0;
2834
2835     # store amounts in {acc_trans}{$key} for multiple accounts
2836     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
2837       $ref->{exchangerate} =
2838         $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
2839       if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
2840         $index++;
2841       }
2842       if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
2843         $ref->{amount} *= -1;
2844       }
2845       $ref->{index} = $index;
2846
2847       push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
2848     }
2849
2850     $sth->finish;
2851     $query =
2852       qq|SELECT
2853            d.curr AS currencies, d.closedto, d.revtrans,
2854            (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2855            (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
2856          FROM defaults d|;
2857     $ref = selectfirst_hashref_query($self, $dbh, $query);
2858     map { $self->{$_} = $ref->{$_} } keys %$ref;
2859
2860   } else {
2861
2862     # get date
2863     $query =
2864        qq|SELECT
2865             current_date AS transdate, d.curr AS currencies, d.closedto, d.revtrans,
2866             (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2867             (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
2868           FROM defaults d|;
2869     $ref = selectfirst_hashref_query($self, $dbh, $query);
2870     map { $self->{$_} = $ref->{$_} } keys %$ref;
2871
2872     if ($self->{"$self->{vc}_id"}) {
2873
2874       # only setup currency
2875       ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency};
2876
2877     } else {
2878
2879       $self->lastname_used($dbh, $myconfig, $table, $module);
2880
2881       # get exchangerate for currency
2882       $self->{exchangerate} =
2883         $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2884
2885     }
2886
2887   }
2888
2889   $main::lxdebug->leave_sub();
2890 }
2891
2892 sub lastname_used {
2893   $main::lxdebug->enter_sub();
2894
2895   my ($self, $dbh, $myconfig, $table, $module) = @_;
2896
2897   my ($arap, $where);
2898
2899   $table         = $table eq "customer" ? "customer" : "vendor";
2900   my %column_map = ("a.curr"                  => "currency",
2901                     "a.${table}_id"           => "${table}_id",
2902                     "a.department_id"         => "department_id",
2903                     "d.description"           => "department",
2904                     "ct.name"                 => $table,
2905                     "ct.curr"                 => "cv_curr",
2906                     "current_date + ct.terms" => "duedate",
2907     );
2908
2909   if ($self->{type} =~ /delivery_order/) {
2910     $arap  = 'delivery_orders';
2911     delete $column_map{"a.curr"};
2912     delete $column_map{"ct.curr"};
2913
2914   } elsif ($self->{type} =~ /_order/) {
2915     $arap  = 'oe';
2916     $where = "quotation = '0'";
2917
2918   } elsif ($self->{type} =~ /_quotation/) {
2919     $arap  = 'oe';
2920     $where = "quotation = '1'";
2921
2922   } elsif ($table eq 'customer') {
2923     $arap  = 'ar';
2924
2925   } else {
2926     $arap  = 'ap';
2927
2928   }
2929
2930   $where           = "($where) AND" if ($where);
2931   my $query        = qq|SELECT MAX(id) FROM $arap
2932                         WHERE $where ${table}_id > 0|;
2933   my ($trans_id)   = selectrow_query($self, $dbh, $query);
2934   $trans_id       *= 1;
2935
2936   my $column_spec  = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
2937   $query           = qq|SELECT $column_spec
2938                         FROM $arap a
2939                         LEFT JOIN $table     ct ON (a.${table}_id = ct.id)
2940                         LEFT JOIN department d  ON (a.department_id = d.id)
2941                         WHERE a.id = ?|;
2942   my $ref          = selectfirst_hashref_query($self, $dbh, $query, $trans_id);
2943
2944   map { $self->{$_} = $ref->{$_} } values %column_map;
2945
2946   # remove any trailing whitespace
2947   $self->{currency} =~ s/\s*$// if $self->{currency};
2948   $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr};
2949
2950   # if customer/vendor currency is set use this
2951   $self->{currency} = $self->{cv_curr} if $self->{cv_curr};
2952
2953   $main::lxdebug->leave_sub();
2954 }
2955
2956 sub current_date {
2957   $main::lxdebug->enter_sub();
2958
2959   my $self     = shift;
2960   my $myconfig = shift || \%::myconfig;
2961   my ($thisdate, $days) = @_;
2962
2963   my $dbh = $self->get_standard_dbh($myconfig);
2964   my $query;
2965
2966   $days *= 1;
2967   if ($thisdate) {
2968     my $dateformat = $myconfig->{dateformat};
2969     $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
2970     $thisdate = $dbh->quote($thisdate);
2971     $query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
2972   } else {
2973     $query = qq|SELECT current_date AS thisdate|;
2974   }
2975
2976   ($thisdate) = selectrow_query($self, $dbh, $query);
2977
2978   $main::lxdebug->leave_sub();
2979
2980   return $thisdate;
2981 }
2982
2983 sub like {
2984   $main::lxdebug->enter_sub();
2985
2986   my ($self, $string) = @_;
2987
2988   if ($string !~ /%/) {
2989     $string = "%$string%";
2990   }
2991
2992   $string =~ s/\'/\'\'/g;
2993
2994   $main::lxdebug->leave_sub();
2995
2996   return $string;
2997 }
2998
2999 sub redo_rows {
3000   $main::lxdebug->enter_sub();
3001
3002   my ($self, $flds, $new, $count, $numrows) = @_;
3003
3004   my @ndx = ();
3005
3006   map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
3007
3008   my $i = 0;
3009
3010   # fill rows
3011   foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
3012     $i++;
3013     my $j = $item->{ndx} - 1;
3014     map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
3015   }
3016
3017   # delete empty rows
3018   for $i ($count + 1 .. $numrows) {
3019     map { delete $self->{"${_}_$i"} } @{$flds};
3020   }
3021
3022   $main::lxdebug->leave_sub();
3023 }
3024
3025 sub update_status {
3026   $main::lxdebug->enter_sub();
3027
3028   my ($self, $myconfig) = @_;
3029
3030   my ($i, $id);
3031
3032   my $dbh = $self->dbconnect_noauto($myconfig);
3033
3034   my $query = qq|DELETE FROM status
3035                  WHERE (formname = ?) AND (trans_id = ?)|;
3036   my $sth = prepare_query($self, $dbh, $query);
3037
3038   if ($self->{formname} =~ /(check|receipt)/) {
3039     for $i (1 .. $self->{rowcount}) {
3040       do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
3041     }
3042   } else {
3043     do_statement($self, $sth, $query, $self->{formname}, $self->{id});
3044   }
3045   $sth->finish();
3046
3047   my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3048   my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3049
3050   my %queued = split / /, $self->{queued};
3051   my @values;
3052
3053   if ($self->{formname} =~ /(check|receipt)/) {
3054
3055     # this is a check or receipt, add one entry for each lineitem
3056     my ($accno) = split /--/, $self->{account};
3057     $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
3058                 VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
3059     @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
3060     $sth = prepare_query($self, $dbh, $query);
3061
3062     for $i (1 .. $self->{rowcount}) {
3063       if ($self->{"checked_$i"}) {
3064         do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
3065       }
3066     }
3067     $sth->finish();
3068
3069   } else {
3070     $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
3071                 VALUES (?, ?, ?, ?, ?)|;
3072     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
3073              $queued{$self->{formname}}, $self->{formname});
3074   }
3075
3076   $dbh->commit;
3077   $dbh->disconnect;
3078
3079   $main::lxdebug->leave_sub();
3080 }
3081
3082 sub save_status {
3083   $main::lxdebug->enter_sub();
3084
3085   my ($self, $dbh) = @_;
3086
3087   my ($query, $printed, $emailed);
3088
3089   my $formnames  = $self->{printed};
3090   my $emailforms = $self->{emailed};
3091
3092   $query = qq|DELETE FROM status
3093                  WHERE (formname = ?) AND (trans_id = ?)|;
3094   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
3095
3096   # this only applies to the forms
3097   # checks and receipts are posted when printed or queued
3098
3099   if ($self->{queued}) {
3100     my %queued = split / /, $self->{queued};
3101
3102     foreach my $formname (keys %queued) {
3103       $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3104       $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3105
3106       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
3107                   VALUES (?, ?, ?, ?, ?)|;
3108       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
3109
3110       $formnames  =~ s/\Q$self->{formname}\E//;
3111       $emailforms =~ s/\Q$self->{formname}\E//;
3112
3113     }
3114   }
3115
3116   # save printed, emailed info
3117   $formnames  =~ s/^ +//g;
3118   $emailforms =~ s/^ +//g;
3119
3120   my %status = ();
3121   map { $status{$_}{printed} = 1 } split / +/, $formnames;
3122   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
3123
3124   foreach my $formname (keys %status) {
3125     $printed = ($formnames  =~ /\Q$self->{formname}\E/) ? "1" : "0";
3126     $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
3127
3128     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
3129                 VALUES (?, ?, ?, ?)|;
3130     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
3131   }
3132
3133   $main::lxdebug->leave_sub();
3134 }
3135
3136 #--- 4 locale ---#
3137 # $main::locale->text('SAVED')
3138 # $main::locale->text('DELETED')
3139 # $main::locale->text('ADDED')
3140 # $main::locale->text('PAYMENT POSTED')
3141 # $main::locale->text('POSTED')
3142 # $main::locale->text('POSTED AS NEW')
3143 # $main::locale->text('ELSE')
3144 # $main::locale->text('SAVED FOR DUNNING')
3145 # $main::locale->text('DUNNING STARTED')
3146 # $main::locale->text('PRINTED')
3147 # $main::locale->text('MAILED')
3148 # $main::locale->text('SCREENED')
3149 # $main::locale->text('CANCELED')
3150 # $main::locale->text('invoice')
3151 # $main::locale->text('proforma')
3152 # $main::locale->text('sales_order')
3153 # $main::locale->text('pick_list')
3154 # $main::locale->text('purchase_order')
3155 # $main::locale->text('bin_list')
3156 # $main::locale->text('sales_quotation')
3157 # $main::locale->text('request_quotation')
3158
3159 sub save_history {
3160   $main::lxdebug->enter_sub();
3161
3162   my $self = shift;
3163   my $dbh  = shift || $self->get_standard_dbh;
3164
3165   if(!exists $self->{employee_id}) {
3166     &get_employee($self, $dbh);
3167   }
3168
3169   my $query =
3170    qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
3171    qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
3172   my @values = (conv_i($self->{id}), $self->{login},
3173                 $self->{addition}, $self->{what_done}, "$self->{snumbers}");
3174   do_query($self, $dbh, $query, @values);
3175
3176   $dbh->commit;
3177
3178   $main::lxdebug->leave_sub();
3179 }
3180
3181 sub get_history {
3182   $main::lxdebug->enter_sub();
3183
3184   my ($self, $dbh, $trans_id, $restriction, $order) = @_;
3185   my ($orderBy, $desc) = split(/\-\-/, $order);
3186   $order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
3187   my @tempArray;
3188   my $i = 0;
3189   if ($trans_id ne "") {
3190     my $query =
3191       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 | .
3192       qq|FROM history_erp h | .
3193       qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
3194       qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | .
3195       $order;
3196
3197     my $sth = $dbh->prepare($query) || $self->dberror($query);
3198
3199     $sth->execute() || $self->dberror("$query");
3200
3201     while(my $hash_ref = $sth->fetchrow_hashref()) {
3202       $hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
3203       $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
3204       $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g;
3205       $tempArray[$i++] = $hash_ref;
3206     }
3207     $main::lxdebug->leave_sub() and return \@tempArray
3208       if ($i > 0 && $tempArray[0] ne "");
3209   }
3210   $main::lxdebug->leave_sub();
3211   return 0;
3212 }
3213
3214 sub update_defaults {
3215   $main::lxdebug->enter_sub();
3216
3217   my ($self, $myconfig, $fld, $provided_dbh) = @_;
3218
3219   my $dbh;
3220   if ($provided_dbh) {
3221     $dbh = $provided_dbh;
3222   } else {
3223     $dbh = $self->dbconnect_noauto($myconfig);
3224   }
3225   my $query = qq|SELECT $fld FROM defaults FOR UPDATE|;
3226   my $sth   = $dbh->prepare($query);
3227
3228   $sth->execute || $self->dberror($query);
3229   my ($var) = $sth->fetchrow_array;
3230   $sth->finish;
3231
3232   if ($var =~ m/\d+$/) {
3233     my $new_var  = (substr $var, $-[0]) * 1 + 1;
3234     my $len_diff = length($var) - $-[0] - length($new_var);
3235     $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
3236
3237   } else {
3238     $var = $var . '1';
3239   }
3240
3241   $query = qq|UPDATE defaults SET $fld = ?|;
3242   do_query($self, $dbh, $query, $var);
3243
3244   if (!$provided_dbh) {
3245     $dbh->commit;
3246     $dbh->disconnect;
3247   }
3248
3249   $main::lxdebug->leave_sub();
3250
3251   return $var;
3252 }
3253
3254 sub update_business {
3255   $main::lxdebug->enter_sub();
3256
3257   my ($self, $myconfig, $business_id, $provided_dbh) = @_;
3258
3259   my $dbh;
3260   if ($provided_dbh) {
3261     $dbh = $provided_dbh;
3262   } else {
3263     $dbh = $self->dbconnect_noauto($myconfig);
3264   }
3265   my $query =
3266     qq|SELECT customernumberinit FROM business
3267        WHERE id = ? FOR UPDATE|;
3268   my ($var) = selectrow_query($self, $dbh, $query, $business_id);
3269
3270   return undef unless $var;
3271
3272   if ($var =~ m/\d+$/) {
3273     my $new_var  = (substr $var, $-[0]) * 1 + 1;
3274     my $len_diff = length($var) - $-[0] - length($new_var);
3275     $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
3276
3277   } else {
3278     $var = $var . '1';
3279   }
3280
3281   $query = qq|UPDATE business
3282               SET customernumberinit = ?
3283               WHERE id = ?|;
3284   do_query($self, $dbh, $query, $var, $business_id);
3285
3286   if (!$provided_dbh) {
3287     $dbh->commit;
3288     $dbh->disconnect;
3289   }
3290
3291   $main::lxdebug->leave_sub();
3292
3293   return $var;
3294 }
3295
3296 sub get_partsgroup {
3297   $main::lxdebug->enter_sub();
3298
3299   my ($self, $myconfig, $p) = @_;
3300   my $target = $p->{target} || 'all_partsgroup';
3301
3302   my $dbh = $self->get_standard_dbh($myconfig);
3303
3304   my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
3305                  FROM partsgroup pg
3306                  JOIN parts p ON (p.partsgroup_id = pg.id) |;
3307   my @values;
3308
3309   if ($p->{searchitems} eq 'part') {
3310     $query .= qq|WHERE p.inventory_accno_id > 0|;
3311   }
3312   if ($p->{searchitems} eq 'service') {
3313     $query .= qq|WHERE p.inventory_accno_id IS NULL|;
3314   }
3315   if ($p->{searchitems} eq 'assembly') {
3316     $query .= qq|WHERE p.assembly = '1'|;
3317   }
3318   if ($p->{searchitems} eq 'labor') {
3319     $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|;
3320   }
3321
3322   $query .= qq|ORDER BY partsgroup|;
3323
3324   if ($p->{all}) {
3325     $query = qq|SELECT id, partsgroup FROM partsgroup
3326                 ORDER BY partsgroup|;
3327   }
3328
3329   if ($p->{language_code}) {
3330     $query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
3331                   t.description AS translation
3332                 FROM partsgroup pg
3333                 JOIN parts p ON (p.partsgroup_id = pg.id)
3334                 LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
3335                 ORDER BY translation|;
3336     @values = ($p->{language_code});
3337   }
3338
3339   $self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);
3340
3341   $main::lxdebug->leave_sub();
3342 }
3343
3344 sub get_pricegroup {
3345   $main::lxdebug->enter_sub();
3346
3347   my ($self, $myconfig, $p) = @_;
3348
3349   my $dbh = $self->get_standard_dbh($myconfig);
3350
3351   my $query = qq|SELECT p.id, p.pricegroup
3352                  FROM pricegroup p|;
3353
3354   $query .= qq| ORDER BY pricegroup|;
3355
3356   if ($p->{all}) {
3357     $query = qq|SELECT id, pricegroup FROM pricegroup
3358                 ORDER BY pricegroup|;
3359   }
3360
3361   $self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);
3362
3363   $main::lxdebug->leave_sub();
3364 }
3365
3366 sub all_years {
3367 # usage $form->all_years($myconfig, [$dbh])
3368 # return list of all years where bookings found
3369 # (@all_years)
3370
3371   $main::lxdebug->enter_sub();
3372
3373   my ($self, $myconfig, $dbh) = @_;
3374
3375   $dbh ||= $self->get_standard_dbh($myconfig);
3376
3377   # get years
3378   my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
3379                    (SELECT MAX(transdate) FROM acc_trans)|;
3380   my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);
3381
3382   if ($myconfig->{dateformat} =~ /^yy/) {
3383     ($startdate) = split /\W/, $startdate;
3384     ($enddate) = split /\W/, $enddate;
3385   } else {
3386     (@_) = split /\W/, $startdate;
3387     $startdate = $_[2];
3388     (@_) = split /\W/, $enddate;
3389     $enddate = $_[2];
3390   }
3391
3392   my @all_years;
3393   $startdate = substr($startdate,0,4);
3394   $enddate = substr($enddate,0,4);
3395
3396   while ($enddate >= $startdate) {
3397     push @all_years, $enddate--;
3398   }
3399
3400   return @all_years;
3401
3402   $main::lxdebug->leave_sub();
3403 }
3404
3405 sub backup_vars {
3406   $main::lxdebug->enter_sub();
3407   my $self = shift;
3408   my @vars = @_;
3409
3410   map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;
3411
3412   $main::lxdebug->leave_sub();
3413 }
3414
3415 sub restore_vars {
3416   $main::lxdebug->enter_sub();
3417
3418   my $self = shift;
3419   my @vars = @_;
3420
3421   map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;
3422
3423   $main::lxdebug->leave_sub();
3424 }
3425
3426 sub prepare_for_printing {
3427   my ($self) = @_;
3428
3429   $self->{templates} ||= $::myconfig{templates};
3430   $self->{formname}  ||= $self->{type};
3431   $self->{media}     ||= 'email';
3432
3433   die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
3434
3435   # set shipto from billto unless set
3436   my $has_shipto = any { $self->{"shipto$_"} } qw(name street zipcode city country contact);
3437   if (!$has_shipto && ($self->{type} =~ m/^(?:purchase_order|request_quotation)$/)) {
3438     $self->{shiptoname}   = $::myconfig{company};
3439     $self->{shiptostreet} = $::myconfig{address};
3440   }
3441
3442   my $language = $self->{language} ? '_' . $self->{language} : '';
3443
3444   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
3445   if ($self->{language_id}) {
3446     ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
3447   } else {
3448     $output_dateformat   = $::myconfig{dateformat};
3449     $output_numberformat = $::myconfig{numberformat};
3450     $output_longdates    = 1;
3451   }
3452
3453   # Retrieve accounts for tax calculation.
3454   IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});
3455
3456   if ($self->{type} =~ /_delivery_order$/) {
3457     DO->order_details();
3458   } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) {
3459     OE->order_details(\%::myconfig, $self);
3460   } else {
3461     IS->invoice_details(\%::myconfig, $self, $::locale);
3462   }
3463
3464   # Chose extension & set source file name
3465   my $extension = 'html';
3466   if ($self->{format} eq 'postscript') {
3467     $self->{postscript}   = 1;
3468     $extension            = 'tex';
3469   } elsif ($self->{"format"} =~ /pdf/) {
3470     $self->{pdf}          = 1;
3471     $extension            = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
3472   } elsif ($self->{"format"} =~ /opendocument/) {
3473     $self->{opendocument} = 1;
3474     $extension            = 'odt';
3475   } elsif ($self->{"format"} =~ /excel/) {
3476     $self->{excel}        = 1;
3477     $extension            = 'xls';
3478   }
3479
3480   my $printer_code    = $self->{printer_code} ? '_' . $self->{printer_code} : '';
3481   my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : '';
3482   $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
3483
3484   # Format dates.
3485   $self->format_dates($output_dateformat, $output_longdates,
3486                       qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid
3487                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
3488                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
3489
3490   $self->reformat_numbers($output_numberformat, 2,
3491                           qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
3492                           grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));
3493
3494   $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));
3495
3496   my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');
3497
3498   if (scalar @{ $cvar_date_fields }) {
3499     $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
3500   }
3501
3502   while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
3503     $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
3504   }
3505
3506   return $self;
3507 }
3508
3509 sub format_dates {
3510   my ($self, $dateformat, $longformat, @indices) = @_;
3511
3512   $dateformat ||= $::myconfig{dateformat};
3513
3514   foreach my $idx (@indices) {
3515     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3516       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3517         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
3518       }
3519     }
3520
3521     next unless defined $self->{$idx};
3522
3523     if (!ref($self->{$idx})) {
3524       $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);
3525
3526     } elsif (ref($self->{$idx}) eq "ARRAY") {
3527       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3528         $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
3529       }
3530     }
3531   }
3532 }
3533
3534 sub reformat_numbers {
3535   my ($self, $numberformat, $places, @indices) = @_;
3536
3537   return if !$numberformat || ($numberformat eq $::myconfig{numberformat});
3538
3539   foreach my $idx (@indices) {
3540     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3541       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3542         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
3543       }
3544     }
3545
3546     next unless defined $self->{$idx};
3547
3548     if (!ref($self->{$idx})) {
3549       $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});
3550
3551     } elsif (ref($self->{$idx}) eq "ARRAY") {
3552       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3553         $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
3554       }
3555     }
3556   }
3557
3558   my $saved_numberformat    = $::myconfig{numberformat};
3559   $::myconfig{numberformat} = $numberformat;
3560
3561   foreach my $idx (@indices) {
3562     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3563       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3564         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
3565       }
3566     }
3567
3568     next unless defined $self->{$idx};
3569
3570     if (!ref($self->{$idx})) {
3571       $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);
3572
3573     } elsif (ref($self->{$idx}) eq "ARRAY") {
3574       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3575         $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
3576       }
3577     }
3578   }
3579
3580   $::myconfig{numberformat} = $saved_numberformat;
3581 }
3582
3583 sub layout {
3584   my ($self) = @_;
3585   $::lxdebug->enter_sub;
3586
3587   my %style_to_script_map = (
3588     v3  => 'v3',
3589     neu => 'new',
3590   );
3591
3592   my $menu_script = $style_to_script_map{$::myconfig{menustyle}} || '';
3593
3594   package main;
3595   require "bin/mozilla/menu$menu_script.pl";
3596   package Form;
3597   require SL::Controller::FrameHeader;
3598
3599
3600   my $layout = SL::Controller::FrameHeader->new->action_header . ::render();
3601
3602   $::lxdebug->leave_sub;
3603   return $layout;
3604 }
3605
3606 1;
3607
3608 __END__
3609
3610 =head1 NAME
3611
3612 SL::Form.pm - main data object.
3613
3614 =head1 SYNOPSIS
3615
3616 This is the main data object of kivitendo.
3617 Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
3618 Points of interest for a beginner are:
3619
3620  - $form->error            - renders a generic error in html. accepts an error message
3621  - $form->get_standard_dbh - returns a database connection for the
3622
3623 =head1 SPECIAL FUNCTIONS
3624
3625 =head2 C<update_business> PARAMS
3626
3627 PARAMS (not named):
3628  \%config,     - config hashref
3629  $business_id, - business id
3630  $dbh          - optional database handle
3631
3632 handles business (thats customer/vendor types) sequences.
3633
3634 special behaviour for empty strings in customerinitnumber field:
3635 will in this case not increase the value, and return undef.
3636
3637 =head2 C<redirect_header> $url
3638
3639 Generates a HTTP redirection header for the new C<$url>. Constructs an
3640 absolute URL including scheme, host name and port. If C<$url> is a
3641 relative URL then it is considered relative to kivitendo base URL.
3642
3643 This function C<die>s if headers have already been created with
3644 C<$::form-E<gt>header>.
3645
3646 Examples:
3647
3648   print $::form->redirect_header('oe.pl?action=edit&id=1234');
3649   print $::form->redirect_header('http://www.lx-office.org/');
3650
3651 =head2 C<header>
3652
3653 Generates a general purpose http/html header and includes most of the scripts
3654 and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.
3655
3656 Only one header will be generated. If the method was already called in this
3657 request it will not output anything and return undef. Also if no
3658 HTTP_USER_AGENT is found, no header is generated.
3659
3660 Although header does not accept parameters itself, it will honor special
3661 hashkeys of its Form instance:
3662
3663 =over 4
3664
3665 =item refresh_time
3666
3667 =item refresh_url
3668
3669 If one of these is set, a http-equiv refresh is generated. Missing parameters
3670 default to 3 seconds and the refering url.
3671
3672 =item stylesheet
3673
3674 Either a scalar or an array ref. Will be inlined into the header. Add
3675 stylesheets with the L<use_stylesheet> function.
3676
3677 =item landscape
3678
3679 If true, a css snippet will be generated that sets the page in landscape mode.
3680
3681 =item favicon
3682
3683 Used to override the default favicon.
3684
3685 =item title
3686
3687 A html page title will be generated from this
3688
3689 =back
3690
3691 =cut