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