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