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