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