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