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