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