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