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         $mail->{message}        =~ s/\r//g;
1160         $mail->{message}        =~ s/\n/<br>\n/g;
1161         $myconfig->{signature}  =~ s/\n/<br>\n/g;
1162         $mail->{message}       .=  "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
1163
1164         open(IN, "<", $self->{tmpfile})
1165           or $self->error($self->cleanup . "$self->{tmpfile} : $!");
1166         $mail->{message} .= $_ while <IN>;
1167         close(IN);
1168
1169       } else {
1170
1171         if (!$self->{"do_not_attach"}) {
1172           my $attachment_name  =  $self->{attachment_filename} || $self->{tmpfile};
1173           $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
1174           $mail->{attachments} =  [{ "filename" => $self->{tmpfile},
1175                                      "name"     => $attachment_name }];
1176         }
1177
1178         $mail->{message}  =~ s/\r//g;
1179         $mail->{message} .=  "\n-- \n$myconfig->{signature}";
1180
1181       }
1182
1183       my $err = $mail->send();
1184       $self->error($self->cleanup . "$err") if ($err);
1185
1186     } else {
1187
1188       $self->{OUT}      = $out;
1189       $self->{OUT_MODE} = $out_mode;
1190
1191       my $numbytes = (-s $self->{tmpfile});
1192       open(IN, "<", $self->{tmpfile})
1193         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
1194       binmode IN;
1195
1196       $self->{copies} = 1 unless $self->{media} eq 'printer';
1197
1198       chdir("$self->{cwd}");
1199       #print(STDERR "Kopien $self->{copies}\n");
1200       #print(STDERR "OUT $self->{OUT}\n");
1201       for my $i (1 .. $self->{copies}) {
1202         if ($self->{OUT}) {
1203           open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
1204           print OUT $_ while <IN>;
1205           close OUT;
1206           seek  IN, 0, 0;
1207
1208         } else {
1209           $self->{attachment_filename} = ($self->{attachment_filename})
1210                                        ? $self->{attachment_filename}
1211                                        : $self->generate_attachment_filename();
1212
1213           # launch application
1214           print qq|Content-Type: | . $template->get_mime_type() . qq|
1215 Content-Disposition: attachment; filename="$self->{attachment_filename}"
1216 Content-Length: $numbytes
1217
1218 |;
1219
1220           $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
1221         }
1222       }
1223
1224       close(IN);
1225     }
1226
1227   }
1228
1229   $self->cleanup;
1230
1231   chdir("$self->{cwd}");
1232   $main::lxdebug->leave_sub();
1233 }
1234
1235 sub get_formname_translation {
1236   $main::lxdebug->enter_sub();
1237   my ($self, $formname) = @_;
1238
1239   $formname ||= $self->{formname};
1240
1241   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1242   my $recipient_locale = Locale->new($self->{recipient_locale});
1243
1244   my %formname_translations = (
1245     bin_list                => $recipient_locale->text('Bin List'),
1246     credit_note             => $recipient_locale->text('Credit Note'),
1247     invoice                 => $recipient_locale->text('Invoice'),
1248     pick_list               => $recipient_locale->text('Pick List'),
1249     proforma                => $recipient_locale->text('Proforma Invoice'),
1250     purchase_order          => $recipient_locale->text('Purchase Order'),
1251     request_quotation       => $recipient_locale->text('RFQ'),
1252     sales_order             => $recipient_locale->text('Confirmation'),
1253     sales_quotation         => $recipient_locale->text('Quotation'),
1254     storno_invoice          => $recipient_locale->text('Storno Invoice'),
1255     sales_delivery_order    => $recipient_locale->text('Delivery Order'),
1256     purchase_delivery_order => $recipient_locale->text('Delivery Order'),
1257     dunning                 => $recipient_locale->text('Dunning'),
1258   );
1259
1260   $main::lxdebug->leave_sub();
1261   return $formname_translations{$formname};
1262 }
1263
1264 sub get_number_prefix_for_type {
1265   $main::lxdebug->enter_sub();
1266   my ($self) = @_;
1267
1268   my $prefix =
1269       (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
1270     : ($self->{type} =~ /_quotation$/)                        ? 'quo'
1271     : ($self->{type} =~ /_delivery_order$/)                   ? 'do'
1272     :                                                           'ord';
1273
1274   $main::lxdebug->leave_sub();
1275   return $prefix;
1276 }
1277
1278 sub get_extension_for_format {
1279   $main::lxdebug->enter_sub();
1280   my ($self)    = @_;
1281
1282   my $extension = $self->{format} =~ /pdf/i          ? ".pdf"
1283                 : $self->{format} =~ /postscript/i   ? ".ps"
1284                 : $self->{format} =~ /opendocument/i ? ".odt"
1285                 : $self->{format} =~ /excel/i        ? ".xls"
1286                 : $self->{format} =~ /html/i         ? ".html"
1287                 :                                      "";
1288
1289   $main::lxdebug->leave_sub();
1290   return $extension;
1291 }
1292
1293 sub generate_attachment_filename {
1294   $main::lxdebug->enter_sub();
1295   my ($self) = @_;
1296
1297   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1298   my $recipient_locale = Locale->new($self->{recipient_locale});
1299
1300   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
1301   my $prefix              = $self->get_number_prefix_for_type();
1302
1303   if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
1304     $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
1305
1306   } elsif ($attachment_filename && $self->{"${prefix}number"}) {
1307     $attachment_filename .=  "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
1308
1309   } else {
1310     $attachment_filename = "";
1311   }
1312
1313   $attachment_filename =  $main::locale->quote_special_chars('filenames', $attachment_filename);
1314   $attachment_filename =~ s|[\s/\\]+|_|g;
1315
1316   $main::lxdebug->leave_sub();
1317   return $attachment_filename;
1318 }
1319
1320 sub generate_email_subject {
1321   $main::lxdebug->enter_sub();
1322   my ($self) = @_;
1323
1324   my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
1325   my $prefix  = $self->get_number_prefix_for_type();
1326
1327   if ($subject && $self->{"${prefix}number"}) {
1328     $subject .= " " . $self->{"${prefix}number"}
1329   }
1330
1331   $main::lxdebug->leave_sub();
1332   return $subject;
1333 }
1334
1335 sub cleanup {
1336   $main::lxdebug->enter_sub();
1337
1338   my ($self, $application) = @_;
1339
1340   my $error_code = $?;
1341
1342   chdir("$self->{tmpdir}");
1343
1344   my @err = ();
1345   if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
1346     push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');
1347
1348   } elsif (-f "$self->{tmpfile}.err") {
1349     open(FH, "$self->{tmpfile}.err");
1350     @err = <FH>;
1351     close(FH);
1352   }
1353
1354   if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
1355     $self->{tmpfile} =~ s|.*/||g;
1356     # strip extension
1357     $self->{tmpfile} =~ s/\.\w+$//g;
1358     my $tmpfile = $self->{tmpfile};
1359     unlink(<$tmpfile.*>);
1360   }
1361
1362   chdir("$self->{cwd}");
1363
1364   $main::lxdebug->leave_sub();
1365
1366   return "@err";
1367 }
1368
1369 sub datetonum {
1370   $main::lxdebug->enter_sub();
1371
1372   my ($self, $date, $myconfig) = @_;
1373   my ($yy, $mm, $dd);
1374
1375   if ($date && $date =~ /\D/) {
1376
1377     if ($myconfig->{dateformat} =~ /^yy/) {
1378       ($yy, $mm, $dd) = split /\D/, $date;
1379     }
1380     if ($myconfig->{dateformat} =~ /^mm/) {
1381       ($mm, $dd, $yy) = split /\D/, $date;
1382     }
1383     if ($myconfig->{dateformat} =~ /^dd/) {
1384       ($dd, $mm, $yy) = split /\D/, $date;
1385     }
1386
1387     $dd *= 1;
1388     $mm *= 1;
1389     $yy = ($yy < 70) ? $yy + 2000 : $yy;
1390     $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
1391
1392     $dd = "0$dd" if ($dd < 10);
1393     $mm = "0$mm" if ($mm < 10);
1394
1395     $date = "$yy$mm$dd";
1396   }
1397
1398   $main::lxdebug->leave_sub();
1399
1400   return $date;
1401 }
1402
1403 # Database routines used throughout
1404
1405 sub _dbconnect_options {
1406   my $self    = shift;
1407   my $options = { pg_enable_utf8 => $::locale->is_utf8,
1408                   @_ };
1409
1410   return $options;
1411 }
1412
1413 sub dbconnect {
1414   $main::lxdebug->enter_sub(2);
1415
1416   my ($self, $myconfig) = @_;
1417
1418   # connect to database
1419   my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
1420     or $self->dberror;
1421
1422   # set db options
1423   if ($myconfig->{dboptions}) {
1424     $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
1425   }
1426
1427   $main::lxdebug->leave_sub(2);
1428
1429   return $dbh;
1430 }
1431
1432 sub dbconnect_noauto {
1433   $main::lxdebug->enter_sub();
1434
1435   my ($self, $myconfig) = @_;
1436
1437   # connect to database
1438   my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
1439     or $self->dberror;
1440
1441   # set db options
1442   if ($myconfig->{dboptions}) {
1443     $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
1444   }
1445
1446   $main::lxdebug->leave_sub();
1447
1448   return $dbh;
1449 }
1450
1451 sub get_standard_dbh {
1452   $main::lxdebug->enter_sub(2);
1453
1454   my $self     = shift;
1455   my $myconfig = shift || \%::myconfig;
1456
1457   if ($standard_dbh && !$standard_dbh->{Active}) {
1458     $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
1459     undef $standard_dbh;
1460   }
1461
1462   $standard_dbh ||= $self->dbconnect_noauto($myconfig);
1463
1464   $main::lxdebug->leave_sub(2);
1465
1466   return $standard_dbh;
1467 }
1468
1469 sub date_closed {
1470   $main::lxdebug->enter_sub();
1471
1472   my ($self, $date, $myconfig) = @_;
1473   my $dbh = $self->dbconnect($myconfig);
1474
1475   my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
1476   my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
1477
1478   # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
1479   # es ist sicher ein conv_date vorher IMMER auszuführen.
1480   # Testfälle ohne definiertes closedto:
1481   #   Leere Datumseingabe i.O.
1482   #     SELECT 1 FROM defaults WHERE '' < closedto
1483   #   normale Zahlungsbuchung über Rechnungsmaske i.O.
1484   #     SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
1485   # Testfälle mit definiertem closedto (30.04.2011):
1486   #  Leere Datumseingabe i.O.
1487   #   SELECT 1 FROM defaults WHERE '' < closedto
1488   # normale Buchung im geschloßenem Zeitraum i.O.
1489   #   SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
1490   #     Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
1491   # normale Buchung in aktiver Buchungsperiode i.O.
1492   #   SELECT 1 FROM defaults WHERE '01.05.2011' < closedto
1493
1494   my ($closed) = $sth->fetchrow_array;
1495
1496   $main::lxdebug->leave_sub();
1497
1498   return $closed;
1499 }
1500
1501 sub update_balance {
1502   $main::lxdebug->enter_sub();
1503
1504   my ($self, $dbh, $table, $field, $where, $value, @values) = @_;
1505
1506   # if we have a value, go do it
1507   if ($value != 0) {
1508
1509     # retrieve balance from table
1510     my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
1511     my $sth = prepare_execute_query($self, $dbh, $query, @values);
1512     my ($balance) = $sth->fetchrow_array;
1513     $sth->finish;
1514
1515     $balance += $value;
1516
1517     # update balance
1518     $query = "UPDATE $table SET $field = $balance WHERE $where";
1519     do_query($self, $dbh, $query, @values);
1520   }
1521   $main::lxdebug->leave_sub();
1522 }
1523
1524 sub update_exchangerate {
1525   $main::lxdebug->enter_sub();
1526
1527   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
1528   my ($query);
1529   # some sanity check for currency
1530   if ($curr eq '') {
1531     $main::lxdebug->leave_sub();
1532     return;
1533   }
1534   $query = qq|SELECT curr FROM defaults|;
1535
1536   my ($currency) = selectrow_query($self, $dbh, $query);
1537   my ($defaultcurrency) = split m/:/, $currency;
1538
1539
1540   if ($curr eq $defaultcurrency) {
1541     $main::lxdebug->leave_sub();
1542     return;
1543   }
1544
1545   $query = qq|SELECT e.curr FROM exchangerate e
1546                  WHERE e.curr = ? AND e.transdate = ?
1547                  FOR UPDATE|;
1548   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
1549
1550   if ($buy == 0) {
1551     $buy = "";
1552   }
1553   if ($sell == 0) {
1554     $sell = "";
1555   }
1556
1557   $buy = conv_i($buy, "NULL");
1558   $sell = conv_i($sell, "NULL");
1559
1560   my $set;
1561   if ($buy != 0 && $sell != 0) {
1562     $set = "buy = $buy, sell = $sell";
1563   } elsif ($buy != 0) {
1564     $set = "buy = $buy";
1565   } elsif ($sell != 0) {
1566     $set = "sell = $sell";
1567   }
1568
1569   if ($sth->fetchrow_array) {
1570     $query = qq|UPDATE exchangerate
1571                 SET $set
1572                 WHERE curr = ?
1573                 AND transdate = ?|;
1574
1575   } else {
1576     $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
1577                 VALUES (?, $buy, $sell, ?)|;
1578   }
1579   $sth->finish;
1580   do_query($self, $dbh, $query, $curr, $transdate);
1581
1582   $main::lxdebug->leave_sub();
1583 }
1584
1585 sub save_exchangerate {
1586   $main::lxdebug->enter_sub();
1587
1588   my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
1589
1590   my $dbh = $self->dbconnect($myconfig);
1591
1592   my ($buy, $sell);
1593
1594   $buy  = $rate if $fld eq 'buy';
1595   $sell = $rate if $fld eq 'sell';
1596
1597
1598   $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
1599
1600
1601   $dbh->disconnect;
1602
1603   $main::lxdebug->leave_sub();
1604 }
1605
1606 sub get_exchangerate {
1607   $main::lxdebug->enter_sub();
1608
1609   my ($self, $dbh, $curr, $transdate, $fld) = @_;
1610   my ($query);
1611
1612   unless ($transdate) {
1613     $main::lxdebug->leave_sub();
1614     return 1;
1615   }
1616
1617   $query = qq|SELECT curr FROM defaults|;
1618
1619   my ($currency) = selectrow_query($self, $dbh, $query);
1620   my ($defaultcurrency) = split m/:/, $currency;
1621
1622   if ($currency eq $defaultcurrency) {
1623     $main::lxdebug->leave_sub();
1624     return 1;
1625   }
1626
1627   $query = qq|SELECT e.$fld FROM exchangerate e
1628                  WHERE e.curr = ? AND e.transdate = ?|;
1629   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
1630
1631
1632
1633   $main::lxdebug->leave_sub();
1634
1635   return $exchangerate;
1636 }
1637
1638 sub check_exchangerate {
1639   $main::lxdebug->enter_sub();
1640
1641   my ($self, $myconfig, $currency, $transdate, $fld) = @_;
1642
1643   if ($fld !~/^buy|sell$/) {
1644     $self->error('Fatal: check_exchangerate called with invalid buy/sell argument');
1645   }
1646
1647   unless ($transdate) {
1648     $main::lxdebug->leave_sub();
1649     return "";
1650   }
1651
1652   my ($defaultcurrency) = $self->get_default_currency($myconfig);
1653
1654   if ($currency eq $defaultcurrency) {
1655     $main::lxdebug->leave_sub();
1656     return 1;
1657   }
1658
1659   my $dbh   = $self->get_standard_dbh($myconfig);
1660   my $query = qq|SELECT e.$fld FROM exchangerate e
1661                  WHERE e.curr = ? AND e.transdate = ?|;
1662
1663   my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
1664
1665   $main::lxdebug->leave_sub();
1666
1667   return $exchangerate;
1668 }
1669
1670 sub get_all_currencies {
1671   $main::lxdebug->enter_sub();
1672
1673   my $self     = shift;
1674   my $myconfig = shift || \%::myconfig;
1675   my $dbh      = $self->get_standard_dbh($myconfig);
1676
1677   my $query = qq|SELECT curr FROM defaults|;
1678
1679   my ($curr)     = selectrow_query($self, $dbh, $query);
1680   my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr;
1681
1682   $main::lxdebug->leave_sub();
1683
1684   return @currencies;
1685 }
1686
1687 sub get_default_currency {
1688   $main::lxdebug->enter_sub();
1689
1690   my ($self, $myconfig) = @_;
1691   my @currencies        = $self->get_all_currencies($myconfig);
1692
1693   $main::lxdebug->leave_sub();
1694
1695   return $currencies[0];
1696 }
1697
1698 sub set_payment_options {
1699   $main::lxdebug->enter_sub();
1700
1701   my ($self, $myconfig, $transdate) = @_;
1702
1703   return $main::lxdebug->leave_sub() unless ($self->{payment_id});
1704
1705   my $dbh = $self->get_standard_dbh($myconfig);
1706
1707   my $query =
1708     qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | .
1709     qq|FROM payment_terms p | .
1710     qq|WHERE p.id = ?|;
1711
1712   ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
1713    $self->{payment_terms}, $self->{payment_description}) =
1714      selectrow_query($self, $dbh, $query, $self->{payment_id});
1715
1716   if ($transdate eq "") {
1717     if ($self->{invdate}) {
1718       $transdate = $self->{invdate};
1719     } else {
1720       $transdate = $self->{transdate};
1721     }
1722   }
1723
1724   $query =
1725     qq|SELECT ?::date + ?::integer AS netto_date, ?::date + ?::integer AS skonto_date | .
1726     qq|FROM payment_terms|;
1727   ($self->{netto_date}, $self->{skonto_date}) =
1728     selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});
1729
1730   my ($invtotal, $total);
1731   my (%amounts, %formatted_amounts);
1732
1733   if ($self->{type} =~ /_order$/) {
1734     $amounts{invtotal} = $self->{ordtotal};
1735     $amounts{total}    = $self->{ordtotal};
1736
1737   } elsif ($self->{type} =~ /_quotation$/) {
1738     $amounts{invtotal} = $self->{quototal};
1739     $amounts{total}    = $self->{quototal};
1740
1741   } else {
1742     $amounts{invtotal} = $self->{invtotal};
1743     $amounts{total}    = $self->{total};
1744   }
1745   $amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
1746
1747   map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
1748
1749   $amounts{skonto_amount}      = $amounts{invtotal} * $self->{percent_skonto};
1750   $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
1751   $amounts{total_wo_skonto}    = $amounts{total}    * (1 - $self->{percent_skonto});
1752
1753   foreach (keys %amounts) {
1754     $amounts{$_}           = $self->round_amount($amounts{$_}, 2);
1755     $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
1756   }
1757
1758   if ($self->{"language_id"}) {
1759     $query =
1760       qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | .
1761       qq|FROM generic_translations t | .
1762       qq|LEFT JOIN language l ON t.language_id = l.id | .
1763       qq|WHERE (t.language_id = ?)
1764            AND (t.translation_id = ?)
1765            AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|;
1766     my ($description_long, $output_numberformat, $output_dateformat,
1767       $output_longdates) =
1768       selectrow_query($self, $dbh, $query,
1769                       $self->{"language_id"}, $self->{"payment_id"});
1770
1771     $self->{payment_terms} = $description_long if ($description_long);
1772
1773     if ($output_dateformat) {
1774       foreach my $key (qw(netto_date skonto_date)) {
1775         $self->{$key} =
1776           $main::locale->reformat_date($myconfig, $self->{$key},
1777                                        $output_dateformat,
1778                                        $output_longdates);
1779       }
1780     }
1781
1782     if ($output_numberformat &&
1783         ($output_numberformat ne $myconfig->{"numberformat"})) {
1784       my $saved_numberformat = $myconfig->{"numberformat"};
1785       $myconfig->{"numberformat"} = $output_numberformat;
1786       map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts;
1787       $myconfig->{"numberformat"} = $saved_numberformat;
1788     }
1789   }
1790
1791   $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
1792   $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
1793   $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
1794   $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
1795   $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
1796   $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
1797   $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
1798
1799   map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
1800
1801   $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
1802
1803   $main::lxdebug->leave_sub();
1804
1805 }
1806
1807 sub get_template_language {
1808   $main::lxdebug->enter_sub();
1809
1810   my ($self, $myconfig) = @_;
1811
1812   my $template_code = "";
1813
1814   if ($self->{language_id}) {
1815     my $dbh = $self->get_standard_dbh($myconfig);
1816     my $query = qq|SELECT template_code FROM language WHERE id = ?|;
1817     ($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id});
1818   }
1819
1820   $main::lxdebug->leave_sub();
1821
1822   return $template_code;
1823 }
1824
1825 sub get_printer_code {
1826   $main::lxdebug->enter_sub();
1827
1828   my ($self, $myconfig) = @_;
1829
1830   my $template_code = "";
1831
1832   if ($self->{printer_id}) {
1833     my $dbh = $self->get_standard_dbh($myconfig);
1834     my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|;
1835     ($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id});
1836   }
1837
1838   $main::lxdebug->leave_sub();
1839
1840   return $template_code;
1841 }
1842
1843 sub get_shipto {
1844   $main::lxdebug->enter_sub();
1845
1846   my ($self, $myconfig) = @_;
1847
1848   my $template_code = "";
1849
1850   if ($self->{shipto_id}) {
1851     my $dbh = $self->get_standard_dbh($myconfig);
1852     my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
1853     my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id});
1854     map({ $self->{$_} = $ref->{$_} } keys(%$ref));
1855   }
1856
1857   $main::lxdebug->leave_sub();
1858 }
1859
1860 sub add_shipto {
1861   $main::lxdebug->enter_sub();
1862
1863   my ($self, $dbh, $id, $module) = @_;
1864
1865   my $shipto;
1866   my @values;
1867
1868   foreach my $item (qw(name department_1 department_2 street zipcode city country
1869                        contact cp_gender phone fax email)) {
1870     if ($self->{"shipto$item"}) {
1871       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
1872     }
1873     push(@values, $self->{"shipto${item}"});
1874   }
1875
1876   if ($shipto) {
1877     if ($self->{shipto_id}) {
1878       my $query = qq|UPDATE shipto set
1879                        shiptoname = ?,
1880                        shiptodepartment_1 = ?,
1881                        shiptodepartment_2 = ?,
1882                        shiptostreet = ?,
1883                        shiptozipcode = ?,
1884                        shiptocity = ?,
1885                        shiptocountry = ?,
1886                        shiptocontact = ?,
1887                        shiptocp_gender = ?,
1888                        shiptophone = ?,
1889                        shiptofax = ?,
1890                        shiptoemail = ?
1891                      WHERE shipto_id = ?|;
1892       do_query($self, $dbh, $query, @values, $self->{shipto_id});
1893     } else {
1894       my $query = qq|SELECT * FROM shipto
1895                      WHERE shiptoname = ? AND
1896                        shiptodepartment_1 = ? AND
1897                        shiptodepartment_2 = ? AND
1898                        shiptostreet = ? AND
1899                        shiptozipcode = ? AND
1900                        shiptocity = ? AND
1901                        shiptocountry = ? AND
1902                        shiptocontact = ? AND
1903                        shiptocp_gender = ? AND
1904                        shiptophone = ? AND
1905                        shiptofax = ? AND
1906                        shiptoemail = ? AND
1907                        module = ? AND
1908                        trans_id = ?|;
1909       my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
1910       if(!$insert_check){
1911         $query =
1912           qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
1913                                  shiptostreet, shiptozipcode, shiptocity, shiptocountry,
1914                                  shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
1915              VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
1916         do_query($self, $dbh, $query, $id, @values, $module);
1917       }
1918     }
1919   }
1920
1921   $main::lxdebug->leave_sub();
1922 }
1923
1924 sub get_employee {
1925   $main::lxdebug->enter_sub();
1926
1927   my ($self, $dbh) = @_;
1928
1929   $dbh ||= $self->get_standard_dbh(\%main::myconfig);
1930
1931   my $query = qq|SELECT id, name FROM employee WHERE login = ?|;
1932   ($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login});
1933   $self->{"employee_id"} *= 1;
1934
1935   $main::lxdebug->leave_sub();
1936 }
1937
1938 sub get_employee_data {
1939   $main::lxdebug->enter_sub();
1940
1941   my $self     = shift;
1942   my %params   = @_;
1943
1944   Common::check_params(\%params, qw(prefix));
1945   Common::check_params_x(\%params, qw(id));
1946
1947   if (!$params{id}) {
1948     $main::lxdebug->leave_sub();
1949     return;
1950   }
1951
1952   my $myconfig = \%main::myconfig;
1953   my $dbh      = $params{dbh} || $self->get_standard_dbh($myconfig);
1954
1955   my ($login)  = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
1956
1957   if ($login) {
1958     my $user = User->new($login);
1959     map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
1960
1961     $self->{$params{prefix} . '_login'}   = $login;
1962     $self->{$params{prefix} . '_name'}  ||= $login;
1963   }
1964
1965   $main::lxdebug->leave_sub();
1966 }
1967
1968 sub get_duedate {
1969   $main::lxdebug->enter_sub();
1970
1971   my ($self, $myconfig, $reference_date) = @_;
1972
1973   $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date';
1974
1975   my $dbh         = $self->get_standard_dbh($myconfig);
1976   my $query       = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|;
1977   my ($duedate)   = selectrow_query($self, $dbh, $query, $self->{payment_id});
1978
1979   $main::lxdebug->leave_sub();
1980
1981   return $duedate;
1982 }
1983
1984 sub _get_contacts {
1985   $main::lxdebug->enter_sub();
1986
1987   my ($self, $dbh, $id, $key) = @_;
1988
1989   $key = "all_contacts" unless ($key);
1990
1991   if (!$id) {
1992     $self->{$key} = [];
1993     $main::lxdebug->leave_sub();
1994     return;
1995   }
1996
1997   my $query =
1998     qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
1999     qq|FROM contacts | .
2000     qq|WHERE cp_cv_id = ? | .
2001     qq|ORDER BY lower(cp_name)|;
2002
2003   $self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);
2004
2005   $main::lxdebug->leave_sub();
2006 }
2007
2008 sub _get_projects {
2009   $main::lxdebug->enter_sub();
2010
2011   my ($self, $dbh, $key) = @_;
2012
2013   my ($all, $old_id, $where, @values);
2014
2015   if (ref($key) eq "HASH") {
2016     my $params = $key;
2017
2018     $key = "ALL_PROJECTS";
2019
2020     foreach my $p (keys(%{$params})) {
2021       if ($p eq "all") {
2022         $all = $params->{$p};
2023       } elsif ($p eq "old_id") {
2024         $old_id = $params->{$p};
2025       } elsif ($p eq "key") {
2026         $key = $params->{$p};
2027       }
2028     }
2029   }
2030
2031   if (!$all) {
2032     $where = "WHERE active ";
2033     if ($old_id) {
2034       if (ref($old_id) eq "ARRAY") {
2035         my @ids = grep({ $_ } @{$old_id});
2036         if (@ids) {
2037           $where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
2038           push(@values, @ids);
2039         }
2040       } else {
2041         $where .= " OR (id = ?) ";
2042         push(@values, $old_id);
2043       }
2044     }
2045   }
2046
2047   my $query =
2048     qq|SELECT id, projectnumber, description, active | .
2049     qq|FROM project | .
2050     $where .
2051     qq|ORDER BY lower(projectnumber)|;
2052
2053   $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
2054
2055   $main::lxdebug->leave_sub();
2056 }
2057
2058 sub _get_shipto {
2059   $main::lxdebug->enter_sub();
2060
2061   my ($self, $dbh, $vc_id, $key) = @_;
2062
2063   $key = "all_shipto" unless ($key);
2064
2065   if ($vc_id) {
2066     # get shipping addresses
2067     my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
2068
2069     $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
2070
2071   } else {
2072     $self->{$key} = [];
2073   }
2074
2075   $main::lxdebug->leave_sub();
2076 }
2077
2078 sub _get_printers {
2079   $main::lxdebug->enter_sub();
2080
2081   my ($self, $dbh, $key) = @_;
2082
2083   $key = "all_printers" unless ($key);
2084
2085   my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;
2086
2087   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2088
2089   $main::lxdebug->leave_sub();
2090 }
2091
2092 sub _get_charts {
2093   $main::lxdebug->enter_sub();
2094
2095   my ($self, $dbh, $params) = @_;
2096   my ($key);
2097
2098   $key = $params->{key};
2099   $key = "all_charts" unless ($key);
2100
2101   my $transdate = quote_db_date($params->{transdate});
2102
2103   my $query =
2104     qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
2105     qq|FROM chart c | .
2106     qq|LEFT JOIN taxkeys tk ON | .
2107     qq|(tk.id = (SELECT id FROM taxkeys | .
2108     qq|          WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
2109     qq|          ORDER BY startdate DESC LIMIT 1)) | .
2110     qq|ORDER BY c.accno|;
2111
2112   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2113
2114   $main::lxdebug->leave_sub();
2115 }
2116
2117 sub _get_taxcharts {
2118   $main::lxdebug->enter_sub();
2119
2120   my ($self, $dbh, $params) = @_;
2121
2122   my $key = "all_taxcharts";
2123   my @where;
2124
2125   if (ref $params eq 'HASH') {
2126     $key = $params->{key} if ($params->{key});
2127     if ($params->{module} eq 'AR') {
2128       push @where, 'taxkey NOT IN (8, 9, 18, 19)';
2129
2130     } elsif ($params->{module} eq 'AP') {
2131       push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)';
2132     }
2133
2134   } elsif ($params) {
2135     $key = $params;
2136   }
2137
2138   my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
2139
2140   my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
2141
2142   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2143
2144   $main::lxdebug->leave_sub();
2145 }
2146
2147 sub _get_taxzones {
2148   $main::lxdebug->enter_sub();
2149
2150   my ($self, $dbh, $key) = @_;
2151
2152   $key = "all_taxzones" unless ($key);
2153
2154   my $query = qq|SELECT * FROM tax_zones ORDER BY id|;
2155
2156   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2157
2158   $main::lxdebug->leave_sub();
2159 }
2160
2161 sub _get_employees {
2162   $main::lxdebug->enter_sub();
2163
2164   my ($self, $dbh, $default_key, $key) = @_;
2165
2166   $key = $default_key unless ($key);
2167   $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|);
2168
2169   $main::lxdebug->leave_sub();
2170 }
2171
2172 sub _get_business_types {
2173   $main::lxdebug->enter_sub();
2174
2175   my ($self, $dbh, $key) = @_;
2176
2177   my $options       = ref $key eq 'HASH' ? $key : { key => $key };
2178   $options->{key} ||= "all_business_types";
2179   my $where         = '';
2180
2181   if (exists $options->{salesman}) {
2182     $where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
2183   }
2184
2185   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
2186
2187   $main::lxdebug->leave_sub();
2188 }
2189
2190 sub _get_languages {
2191   $main::lxdebug->enter_sub();
2192
2193   my ($self, $dbh, $key) = @_;
2194
2195   $key = "all_languages" unless ($key);
2196
2197   my $query = qq|SELECT * FROM language ORDER BY id|;
2198
2199   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2200
2201   $main::lxdebug->leave_sub();
2202 }
2203
2204 sub _get_dunning_configs {
2205   $main::lxdebug->enter_sub();
2206
2207   my ($self, $dbh, $key) = @_;
2208
2209   $key = "all_dunning_configs" unless ($key);
2210
2211   my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;
2212
2213   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2214
2215   $main::lxdebug->leave_sub();
2216 }
2217
2218 sub _get_currencies {
2219 $main::lxdebug->enter_sub();
2220
2221   my ($self, $dbh, $key) = @_;
2222
2223   $key = "all_currencies" unless ($key);
2224
2225   my $query = qq|SELECT curr AS currency FROM defaults|;
2226
2227   $self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})];
2228
2229   $main::lxdebug->leave_sub();
2230 }
2231
2232 sub _get_payments {
2233 $main::lxdebug->enter_sub();
2234
2235   my ($self, $dbh, $key) = @_;
2236
2237   $key = "all_payments" unless ($key);
2238
2239   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
2240
2241   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2242
2243   $main::lxdebug->leave_sub();
2244 }
2245
2246 sub _get_customers {
2247   $main::lxdebug->enter_sub();
2248
2249   my ($self, $dbh, $key) = @_;
2250
2251   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
2252   $options->{key}  ||= "all_customers";
2253   my $limit_clause   = $options->{limit} ? "LIMIT $options->{limit}" : '';
2254
2255   my @where;
2256   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
2257   push @where, qq|NOT obsolete|                                            if !$options->{with_obsolete};
2258   my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';
2259
2260   my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
2261   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
2262
2263   $main::lxdebug->leave_sub();
2264 }
2265
2266 sub _get_vendors {
2267   $main::lxdebug->enter_sub();
2268
2269   my ($self, $dbh, $key) = @_;
2270
2271   $key = "all_vendors" unless ($key);
2272
2273   my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;
2274
2275   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2276
2277   $main::lxdebug->leave_sub();
2278 }
2279
2280 sub _get_departments {
2281   $main::lxdebug->enter_sub();
2282
2283   my ($self, $dbh, $key) = @_;
2284
2285   $key = "all_departments" unless ($key);
2286
2287   my $query = qq|SELECT * FROM department ORDER BY description|;
2288
2289   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2290
2291   $main::lxdebug->leave_sub();
2292 }
2293
2294 sub _get_warehouses {
2295   $main::lxdebug->enter_sub();
2296
2297   my ($self, $dbh, $param) = @_;
2298
2299   my ($key, $bins_key);
2300
2301   if ('' eq ref $param) {
2302     $key = $param;
2303
2304   } else {
2305     $key      = $param->{key};
2306     $bins_key = $param->{bins};
2307   }
2308
2309   my $query = qq|SELECT w.* FROM warehouse w
2310                  WHERE (NOT w.invalid) AND
2311                    ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
2312                  ORDER BY w.sortkey|;
2313
2314   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2315
2316   if ($bins_key) {
2317     $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
2318                 ORDER BY description|;
2319     my $sth = prepare_query($self, $dbh, $query);
2320
2321     foreach my $warehouse (@{ $self->{$key} }) {
2322       do_statement($self, $sth, $query, $warehouse->{id});
2323       $warehouse->{$bins_key} = [];
2324
2325       while (my $ref = $sth->fetchrow_hashref()) {
2326         push @{ $warehouse->{$bins_key} }, $ref;
2327       }
2328     }
2329     $sth->finish();
2330   }
2331
2332   $main::lxdebug->leave_sub();
2333 }
2334
2335 sub _get_simple {
2336   $main::lxdebug->enter_sub();
2337
2338   my ($self, $dbh, $table, $key, $sortkey) = @_;
2339
2340   my $query  = qq|SELECT * FROM $table|;
2341   $query    .= qq| ORDER BY $sortkey| if ($sortkey);
2342
2343   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2344
2345   $main::lxdebug->leave_sub();
2346 }
2347
2348 #sub _get_groups {
2349 #  $main::lxdebug->enter_sub();
2350 #
2351 #  my ($self, $dbh, $key) = @_;
2352 #
2353 #  $key ||= "all_groups";
2354 #
2355 #  my $groups = $main::auth->read_groups();
2356 #
2357 #  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2358 #
2359 #  $main::lxdebug->leave_sub();
2360 #}
2361
2362 sub get_lists {
2363   $main::lxdebug->enter_sub();
2364
2365   my $self = shift;
2366   my %params = @_;
2367
2368   my $dbh = $self->get_standard_dbh(\%main::myconfig);
2369   my ($sth, $query, $ref);
2370
2371   my $vc = $self->{"vc"} eq "customer" ? "customer" : "vendor";
2372   my $vc_id = $self->{"${vc}_id"};
2373
2374   if ($params{"contacts"}) {
2375     $self->_get_contacts($dbh, $vc_id, $params{"contacts"});
2376   }
2377
2378   if ($params{"shipto"}) {
2379     $self->_get_shipto($dbh, $vc_id, $params{"shipto"});
2380   }
2381
2382   if ($params{"projects"} || $params{"all_projects"}) {
2383     $self->_get_projects($dbh, $params{"all_projects"} ?
2384                          $params{"all_projects"} : $params{"projects"},
2385                          $params{"all_projects"} ? 1 : 0);
2386   }
2387
2388   if ($params{"printers"}) {
2389     $self->_get_printers($dbh, $params{"printers"});
2390   }
2391
2392   if ($params{"languages"}) {
2393     $self->_get_languages($dbh, $params{"languages"});
2394   }
2395
2396   if ($params{"charts"}) {
2397     $self->_get_charts($dbh, $params{"charts"});
2398   }
2399
2400   if ($params{"taxcharts"}) {
2401     $self->_get_taxcharts($dbh, $params{"taxcharts"});
2402   }
2403
2404   if ($params{"taxzones"}) {
2405     $self->_get_taxzones($dbh, $params{"taxzones"});
2406   }
2407
2408   if ($params{"employees"}) {
2409     $self->_get_employees($dbh, "all_employees", $params{"employees"});
2410   }
2411
2412   if ($params{"salesmen"}) {
2413     $self->_get_employees($dbh, "all_salesmen", $params{"salesmen"});
2414   }
2415
2416   if ($params{"business_types"}) {
2417     $self->_get_business_types($dbh, $params{"business_types"});
2418   }
2419
2420   if ($params{"dunning_configs"}) {
2421     $self->_get_dunning_configs($dbh, $params{"dunning_configs"});
2422   }
2423
2424   if($params{"currencies"}) {
2425     $self->_get_currencies($dbh, $params{"currencies"});
2426   }
2427
2428   if($params{"customers"}) {
2429     $self->_get_customers($dbh, $params{"customers"});
2430   }
2431
2432   if($params{"vendors"}) {
2433     if (ref $params{"vendors"} eq 'HASH') {
2434       $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
2435     } else {
2436       $self->_get_vendors($dbh, $params{"vendors"});
2437     }
2438   }
2439
2440   if($params{"payments"}) {
2441     $self->_get_payments($dbh, $params{"payments"});
2442   }
2443
2444   if($params{"departments"}) {
2445     $self->_get_departments($dbh, $params{"departments"});
2446   }
2447
2448   if ($params{price_factors}) {
2449     $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
2450   }
2451
2452   if ($params{warehouses}) {
2453     $self->_get_warehouses($dbh, $params{warehouses});
2454   }
2455
2456 #  if ($params{groups}) {
2457 #    $self->_get_groups($dbh, $params{groups});
2458 #  }
2459
2460   if ($params{partsgroup}) {
2461     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
2462   }
2463
2464   $main::lxdebug->leave_sub();
2465 }
2466
2467 # this sub gets the id and name from $table
2468 sub get_name {
2469   $main::lxdebug->enter_sub();
2470
2471   my ($self, $myconfig, $table) = @_;
2472
2473   # connect to database
2474   my $dbh = $self->get_standard_dbh($myconfig);
2475
2476   $table = $table eq "customer" ? "customer" : "vendor";
2477   my $arap = $self->{arap} eq "ar" ? "ar" : "ap";
2478
2479   my ($query, @values);
2480
2481   if (!$self->{openinvoices}) {
2482     my $where;
2483     if ($self->{customernumber} ne "") {
2484       $where = qq|(vc.customernumber ILIKE ?)|;
2485       push(@values, '%' . $self->{customernumber} . '%');
2486     } else {
2487       $where = qq|(vc.name ILIKE ?)|;
2488       push(@values, '%' . $self->{$table} . '%');
2489     }
2490
2491     $query =
2492       qq~SELECT vc.id, vc.name,
2493            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2494          FROM $table vc
2495          WHERE $where AND (NOT vc.obsolete)
2496          ORDER BY vc.name~;
2497   } else {
2498     $query =
2499       qq~SELECT DISTINCT vc.id, vc.name,
2500            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2501          FROM $arap a
2502          JOIN $table vc ON (a.${table}_id = vc.id)
2503          WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
2504          ORDER BY vc.name~;
2505     push(@values, '%' . $self->{$table} . '%');
2506   }
2507
2508   $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
2509
2510   $main::lxdebug->leave_sub();
2511
2512   return scalar(@{ $self->{name_list} });
2513 }
2514
2515 # the selection sub is used in the AR, AP, IS, IR and OE module
2516 #
2517 sub all_vc {
2518   $main::lxdebug->enter_sub();
2519
2520   my ($self, $myconfig, $table, $module) = @_;
2521
2522   my $ref;
2523   my $dbh = $self->get_standard_dbh;
2524
2525   $table = $table eq "customer" ? "customer" : "vendor";
2526
2527   my $query = qq|SELECT count(*) FROM $table WHERE NOT obsolete|;
2528   my ($count) = selectrow_query($self, $dbh, $query);
2529
2530   # build selection list
2531   if ($count <= $myconfig->{vclimit}) {
2532     $query = qq|SELECT id, name, salesman_id
2533                 FROM $table WHERE NOT obsolete
2534                 ORDER BY name|;
2535     $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
2536   }
2537
2538   # get self
2539   $self->get_employee($dbh);
2540
2541   # setup sales contacts
2542   $query = qq|SELECT e.id, e.name
2543               FROM employee e
2544               WHERE (e.sales = '1') AND (NOT e.id = ?)|;
2545   $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
2546
2547   # this is for self
2548   push(@{ $self->{all_employees} },
2549        { id   => $self->{employee_id},
2550          name => $self->{employee} });
2551
2552   # sort the whole thing
2553   @{ $self->{all_employees} } =
2554     sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };
2555
2556
2557     # prepare query for departments
2558     $query = qq|SELECT id, description
2559                 FROM department
2560                 ORDER BY description|;
2561
2562   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2563
2564   # get languages
2565   $query = qq|SELECT id, description
2566               FROM language
2567               ORDER BY id|;
2568
2569   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2570
2571   # get printer
2572   $query = qq|SELECT printer_description, id
2573               FROM printers
2574               ORDER BY printer_description|;
2575
2576   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2577
2578   # get payment terms
2579   $query = qq|SELECT id, description
2580               FROM payment_terms
2581               ORDER BY sortkey|;
2582
2583   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
2584
2585   $main::lxdebug->leave_sub();
2586 }
2587
2588 sub language_payment {
2589   $main::lxdebug->enter_sub();
2590
2591   my ($self, $myconfig) = @_;
2592
2593   my $dbh = $self->get_standard_dbh($myconfig);
2594   # get languages
2595   my $query = qq|SELECT id, description
2596                  FROM language
2597                  ORDER BY id|;
2598
2599   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2600
2601   # get printer
2602   $query = qq|SELECT printer_description, id
2603               FROM printers
2604               ORDER BY printer_description|;
2605
2606   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2607
2608   # get payment terms
2609   $query = qq|SELECT id, description
2610               FROM payment_terms
2611               ORDER BY sortkey|;
2612
2613   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
2614
2615   # get buchungsgruppen
2616   $query = qq|SELECT id, description
2617               FROM buchungsgruppen|;
2618
2619   $self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);
2620
2621   $main::lxdebug->leave_sub();
2622 }
2623
2624 # this is only used for reports
2625 sub all_departments {
2626   $main::lxdebug->enter_sub();
2627
2628   my ($self, $myconfig, $table) = @_;
2629
2630   my $dbh = $self->get_standard_dbh($myconfig);
2631
2632   my $query = qq|SELECT id, description
2633                  FROM department
2634                  ORDER BY description|;
2635   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2636
2637   delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });
2638
2639   $main::lxdebug->leave_sub();
2640 }
2641
2642 sub create_links {
2643   $main::lxdebug->enter_sub();
2644
2645   my ($self, $module, $myconfig, $table, $provided_dbh) = @_;
2646
2647   my ($fld, $arap);
2648   if ($table eq "customer") {
2649     $fld = "buy";
2650     $arap = "ar";
2651   } else {
2652     $table = "vendor";
2653     $fld = "sell";
2654     $arap = "ap";
2655   }
2656
2657   $self->all_vc($myconfig, $table, $module);
2658
2659   # get last customers or vendors
2660   my ($query, $sth, $ref);
2661
2662   my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
2663   my %xkeyref = ();
2664
2665   if (!$self->{id}) {
2666
2667     my $transdate = "current_date";
2668     if ($self->{transdate}) {
2669       $transdate = $dbh->quote($self->{transdate});
2670     }
2671
2672     # now get the account numbers
2673 #    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
2674 #                FROM chart c, taxkeys tk
2675 #                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
2676 #                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
2677 #                ORDER BY c.accno|;
2678
2679 #  same query as above, but without expensive subquery for each row. about 80% faster
2680     $query = qq|
2681       SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id
2682         FROM chart c
2683         -- find newest entries in taxkeys
2684         INNER JOIN (
2685           SELECT chart_id, MAX(startdate) AS startdate
2686           FROM taxkeys
2687           WHERE (startdate <= $transdate)
2688           GROUP BY chart_id
2689         ) tk ON (c.id = tk.chart_id)
2690         -- and load all of those entries
2691         INNER JOIN taxkeys tk2
2692            ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
2693        WHERE (c.link LIKE ?)
2694       ORDER BY c.accno|;
2695
2696     $sth = $dbh->prepare($query);
2697
2698     do_statement($self, $sth, $query, '%' . $module . '%');
2699
2700     $self->{accounts} = "";
2701     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2702
2703       foreach my $key (split(/:/, $ref->{link})) {
2704         if ($key =~ /\Q$module\E/) {
2705
2706           # cross reference for keys
2707           $xkeyref{ $ref->{accno} } = $key;
2708
2709           push @{ $self->{"${module}_links"}{$key} },
2710             { accno       => $ref->{accno},
2711               description => $ref->{description},
2712               taxkey      => $ref->{taxkey_id},
2713               tax_id      => $ref->{tax_id} };
2714
2715           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2716         }
2717       }
2718     }
2719   }
2720
2721   # get taxkeys and description
2722   $query = qq|SELECT id, taxkey, taxdescription FROM tax|;
2723   $self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);
2724
2725   if (($module eq "AP") || ($module eq "AR")) {
2726     # get tax rates and description
2727     $query = qq|SELECT * FROM tax|;
2728     $self->{TAX} = selectall_hashref_query($self, $dbh, $query);
2729   }
2730
2731   if ($self->{id}) {
2732     $query =
2733       qq|SELECT
2734            a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid,
2735            a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
2736            a.intnotes, a.department_id, a.amount AS oldinvtotal,
2737            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
2738            a.globalproject_id,
2739            c.name AS $table,
2740            d.description AS department,
2741            e.name AS employee
2742          FROM $arap a
2743          JOIN $table c ON (a.${table}_id = c.id)
2744          LEFT JOIN employee e ON (e.id = a.employee_id)
2745          LEFT JOIN department d ON (d.id = a.department_id)
2746          WHERE a.id = ?|;
2747     $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
2748
2749     foreach my $key (keys %$ref) {
2750       $self->{$key} = $ref->{$key};
2751     }
2752
2753     # remove any trailing whitespace
2754     $self->{currency} =~ s/\s*$//;
2755
2756     my $transdate = "current_date";
2757     if ($self->{transdate}) {
2758       $transdate = $dbh->quote($self->{transdate});
2759     }
2760
2761     # now get the account numbers
2762     $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
2763                 FROM chart c
2764                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
2765                 WHERE c.link LIKE ?
2766                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
2767                     OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
2768                 ORDER BY c.accno|;
2769
2770     $sth = $dbh->prepare($query);
2771     do_statement($self, $sth, $query, "%$module%");
2772
2773     $self->{accounts} = "";
2774     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2775
2776       foreach my $key (split(/:/, $ref->{link})) {
2777         if ($key =~ /\Q$module\E/) {
2778
2779           # cross reference for keys
2780           $xkeyref{ $ref->{accno} } = $key;
2781
2782           push @{ $self->{"${module}_links"}{$key} },
2783             { accno       => $ref->{accno},
2784               description => $ref->{description},
2785               taxkey      => $ref->{taxkey_id},
2786               tax_id      => $ref->{tax_id} };
2787
2788           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2789         }
2790       }
2791     }
2792
2793
2794     # get amounts from individual entries
2795     $query =
2796       qq|SELECT
2797            c.accno, c.description,
2798            a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey,
2799            p.projectnumber,
2800            t.rate, t.id
2801          FROM acc_trans a
2802          LEFT JOIN chart c ON (c.id = a.chart_id)
2803          LEFT JOIN project p ON (p.id = a.project_id)
2804          LEFT JOIN tax t ON (t.id= (SELECT tk.tax_id FROM taxkeys tk
2805                                     WHERE (tk.taxkey_id=a.taxkey) AND
2806                                       ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id = a.taxkey)
2807                                         THEN tk.chart_id = a.chart_id
2808                                         ELSE 1 = 1
2809                                         END)
2810                                        OR (c.link='%tax%')) AND
2811                                       (startdate <= a.transdate) ORDER BY startdate DESC LIMIT 1))
2812          WHERE a.trans_id = ?
2813          AND a.fx_transaction = '0'
2814          ORDER BY a.acc_trans_id, a.transdate|;
2815     $sth = $dbh->prepare($query);
2816     do_statement($self, $sth, $query, $self->{id});
2817
2818     # get exchangerate for currency
2819     $self->{exchangerate} =
2820       $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2821     my $index = 0;
2822
2823     # store amounts in {acc_trans}{$key} for multiple accounts
2824     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
2825       $ref->{exchangerate} =
2826         $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
2827       if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
2828         $index++;
2829       }
2830       if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
2831         $ref->{amount} *= -1;
2832       }
2833       $ref->{index} = $index;
2834
2835       push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
2836     }
2837
2838     $sth->finish;
2839     $query =
2840       qq|SELECT
2841            d.curr AS currencies, d.closedto, d.revtrans,
2842            (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2843            (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
2844          FROM defaults d|;
2845     $ref = selectfirst_hashref_query($self, $dbh, $query);
2846     map { $self->{$_} = $ref->{$_} } keys %$ref;
2847
2848   } else {
2849
2850     # get date
2851     $query =
2852        qq|SELECT
2853             current_date AS transdate, d.curr AS currencies, d.closedto, d.revtrans,
2854             (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2855             (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
2856           FROM defaults d|;
2857     $ref = selectfirst_hashref_query($self, $dbh, $query);
2858     map { $self->{$_} = $ref->{$_} } keys %$ref;
2859
2860     if ($self->{"$self->{vc}_id"}) {
2861
2862       # only setup currency
2863       ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency};
2864
2865     } else {
2866
2867       $self->lastname_used($dbh, $myconfig, $table, $module);
2868
2869       # get exchangerate for currency
2870       $self->{exchangerate} =
2871         $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2872
2873     }
2874
2875   }
2876
2877   $main::lxdebug->leave_sub();
2878 }
2879
2880 sub lastname_used {
2881   $main::lxdebug->enter_sub();
2882
2883   my ($self, $dbh, $myconfig, $table, $module) = @_;
2884
2885   my ($arap, $where);
2886
2887   $table         = $table eq "customer" ? "customer" : "vendor";
2888   my %column_map = ("a.curr"                  => "currency",
2889                     "a.${table}_id"           => "${table}_id",
2890                     "a.department_id"         => "department_id",
2891                     "d.description"           => "department",
2892                     "ct.name"                 => $table,
2893                     "ct.curr"                 => "cv_curr",
2894                     "current_date + ct.terms" => "duedate",
2895     );
2896
2897   if ($self->{type} =~ /delivery_order/) {
2898     $arap  = 'delivery_orders';
2899     delete $column_map{"a.curr"};
2900     delete $column_map{"ct.curr"};
2901
2902   } elsif ($self->{type} =~ /_order/) {
2903     $arap  = 'oe';
2904     $where = "quotation = '0'";
2905
2906   } elsif ($self->{type} =~ /_quotation/) {
2907     $arap  = 'oe';
2908     $where = "quotation = '1'";
2909
2910   } elsif ($table eq 'customer') {
2911     $arap  = 'ar';
2912
2913   } else {
2914     $arap  = 'ap';
2915
2916   }
2917
2918   $where           = "($where) AND" if ($where);
2919   my $query        = qq|SELECT MAX(id) FROM $arap
2920                         WHERE $where ${table}_id > 0|;
2921   my ($trans_id)   = selectrow_query($self, $dbh, $query);
2922   $trans_id       *= 1;
2923
2924   my $column_spec  = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
2925   $query           = qq|SELECT $column_spec
2926                         FROM $arap a
2927                         LEFT JOIN $table     ct ON (a.${table}_id = ct.id)
2928                         LEFT JOIN department d  ON (a.department_id = d.id)
2929                         WHERE a.id = ?|;
2930   my $ref          = selectfirst_hashref_query($self, $dbh, $query, $trans_id);
2931
2932   map { $self->{$_} = $ref->{$_} } values %column_map;
2933
2934   # remove any trailing whitespace
2935   $self->{currency} =~ s/\s*$// if $self->{currency};
2936   $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr};
2937
2938   # if customer/vendor currency is set use this
2939   $self->{currency} = $self->{cv_curr} if $self->{cv_curr};
2940
2941   $main::lxdebug->leave_sub();
2942 }
2943
2944 sub current_date {
2945   $main::lxdebug->enter_sub();
2946
2947   my $self     = shift;
2948   my $myconfig = shift || \%::myconfig;
2949   my ($thisdate, $days) = @_;
2950
2951   my $dbh = $self->get_standard_dbh($myconfig);
2952   my $query;
2953
2954   $days *= 1;
2955   if ($thisdate) {
2956     my $dateformat = $myconfig->{dateformat};
2957     $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
2958     $thisdate = $dbh->quote($thisdate);
2959     $query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
2960   } else {
2961     $query = qq|SELECT current_date AS thisdate|;
2962   }
2963
2964   ($thisdate) = selectrow_query($self, $dbh, $query);
2965
2966   $main::lxdebug->leave_sub();
2967
2968   return $thisdate;
2969 }
2970
2971 sub like {
2972   $main::lxdebug->enter_sub();
2973
2974   my ($self, $string) = @_;
2975
2976   if ($string !~ /%/) {
2977     $string = "%$string%";
2978   }
2979
2980   $string =~ s/\'/\'\'/g;
2981
2982   $main::lxdebug->leave_sub();
2983
2984   return $string;
2985 }
2986
2987 sub redo_rows {
2988   $main::lxdebug->enter_sub();
2989
2990   my ($self, $flds, $new, $count, $numrows) = @_;
2991
2992   my @ndx = ();
2993
2994   map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
2995
2996   my $i = 0;
2997
2998   # fill rows
2999   foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
3000     $i++;
3001     my $j = $item->{ndx} - 1;
3002     map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
3003   }
3004
3005   # delete empty rows
3006   for $i ($count + 1 .. $numrows) {
3007     map { delete $self->{"${_}_$i"} } @{$flds};
3008   }
3009
3010   $main::lxdebug->leave_sub();
3011 }
3012
3013 sub update_status {
3014   $main::lxdebug->enter_sub();
3015
3016   my ($self, $myconfig) = @_;
3017
3018   my ($i, $id);
3019
3020   my $dbh = $self->dbconnect_noauto($myconfig);
3021
3022   my $query = qq|DELETE FROM status
3023                  WHERE (formname = ?) AND (trans_id = ?)|;
3024   my $sth = prepare_query($self, $dbh, $query);
3025
3026   if ($self->{formname} =~ /(check|receipt)/) {
3027     for $i (1 .. $self->{rowcount}) {
3028       do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
3029     }
3030   } else {
3031     do_statement($self, $sth, $query, $self->{formname}, $self->{id});
3032   }
3033   $sth->finish();
3034
3035   my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3036   my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3037
3038   my %queued = split / /, $self->{queued};
3039   my @values;
3040
3041   if ($self->{formname} =~ /(check|receipt)/) {
3042
3043     # this is a check or receipt, add one entry for each lineitem
3044     my ($accno) = split /--/, $self->{account};
3045     $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
3046                 VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
3047     @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
3048     $sth = prepare_query($self, $dbh, $query);
3049
3050     for $i (1 .. $self->{rowcount}) {
3051       if ($self->{"checked_$i"}) {
3052         do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
3053       }
3054     }
3055     $sth->finish();
3056
3057   } else {
3058     $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
3059                 VALUES (?, ?, ?, ?, ?)|;
3060     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
3061              $queued{$self->{formname}}, $self->{formname});
3062   }
3063
3064   $dbh->commit;
3065   $dbh->disconnect;
3066
3067   $main::lxdebug->leave_sub();
3068 }
3069
3070 sub save_status {
3071   $main::lxdebug->enter_sub();
3072
3073   my ($self, $dbh) = @_;
3074
3075   my ($query, $printed, $emailed);
3076
3077   my $formnames  = $self->{printed};
3078   my $emailforms = $self->{emailed};
3079
3080   $query = qq|DELETE FROM status
3081                  WHERE (formname = ?) AND (trans_id = ?)|;
3082   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
3083
3084   # this only applies to the forms
3085   # checks and receipts are posted when printed or queued
3086
3087   if ($self->{queued}) {
3088     my %queued = split / /, $self->{queued};
3089
3090     foreach my $formname (keys %queued) {
3091       $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3092       $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3093
3094       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
3095                   VALUES (?, ?, ?, ?, ?)|;
3096       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
3097
3098       $formnames  =~ s/\Q$self->{formname}\E//;
3099       $emailforms =~ s/\Q$self->{formname}\E//;
3100
3101     }
3102   }
3103
3104   # save printed, emailed info
3105   $formnames  =~ s/^ +//g;
3106   $emailforms =~ s/^ +//g;
3107
3108   my %status = ();
3109   map { $status{$_}{printed} = 1 } split / +/, $formnames;
3110   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
3111
3112   foreach my $formname (keys %status) {
3113     $printed = ($formnames  =~ /\Q$self->{formname}\E/) ? "1" : "0";
3114     $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
3115
3116     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
3117                 VALUES (?, ?, ?, ?)|;
3118     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
3119   }
3120
3121   $main::lxdebug->leave_sub();
3122 }
3123
3124 #--- 4 locale ---#
3125 # $main::locale->text('SAVED')
3126 # $main::locale->text('DELETED')
3127 # $main::locale->text('ADDED')
3128 # $main::locale->text('PAYMENT POSTED')
3129 # $main::locale->text('POSTED')
3130 # $main::locale->text('POSTED AS NEW')
3131 # $main::locale->text('ELSE')
3132 # $main::locale->text('SAVED FOR DUNNING')
3133 # $main::locale->text('DUNNING STARTED')
3134 # $main::locale->text('PRINTED')
3135 # $main::locale->text('MAILED')
3136 # $main::locale->text('SCREENED')
3137 # $main::locale->text('CANCELED')
3138 # $main::locale->text('invoice')
3139 # $main::locale->text('proforma')
3140 # $main::locale->text('sales_order')
3141 # $main::locale->text('pick_list')
3142 # $main::locale->text('purchase_order')
3143 # $main::locale->text('bin_list')
3144 # $main::locale->text('sales_quotation')
3145 # $main::locale->text('request_quotation')
3146
3147 sub save_history {
3148   $main::lxdebug->enter_sub();
3149
3150   my $self = shift;
3151   my $dbh  = shift || $self->get_standard_dbh;
3152
3153   if(!exists $self->{employee_id}) {
3154     &get_employee($self, $dbh);
3155   }
3156
3157   my $query =
3158    qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
3159    qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
3160   my @values = (conv_i($self->{id}), $self->{login},
3161                 $self->{addition}, $self->{what_done}, "$self->{snumbers}");
3162   do_query($self, $dbh, $query, @values);
3163
3164   $dbh->commit;
3165
3166   $main::lxdebug->leave_sub();
3167 }
3168
3169 sub get_history {
3170   $main::lxdebug->enter_sub();
3171
3172   my ($self, $dbh, $trans_id, $restriction, $order) = @_;
3173   my ($orderBy, $desc) = split(/\-\-/, $order);
3174   $order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
3175   my @tempArray;
3176   my $i = 0;
3177   if ($trans_id ne "") {
3178     my $query =
3179       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 | .
3180       qq|FROM history_erp h | .
3181       qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
3182       qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | .
3183       $order;
3184
3185     my $sth = $dbh->prepare($query) || $self->dberror($query);
3186
3187     $sth->execute() || $self->dberror("$query");
3188
3189     while(my $hash_ref = $sth->fetchrow_hashref()) {
3190       $hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
3191       $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
3192       $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g;
3193       $tempArray[$i++] = $hash_ref;
3194     }
3195     $main::lxdebug->leave_sub() and return \@tempArray
3196       if ($i > 0 && $tempArray[0] ne "");
3197   }
3198   $main::lxdebug->leave_sub();
3199   return 0;
3200 }
3201
3202 sub update_defaults {
3203   $main::lxdebug->enter_sub();
3204
3205   my ($self, $myconfig, $fld, $provided_dbh) = @_;
3206
3207   my $dbh;
3208   if ($provided_dbh) {
3209     $dbh = $provided_dbh;
3210   } else {
3211     $dbh = $self->dbconnect_noauto($myconfig);
3212   }
3213   my $query = qq|SELECT $fld FROM defaults FOR UPDATE|;
3214   my $sth   = $dbh->prepare($query);
3215
3216   $sth->execute || $self->dberror($query);
3217   my ($var) = $sth->fetchrow_array;
3218   $sth->finish;
3219
3220   if ($var =~ m/\d+$/) {
3221     my $new_var  = (substr $var, $-[0]) * 1 + 1;
3222     my $len_diff = length($var) - $-[0] - length($new_var);
3223     $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
3224
3225   } else {
3226     $var = $var . '1';
3227   }
3228
3229   $query = qq|UPDATE defaults SET $fld = ?|;
3230   do_query($self, $dbh, $query, $var);
3231
3232   if (!$provided_dbh) {
3233     $dbh->commit;
3234     $dbh->disconnect;
3235   }
3236
3237   $main::lxdebug->leave_sub();
3238
3239   return $var;
3240 }
3241
3242 sub update_business {
3243   $main::lxdebug->enter_sub();
3244
3245   my ($self, $myconfig, $business_id, $provided_dbh) = @_;
3246
3247   my $dbh;
3248   if ($provided_dbh) {
3249     $dbh = $provided_dbh;
3250   } else {
3251     $dbh = $self->dbconnect_noauto($myconfig);
3252   }
3253   my $query =
3254     qq|SELECT customernumberinit FROM business
3255        WHERE id = ? FOR UPDATE|;
3256   my ($var) = selectrow_query($self, $dbh, $query, $business_id);
3257
3258   return undef unless $var;
3259
3260   if ($var =~ m/\d+$/) {
3261     my $new_var  = (substr $var, $-[0]) * 1 + 1;
3262     my $len_diff = length($var) - $-[0] - length($new_var);
3263     $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
3264
3265   } else {
3266     $var = $var . '1';
3267   }
3268
3269   $query = qq|UPDATE business
3270               SET customernumberinit = ?
3271               WHERE id = ?|;
3272   do_query($self, $dbh, $query, $var, $business_id);
3273
3274   if (!$provided_dbh) {
3275     $dbh->commit;
3276     $dbh->disconnect;
3277   }
3278
3279   $main::lxdebug->leave_sub();
3280
3281   return $var;
3282 }
3283
3284 sub get_partsgroup {
3285   $main::lxdebug->enter_sub();
3286
3287   my ($self, $myconfig, $p) = @_;
3288   my $target = $p->{target} || 'all_partsgroup';
3289
3290   my $dbh = $self->get_standard_dbh($myconfig);
3291
3292   my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
3293                  FROM partsgroup pg
3294                  JOIN parts p ON (p.partsgroup_id = pg.id) |;
3295   my @values;
3296
3297   if ($p->{searchitems} eq 'part') {
3298     $query .= qq|WHERE p.inventory_accno_id > 0|;
3299   }
3300   if ($p->{searchitems} eq 'service') {
3301     $query .= qq|WHERE p.inventory_accno_id IS NULL|;
3302   }
3303   if ($p->{searchitems} eq 'assembly') {
3304     $query .= qq|WHERE p.assembly = '1'|;
3305   }
3306   if ($p->{searchitems} eq 'labor') {
3307     $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|;
3308   }
3309
3310   $query .= qq|ORDER BY partsgroup|;
3311
3312   if ($p->{all}) {
3313     $query = qq|SELECT id, partsgroup FROM partsgroup
3314                 ORDER BY partsgroup|;
3315   }
3316
3317   if ($p->{language_code}) {
3318     $query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
3319                   t.description AS translation
3320                 FROM partsgroup pg
3321                 JOIN parts p ON (p.partsgroup_id = pg.id)
3322                 LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
3323                 ORDER BY translation|;
3324     @values = ($p->{language_code});
3325   }
3326
3327   $self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);
3328
3329   $main::lxdebug->leave_sub();
3330 }
3331
3332 sub get_pricegroup {
3333   $main::lxdebug->enter_sub();
3334
3335   my ($self, $myconfig, $p) = @_;
3336
3337   my $dbh = $self->get_standard_dbh($myconfig);
3338
3339   my $query = qq|SELECT p.id, p.pricegroup
3340                  FROM pricegroup p|;
3341
3342   $query .= qq| ORDER BY pricegroup|;
3343
3344   if ($p->{all}) {
3345     $query = qq|SELECT id, pricegroup FROM pricegroup
3346                 ORDER BY pricegroup|;
3347   }
3348
3349   $self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);
3350
3351   $main::lxdebug->leave_sub();
3352 }
3353
3354 sub all_years {
3355 # usage $form->all_years($myconfig, [$dbh])
3356 # return list of all years where bookings found
3357 # (@all_years)
3358
3359   $main::lxdebug->enter_sub();
3360
3361   my ($self, $myconfig, $dbh) = @_;
3362
3363   $dbh ||= $self->get_standard_dbh($myconfig);
3364
3365   # get years
3366   my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
3367                    (SELECT MAX(transdate) FROM acc_trans)|;
3368   my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);
3369
3370   if ($myconfig->{dateformat} =~ /^yy/) {
3371     ($startdate) = split /\W/, $startdate;
3372     ($enddate) = split /\W/, $enddate;
3373   } else {
3374     (@_) = split /\W/, $startdate;
3375     $startdate = $_[2];
3376     (@_) = split /\W/, $enddate;
3377     $enddate = $_[2];
3378   }
3379
3380   my @all_years;
3381   $startdate = substr($startdate,0,4);
3382   $enddate = substr($enddate,0,4);
3383
3384   while ($enddate >= $startdate) {
3385     push @all_years, $enddate--;
3386   }
3387
3388   return @all_years;
3389
3390   $main::lxdebug->leave_sub();
3391 }
3392
3393 sub backup_vars {
3394   $main::lxdebug->enter_sub();
3395   my $self = shift;
3396   my @vars = @_;
3397
3398   map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;
3399
3400   $main::lxdebug->leave_sub();
3401 }
3402
3403 sub restore_vars {
3404   $main::lxdebug->enter_sub();
3405
3406   my $self = shift;
3407   my @vars = @_;
3408
3409   map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;
3410
3411   $main::lxdebug->leave_sub();
3412 }
3413
3414 sub prepare_for_printing {
3415   my ($self) = @_;
3416
3417   $self->{templates} ||= $::myconfig{templates};
3418   $self->{formname}  ||= $self->{type};
3419   $self->{media}     ||= 'email';
3420
3421   die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
3422
3423   # set shipto from billto unless set
3424   my $has_shipto = any { $self->{"shipto$_"} } qw(name street zipcode city country contact);
3425   if (!$has_shipto && ($self->{type} =~ m/^(?:purchase_order|request_quotation)$/)) {
3426     $self->{shiptoname}   = $::myconfig{company};
3427     $self->{shiptostreet} = $::myconfig{address};
3428   }
3429
3430   my $language = $self->{language} ? '_' . $self->{language} : '';
3431
3432   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
3433   if ($self->{language_id}) {
3434     ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
3435   } else {
3436     $output_dateformat   = $::myconfig{dateformat};
3437     $output_numberformat = $::myconfig{numberformat};
3438     $output_longdates    = 1;
3439   }
3440
3441   # Retrieve accounts for tax calculation.
3442   IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});
3443
3444   if ($self->{type} =~ /_delivery_order$/) {
3445     DO->order_details();
3446   } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) {
3447     OE->order_details(\%::myconfig, $self);
3448   } else {
3449     IS->invoice_details(\%::myconfig, $self, $::locale);
3450   }
3451
3452   # Chose extension & set source file name
3453   my $extension = 'html';
3454   if ($self->{format} eq 'postscript') {
3455     $self->{postscript}   = 1;
3456     $extension            = 'tex';
3457   } elsif ($self->{"format"} =~ /pdf/) {
3458     $self->{pdf}          = 1;
3459     $extension            = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
3460   } elsif ($self->{"format"} =~ /opendocument/) {
3461     $self->{opendocument} = 1;
3462     $extension            = 'odt';
3463   } elsif ($self->{"format"} =~ /excel/) {
3464     $self->{excel}        = 1;
3465     $extension            = 'xls';
3466   }
3467
3468   my $printer_code    = $self->{printer_code} ? '_' . $self->{printer_code} : '';
3469   my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : '';
3470   $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
3471
3472   # Format dates.
3473   $self->format_dates($output_dateformat, $output_longdates,
3474                       qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid
3475                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
3476                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
3477
3478   $self->reformat_numbers($output_numberformat, 2,
3479                           qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
3480                           grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));
3481
3482   $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));
3483
3484   my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');
3485
3486   if (scalar @{ $cvar_date_fields }) {
3487     $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
3488   }
3489
3490   while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
3491     $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
3492   }
3493
3494   return $self;
3495 }
3496
3497 sub format_dates {
3498   my ($self, $dateformat, $longformat, @indices) = @_;
3499
3500   $dateformat ||= $::myconfig{dateformat};
3501
3502   foreach my $idx (@indices) {
3503     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3504       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3505         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
3506       }
3507     }
3508
3509     next unless defined $self->{$idx};
3510
3511     if (!ref($self->{$idx})) {
3512       $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);
3513
3514     } elsif (ref($self->{$idx}) eq "ARRAY") {
3515       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3516         $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
3517       }
3518     }
3519   }
3520 }
3521
3522 sub reformat_numbers {
3523   my ($self, $numberformat, $places, @indices) = @_;
3524
3525   return if !$numberformat || ($numberformat eq $::myconfig{numberformat});
3526
3527   foreach my $idx (@indices) {
3528     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3529       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3530         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
3531       }
3532     }
3533
3534     next unless defined $self->{$idx};
3535
3536     if (!ref($self->{$idx})) {
3537       $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});
3538
3539     } elsif (ref($self->{$idx}) eq "ARRAY") {
3540       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3541         $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
3542       }
3543     }
3544   }
3545
3546   my $saved_numberformat    = $::myconfig{numberformat};
3547   $::myconfig{numberformat} = $numberformat;
3548
3549   foreach my $idx (@indices) {
3550     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3551       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3552         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
3553       }
3554     }
3555
3556     next unless defined $self->{$idx};
3557
3558     if (!ref($self->{$idx})) {
3559       $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);
3560
3561     } elsif (ref($self->{$idx}) eq "ARRAY") {
3562       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3563         $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
3564       }
3565     }
3566   }
3567
3568   $::myconfig{numberformat} = $saved_numberformat;
3569 }
3570
3571 1;
3572
3573 __END__
3574
3575 =head1 NAME
3576
3577 SL::Form.pm - main data object.
3578
3579 =head1 SYNOPSIS
3580
3581 This is the main data object of Lx-Office.
3582 Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
3583 Points of interest for a beginner are:
3584
3585  - $form->error            - renders a generic error in html. accepts an error message
3586  - $form->get_standard_dbh - returns a database connection for the
3587
3588 =head1 SPECIAL FUNCTIONS
3589
3590 =head2 C<update_business> PARAMS
3591
3592 PARAMS (not named):
3593  \%config,     - config hashref
3594  $business_id, - business id
3595  $dbh          - optional database handle
3596
3597 handles business (thats customer/vendor types) sequences.
3598
3599 special behaviour for empty strings in customerinitnumber field:
3600 will in this case not increase the value, and return undef.
3601
3602 =head2 C<redirect_header> $url
3603
3604 Generates a HTTP redirection header for the new C<$url>. Constructs an
3605 absolute URL including scheme, host name and port. If C<$url> is a
3606 relative URL then it is considered relative to Lx-Office base URL.
3607
3608 This function C<die>s if headers have already been created with
3609 C<$::form-E<gt>header>.
3610
3611 Examples:
3612
3613   print $::form->redirect_header('oe.pl?action=edit&id=1234');
3614   print $::form->redirect_header('http://www.lx-office.org/');
3615
3616 =head2 C<header>
3617
3618 Generates a general purpose http/html header and includes most of the scripts
3619 and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.
3620
3621 Only one header will be generated. If the method was already called in this
3622 request it will not output anything and return undef. Also if no
3623 HTTP_USER_AGENT is found, no header is generated.
3624
3625 Although header does not accept parameters itself, it will honor special
3626 hashkeys of its Form instance:
3627
3628 =over 4
3629
3630 =item refresh_time
3631
3632 =item refresh_url
3633
3634 If one of these is set, a http-equiv refresh is generated. Missing parameters
3635 default to 3 seconds and the refering url.
3636
3637 =item stylesheet
3638
3639 Either a scalar or an array ref. Will be inlined into the header. Add
3640 stylesheets with the L<use_stylesheet> function.
3641
3642 =item landscape
3643
3644 If true, a css snippet will be generated that sets the page in landscape mode.
3645
3646 =item favicon
3647
3648 Used to override the default favicon.
3649
3650 =item title
3651
3652 A html page title will be generated from this
3653
3654 =back
3655
3656 =cut