SL/Form.pm

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