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