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   # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13
 875
 876   my $neg = ($amount =~ s/^-//);
 877   my $exp = ($amount =~ m/[e]/) ? 1 : 0;
 878
 879   if (defined($places) && ($places ne '')) {
 880     if (not $exp) {
 881       if ($places < 0) {
 882         $amount *= 1;
 883         $places *= -1;
 884
 885         if ($amount =~ /\.(\d+)/) {
 886           my $actual_places = length $1;
 887           $places = $actual_places if $actual_places > $places;
 888         }
 889       }
 890     }
 891     $amount = $self->round_amount($amount, $places);
 892   }
 893
 894   my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
 895   my @p = split(/\./, $amount); # split amount at decimal point
 896
 897   $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
 898
 899   $amount = $p[0];
 900   $amount .= $d[0].($p[1]||'').(0 x ($places - length ($p[1]||''))) if ($places || $p[1] ne '');
 901
 902   $amount = do {
 903     ($dash =~ /-/)    ? ($neg ? "($amount)"                            : "$amount" )                              :
 904     ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) :
 905                         ($neg ? "-$amount"                             : "$amount" )                              ;
 906   };
 907
 908
 909   $main::lxdebug->leave_sub(2);
 910   return $amount;
 911 }
 912
 913 sub format_amount_units {
 914   $main::lxdebug->enter_sub();
 915
 916   my $self             = shift;
 917   my %params           = @_;
 918
 919   my $myconfig         = \%main::myconfig;
 920   my $amount           = $params{amount} * 1;
 921   my $places           = $params{places};
 922   my $part_unit_name   = $params{part_unit};
 923   my $amount_unit_name = $params{amount_unit};
 924   my $conv_units       = $params{conv_units};
 925   my $max_places       = $params{max_places};
 926
 927   if (!$part_unit_name) {
 928     $main::lxdebug->leave_sub();
 929     return '';
 930   }
 931
 932   my $all_units        = AM->retrieve_all_units;
 933
 934   if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
 935     $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
 936   }
 937
 938   if (!scalar @{ $conv_units }) {
 939     my $result = $self->format_amount($myconfig, $amount, $places, undef, $max_places) . " " . $part_unit_name;
 940     $main::lxdebug->leave_sub();
 941     return $result;
 942   }
 943
 944   my $part_unit  = $all_units->{$part_unit_name};
 945   my $conv_unit  = ($amount_unit_name && ($amount_unit_name ne $part_unit_name)) ? $all_units->{$amount_unit_name} : $part_unit;
 946
 947   $amount       *= $conv_unit->{factor};
 948
 949   my @values;
 950   my $num;
 951
 952   foreach my $unit (@$conv_units) {
 953     my $last = $unit->{name} eq $part_unit->{name};
 954     if (!$last) {
 955       $num     = int($amount / $unit->{factor});
 956       $amount -= $num * $unit->{factor};
 957     }
 958
 959     if ($last ? $amount : $num) {
 960       push @values, { "unit"   => $unit->{name},
 961                       "amount" => $last ? $amount / $unit->{factor} : $num,
 962                       "places" => $last ? $places : 0 };
 963     }
 964
 965     last if $last;
 966   }
 967
 968   if (!@values) {
 969     push @values, { "unit"   => $part_unit_name,
 970                     "amount" => 0,
 971                     "places" => 0 };
 972   }
 973
 974   my $result = join " ", map { $self->format_amount($myconfig, $_->{amount}, $_->{places}, undef, $max_places), $_->{unit} } @values;
 975
 976   $main::lxdebug->leave_sub();
 977
 978   return $result;
 979 }
 980
 981 sub format_string {
 982   $main::lxdebug->enter_sub(2);
 983
 984   my $self  = shift;
 985   my $input = shift;
 986
 987   $input =~ s/(^|[^\#]) \#  (\d+)  /$1$_[$2 - 1]/gx;
 988   $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx;
 989   $input =~ s/\#\#/\#/g;
 990
 991   $main::lxdebug->leave_sub(2);
 992
 993   return $input;
 994 }
 995
 996 #
 997
 998 sub parse_amount {
 999   $main::lxdebug->enter_sub(2);
1000
1001   my ($self, $myconfig, $amount) = @_;
1002
1003   if (   ($myconfig->{numberformat} eq '1.000,00')
1004       || ($myconfig->{numberformat} eq '1000,00')) {
1005     $amount =~ s/\.//g;
1006     $amount =~ s/,/\./g;
1007   }
1008
1009   if ($myconfig->{numberformat} eq "1'000.00") {
1010     $amount =~ s/\'//g;
1011   }
1012
1013   $amount =~ s/,//g;
1014
1015   $main::lxdebug->leave_sub(2);
1016
1017   # Make sure no code wich is not a math expression ends up in eval().
1018   return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
1019   return scalar(eval($amount)) * 1 ;
1020 }
1021
1022 sub round_amount {
1023   $main::lxdebug->enter_sub(2);
1024
1025   my ($self, $amount, $places) = @_;
1026   my $round_amount;
1027
1028   # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung )
1029
1030   # Round amounts to eight places before rounding to the requested
1031   # number of places. This gets rid of errors due to internal floating
1032   # point representation.
1033   $amount       = $self->round_amount($amount, 8) if $places < 8;
1034   $amount       = $amount * (10**($places));
1035   $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
1036
1037   $main::lxdebug->leave_sub(2);
1038
1039   return $round_amount;
1040
1041 }
1042
1043 sub parse_template {
1044   $main::lxdebug->enter_sub();
1045
1046   my ($self, $myconfig) = @_;
1047   my ($out, $out_mode);
1048
1049   local (*IN, *OUT);
1050
1051   my $userspath = $::lx_office_conf{paths}->{userspath};
1052
1053   $self->{"cwd"} = getcwd();
1054   $self->{"tmpdir"} = $self->{cwd} . "/${userspath}";
1055
1056   my $ext_for_format;
1057
1058   my $template_type;
1059   if ($self->{"format"} =~ /(opendocument|oasis)/i) {
1060     $template_type  = 'OpenDocument';
1061     $ext_for_format = $self->{"format"} =~ m/pdf/ ? 'pdf' : 'odt';
1062
1063   } elsif ($self->{"format"} =~ /(postscript|pdf)/i) {
1064     $ENV{"TEXINPUTS"} = ".:" . getcwd() . "/" . $myconfig->{"templates"} . ":" . $ENV{"TEXINPUTS"};
1065     $template_type    = 'LaTeX';
1066     $ext_for_format   = 'pdf';
1067
1068   } elsif (($self->{"format"} =~ /html/i) || (!$self->{"format"} && ($self->{"IN"} =~ /html$/i))) {
1069     $template_type  = 'HTML';
1070     $ext_for_format = 'html';
1071
1072   } elsif (($self->{"format"} =~ /xml/i) || (!$self->{"format"} && ($self->{"IN"} =~ /xml$/i))) {
1073     $template_type  = 'XML';
1074     $ext_for_format = 'xml';
1075
1076   } elsif ( $self->{"format"} =~ /elster(?:winston|taxbird)/i ) {
1077     $template_type = 'XML';
1078
1079   } elsif ( $self->{"format"} =~ /excel/i ) {
1080     $template_type  = 'Excel';
1081     $ext_for_format = 'xls';
1082
1083   } elsif ( defined $self->{'format'}) {
1084     $self->error("Outputformat not defined. This may be a future feature: $self->{'format'}");
1085
1086   } elsif ( $self->{'format'} eq '' ) {
1087     $self->error("No Outputformat given: $self->{'format'}");
1088
1089   } else { #Catch the rest
1090     $self->error("Outputformat not defined: $self->{'format'}");
1091   }
1092
1093   my $template = SL::Template::create(type      => $template_type,
1094                                       file_name => $self->{IN},
1095                                       form      => $self,
1096                                       myconfig  => $myconfig,
1097                                       userspath => $userspath);
1098
1099   # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be.
1100   $self->{"notes"} = $self->{ $self->{"formname"} . "notes" };
1101
1102   if (!$self->{employee_id}) {
1103     map { $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns);
1104   }
1105
1106   map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid);
1107   map { $self->{"myconfig_${_}"} = $myconfig->{$_} } grep { $_ ne 'dbpasswd' } keys %{ $myconfig };
1108
1109   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
1110
1111   # OUT is used for the media, screen, printer, email
1112   # for postscript we store a copy in a temporary file
1113   my ($temp_fh, $suffix);
1114   $suffix =  $self->{IN};
1115   $suffix =~ s/.*\.//;
1116   ($temp_fh, $self->{tmpfile}) = File::Temp::tempfile(
1117     'kivitendo-printXXXXXX',
1118     SUFFIX => '.' . ($suffix || 'tex'),
1119     DIR    => $userspath,
1120     UNLINK => ($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})? 0 : 1,
1121   );
1122   close $temp_fh;
1123
1124   if ($template->uses_temp_file() || $self->{media} eq 'email') {
1125     $out              = $self->{OUT};
1126     $out_mode         = $self->{OUT_MODE} || '>';
1127     $self->{OUT}      = "$self->{tmpfile}";
1128     $self->{OUT_MODE} = '>';
1129   }
1130
1131   my $result;
1132   my $command_formatter = sub {
1133     my ($out_mode, $out) = @_;
1134     return $out_mode eq '|-' ? SL::Template::create(type => 'ShellCommand', form => $self)->parse($out) : $out;
1135   };
1136
1137   if ($self->{OUT}) {
1138     $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
1139     open(OUT, $self->{OUT_MODE}, $self->{OUT}) or $self->error("error on opening $self->{OUT} with mode $self->{OUT_MODE} : $!");
1140   } else {
1141     *OUT = ($::dispatcher->get_standard_filehandles)[1];
1142     $self->header;
1143   }
1144
1145   if (!$template->parse(*OUT)) {
1146     $self->cleanup();
1147     $self->error("$self->{IN} : " . $template->get_error());
1148   }
1149
1150   close OUT if $self->{OUT};
1151
1152   if ($self->{media} eq 'file') {
1153     copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
1154     $self->cleanup;
1155     chdir("$self->{cwd}");
1156
1157     $::lxdebug->leave_sub();
1158
1159     return;
1160   }
1161
1162   if ($template->uses_temp_file() || $self->{media} eq 'email') {
1163
1164     if ($self->{media} eq 'email') {
1165
1166       my $mail = new Mailer;
1167
1168       map { $mail->{$_} = $self->{$_} }
1169         qw(cc bcc subject message version format);
1170       $mail->{charset} = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
1171       $mail->{to} = $self->{EMAIL_RECIPIENT} ? $self->{EMAIL_RECIPIENT} : $self->{email};
1172       $mail->{from}   = qq|"$myconfig->{name}" <$myconfig->{email}>|;
1173       $mail->{fileid} = time() . '.' . $$ . '.';
1174       $myconfig->{signature} =~ s/\r//g;
1175
1176       # if we send html or plain text inline
1177       if (($self->{format} eq 'html') && ($self->{sendmode} eq 'inline')) {
1178         $mail->{contenttype}    =  "text/html";
1179         $mail->{message}        =~ s/\r//g;
1180         $mail->{message}        =~ s/\n/<br>\n/g;
1181         $myconfig->{signature}  =~ s/\n/<br>\n/g;
1182         $mail->{message}       .=  "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
1183
1184         open(IN, "<", $self->{tmpfile})
1185           or $self->error($self->cleanup . "$self->{tmpfile} : $!");
1186         $mail->{message} .= $_ while <IN>;
1187         close(IN);
1188
1189       } else {
1190
1191         if (!$self->{"do_not_attach"}) {
1192           my $attachment_name  =  $self->{attachment_filename} || $self->{tmpfile};
1193           $attachment_name     =~ s/\.(.+?)$/.${ext_for_format}/ if ($ext_for_format);
1194           $mail->{attachments} =  [{ "filename" => $self->{tmpfile},
1195                                      "name"     => $attachment_name }];
1196         }
1197
1198         $mail->{message}  =~ s/\r//g;
1199         $mail->{message} .=  "\n-- \n$myconfig->{signature}";
1200
1201       }
1202
1203       my $err = $mail->send();
1204       $self->error($self->cleanup . "$err") if ($err);
1205
1206     } else {
1207
1208       $self->{OUT}      = $out;
1209       $self->{OUT_MODE} = $out_mode;
1210
1211       my $numbytes = (-s $self->{tmpfile});
1212       open(IN, "<", $self->{tmpfile})
1213         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
1214       binmode IN;
1215
1216       $self->{copies} = 1 unless $self->{media} eq 'printer';
1217
1218       chdir("$self->{cwd}");
1219       #print(STDERR "Kopien $self->{copies}\n");
1220       #print(STDERR "OUT $self->{OUT}\n");
1221       for my $i (1 .. $self->{copies}) {
1222         if ($self->{OUT}) {
1223           $self->{OUT} = $command_formatter->($self->{OUT_MODE}, $self->{OUT});
1224
1225           open  OUT, $self->{OUT_MODE}, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
1226           print OUT $_ while <IN>;
1227           close OUT;
1228           seek  IN, 0, 0;
1229
1230         } else {
1231           $self->{attachment_filename} = ($self->{attachment_filename})
1232                                        ? $self->{attachment_filename}
1233                                        : $self->generate_attachment_filename();
1234
1235           # launch application
1236           print qq|Content-Type: | . $template->get_mime_type() . qq|
1237 Content-Disposition: attachment; filename="$self->{attachment_filename}"
1238 Content-Length: $numbytes
1239
1240 |;
1241
1242           $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
1243         }
1244       }
1245
1246       close(IN);
1247     }
1248
1249   }
1250
1251   $self->cleanup;
1252
1253   chdir("$self->{cwd}");
1254   $main::lxdebug->leave_sub();
1255 }
1256
1257 sub get_formname_translation {
1258   $main::lxdebug->enter_sub();
1259   my ($self, $formname) = @_;
1260
1261   $formname ||= $self->{formname};
1262
1263   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1264   local $::locale = Locale->new($self->{recipient_locale});
1265
1266   my %formname_translations = (
1267     bin_list                => $main::locale->text('Bin List'),
1268     credit_note             => $main::locale->text('Credit Note'),
1269     invoice                 => $main::locale->text('Invoice'),
1270     pick_list               => $main::locale->text('Pick List'),
1271     proforma                => $main::locale->text('Proforma Invoice'),
1272     purchase_order          => $main::locale->text('Purchase Order'),
1273     request_quotation       => $main::locale->text('RFQ'),
1274     sales_order             => $main::locale->text('Confirmation'),
1275     sales_quotation         => $main::locale->text('Quotation'),
1276     storno_invoice          => $main::locale->text('Storno Invoice'),
1277     sales_delivery_order    => $main::locale->text('Delivery Order'),
1278     purchase_delivery_order => $main::locale->text('Delivery Order'),
1279     dunning                 => $main::locale->text('Dunning'),
1280   );
1281
1282   $main::lxdebug->leave_sub();
1283   return $formname_translations{$formname};
1284 }
1285
1286 sub get_number_prefix_for_type {
1287   $main::lxdebug->enter_sub();
1288   my ($self) = @_;
1289
1290   my $prefix =
1291       (first { $self->{type} eq $_ } qw(invoice credit_note)) ? 'inv'
1292     : ($self->{type} =~ /_quotation$/)                        ? 'quo'
1293     : ($self->{type} =~ /_delivery_order$/)                   ? 'do'
1294     :                                                           'ord';
1295
1296   $main::lxdebug->leave_sub();
1297   return $prefix;
1298 }
1299
1300 sub get_extension_for_format {
1301   $main::lxdebug->enter_sub();
1302   my ($self)    = @_;
1303
1304   my $extension = $self->{format} =~ /pdf/i          ? ".pdf"
1305                 : $self->{format} =~ /postscript/i   ? ".ps"
1306                 : $self->{format} =~ /opendocument/i ? ".odt"
1307                 : $self->{format} =~ /excel/i        ? ".xls"
1308                 : $self->{format} =~ /html/i         ? ".html"
1309                 :                                      "";
1310
1311   $main::lxdebug->leave_sub();
1312   return $extension;
1313 }
1314
1315 sub generate_attachment_filename {
1316   $main::lxdebug->enter_sub();
1317   my ($self) = @_;
1318
1319   $self->{recipient_locale} ||=  Locale->lang_to_locale($self->{language});
1320   my $recipient_locale = Locale->new($self->{recipient_locale});
1321
1322   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
1323   my $prefix              = $self->get_number_prefix_for_type();
1324
1325   if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
1326     $attachment_filename .= ' (' . $recipient_locale->text('Preview') . ')' . $self->get_extension_for_format();
1327
1328   } elsif ($attachment_filename && $self->{"${prefix}number"}) {
1329     $attachment_filename .=  "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
1330
1331   } else {
1332     $attachment_filename = "";
1333   }
1334
1335   $attachment_filename =  $main::locale->quote_special_chars('filenames', $attachment_filename);
1336   $attachment_filename =~ s|[\s/\\]+|_|g;
1337
1338   $main::lxdebug->leave_sub();
1339   return $attachment_filename;
1340 }
1341
1342 sub generate_email_subject {
1343   $main::lxdebug->enter_sub();
1344   my ($self) = @_;
1345
1346   my $subject = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
1347   my $prefix  = $self->get_number_prefix_for_type();
1348
1349   if ($subject && $self->{"${prefix}number"}) {
1350     $subject .= " " . $self->{"${prefix}number"}
1351   }
1352
1353   $main::lxdebug->leave_sub();
1354   return $subject;
1355 }
1356
1357 sub cleanup {
1358   $main::lxdebug->enter_sub();
1359
1360   my ($self, $application) = @_;
1361
1362   my $error_code = $?;
1363
1364   chdir("$self->{tmpdir}");
1365
1366   my @err = ();
1367   if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
1368     push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');
1369
1370   } elsif (-f "$self->{tmpfile}.err") {
1371     open(FH, "$self->{tmpfile}.err");
1372     @err = <FH>;
1373     close(FH);
1374   }
1375
1376   if ($self->{tmpfile} && !($::lx_office_conf{debug} && $::lx_office_conf{debug}->{keep_temp_files})) {
1377     $self->{tmpfile} =~ s|.*/||g;
1378     # strip extension
1379     $self->{tmpfile} =~ s/\.\w+$//g;
1380     my $tmpfile = $self->{tmpfile};
1381     unlink(<$tmpfile.*>);
1382   }
1383
1384   chdir("$self->{cwd}");
1385
1386   $main::lxdebug->leave_sub();
1387
1388   return "@err";
1389 }
1390
1391 sub datetonum {
1392   $main::lxdebug->enter_sub();
1393
1394   my ($self, $date, $myconfig) = @_;
1395   my ($yy, $mm, $dd);
1396
1397   if ($date && $date =~ /\D/) {
1398
1399     if ($myconfig->{dateformat} =~ /^yy/) {
1400       ($yy, $mm, $dd) = split /\D/, $date;
1401     }
1402     if ($myconfig->{dateformat} =~ /^mm/) {
1403       ($mm, $dd, $yy) = split /\D/, $date;
1404     }
1405     if ($myconfig->{dateformat} =~ /^dd/) {
1406       ($dd, $mm, $yy) = split /\D/, $date;
1407     }
1408
1409     $dd *= 1;
1410     $mm *= 1;
1411     $yy = ($yy < 70) ? $yy + 2000 : $yy;
1412     $yy = ($yy >= 70 && $yy <= 99) ? $yy + 1900 : $yy;
1413
1414     $dd = "0$dd" if ($dd < 10);
1415     $mm = "0$mm" if ($mm < 10);
1416
1417     $date = "$yy$mm$dd";
1418   }
1419
1420   $main::lxdebug->leave_sub();
1421
1422   return $date;
1423 }
1424
1425 # Database routines used throughout
1426
1427 sub _dbconnect_options {
1428   my $self    = shift;
1429   my $options = { pg_enable_utf8 => $::locale->is_utf8,
1430                   @_ };
1431
1432   return $options;
1433 }
1434
1435 sub dbconnect {
1436   $main::lxdebug->enter_sub(2);
1437
1438   my ($self, $myconfig) = @_;
1439
1440   # connect to database
1441   my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options)
1442     or $self->dberror;
1443
1444   # set db options
1445   if ($myconfig->{dboptions}) {
1446     $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
1447   }
1448
1449   $main::lxdebug->leave_sub(2);
1450
1451   return $dbh;
1452 }
1453
1454 sub dbconnect_noauto {
1455   $main::lxdebug->enter_sub();
1456
1457   my ($self, $myconfig) = @_;
1458
1459   # connect to database
1460   my $dbh = SL::DBConnect->connect($myconfig->{dbconnect}, $myconfig->{dbuser}, $myconfig->{dbpasswd}, $self->_dbconnect_options(AutoCommit => 0))
1461     or $self->dberror;
1462
1463   # set db options
1464   if ($myconfig->{dboptions}) {
1465     $dbh->do($myconfig->{dboptions}) || $self->dberror($myconfig->{dboptions});
1466   }
1467
1468   $main::lxdebug->leave_sub();
1469
1470   return $dbh;
1471 }
1472
1473 sub get_standard_dbh {
1474   $main::lxdebug->enter_sub(2);
1475
1476   my $self     = shift;
1477   my $myconfig = shift || \%::myconfig;
1478
1479   if ($standard_dbh && !$standard_dbh->{Active}) {
1480     $main::lxdebug->message(LXDebug->INFO(), "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
1481     undef $standard_dbh;
1482   }
1483
1484   $standard_dbh ||= $self->dbconnect_noauto($myconfig);
1485
1486   $main::lxdebug->leave_sub(2);
1487
1488   return $standard_dbh;
1489 }
1490
1491 sub date_closed {
1492   $main::lxdebug->enter_sub();
1493
1494   my ($self, $date, $myconfig) = @_;
1495   my $dbh = $self->dbconnect($myconfig);
1496
1497   my $query = "SELECT 1 FROM defaults WHERE ? < closedto";
1498   my $sth = prepare_execute_query($self, $dbh, $query, conv_date($date));
1499
1500   # Falls $date = '' - Fehlermeldung aus der Datenbank. Ich denke,
1501   # es ist sicher ein conv_date vorher IMMER auszuführen.
1502   # Testfälle ohne definiertes closedto:
1503   #   Leere Datumseingabe i.O.
1504   #     SELECT 1 FROM defaults WHERE '' < closedto
1505   #   normale Zahlungsbuchung über Rechnungsmaske i.O.
1506   #     SELECT 1 FROM defaults WHERE '10.05.2011' < closedto
1507   # Testfälle mit definiertem closedto (30.04.2011):
1508   #  Leere Datumseingabe i.O.
1509   #   SELECT 1 FROM defaults WHERE '' < closedto
1510   # normale Buchung im geschloßenem Zeitraum i.O.
1511   #   SELECT 1 FROM defaults WHERE '21.04.2011' < closedto
1512   #     Fehlermeldung: Es können keine Zahlungen für abgeschlossene Bücher gebucht werden!
1513   # normale Buchung in aktiver Buchungsperiode i.O.
1514   #   SELECT 1 FROM defaults WHERE '01.05.2011' < closedto
1515
1516   my ($closed) = $sth->fetchrow_array;
1517
1518   $main::lxdebug->leave_sub();
1519
1520   return $closed;
1521 }
1522
1523 sub update_balance {
1524   $main::lxdebug->enter_sub();
1525
1526   my ($self, $dbh, $table, $field, $where, $value, @values) = @_;
1527
1528   # if we have a value, go do it
1529   if ($value != 0) {
1530
1531     # retrieve balance from table
1532     my $query = "SELECT $field FROM $table WHERE $where FOR UPDATE";
1533     my $sth = prepare_execute_query($self, $dbh, $query, @values);
1534     my ($balance) = $sth->fetchrow_array;
1535     $sth->finish;
1536
1537     $balance += $value;
1538
1539     # update balance
1540     $query = "UPDATE $table SET $field = $balance WHERE $where";
1541     do_query($self, $dbh, $query, @values);
1542   }
1543   $main::lxdebug->leave_sub();
1544 }
1545
1546 sub update_exchangerate {
1547   $main::lxdebug->enter_sub();
1548
1549   my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_;
1550   my ($query);
1551   # some sanity check for currency
1552   if ($curr eq '') {
1553     $main::lxdebug->leave_sub();
1554     return;
1555   }
1556   $query = qq|SELECT curr FROM defaults|;
1557
1558   my ($currency) = selectrow_query($self, $dbh, $query);
1559   my ($defaultcurrency) = split m/:/, $currency;
1560
1561
1562   if ($curr eq $defaultcurrency) {
1563     $main::lxdebug->leave_sub();
1564     return;
1565   }
1566
1567   $query = qq|SELECT e.curr FROM exchangerate e
1568                  WHERE e.curr = ? AND e.transdate = ?
1569                  FOR UPDATE|;
1570   my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate);
1571
1572   if ($buy == 0) {
1573     $buy = "";
1574   }
1575   if ($sell == 0) {
1576     $sell = "";
1577   }
1578
1579   $buy = conv_i($buy, "NULL");
1580   $sell = conv_i($sell, "NULL");
1581
1582   my $set;
1583   if ($buy != 0 && $sell != 0) {
1584     $set = "buy = $buy, sell = $sell";
1585   } elsif ($buy != 0) {
1586     $set = "buy = $buy";
1587   } elsif ($sell != 0) {
1588     $set = "sell = $sell";
1589   }
1590
1591   if ($sth->fetchrow_array) {
1592     $query = qq|UPDATE exchangerate
1593                 SET $set
1594                 WHERE curr = ?
1595                 AND transdate = ?|;
1596
1597   } else {
1598     $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate)
1599                 VALUES (?, $buy, $sell, ?)|;
1600   }
1601   $sth->finish;
1602   do_query($self, $dbh, $query, $curr, $transdate);
1603
1604   $main::lxdebug->leave_sub();
1605 }
1606
1607 sub save_exchangerate {
1608   $main::lxdebug->enter_sub();
1609
1610   my ($self, $myconfig, $currency, $transdate, $rate, $fld) = @_;
1611
1612   my $dbh = $self->dbconnect($myconfig);
1613
1614   my ($buy, $sell);
1615
1616   $buy  = $rate if $fld eq 'buy';
1617   $sell = $rate if $fld eq 'sell';
1618
1619
1620   $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell);
1621
1622
1623   $dbh->disconnect;
1624
1625   $main::lxdebug->leave_sub();
1626 }
1627
1628 sub get_exchangerate {
1629   $main::lxdebug->enter_sub();
1630
1631   my ($self, $dbh, $curr, $transdate, $fld) = @_;
1632   my ($query);
1633
1634   unless ($transdate) {
1635     $main::lxdebug->leave_sub();
1636     return 1;
1637   }
1638
1639   $query = qq|SELECT curr FROM defaults|;
1640
1641   my ($currency) = selectrow_query($self, $dbh, $query);
1642   my ($defaultcurrency) = split m/:/, $currency;
1643
1644   if ($currency eq $defaultcurrency) {
1645     $main::lxdebug->leave_sub();
1646     return 1;
1647   }
1648
1649   $query = qq|SELECT e.$fld FROM exchangerate e
1650                  WHERE e.curr = ? AND e.transdate = ?|;
1651   my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate);
1652
1653
1654
1655   $main::lxdebug->leave_sub();
1656
1657   return $exchangerate;
1658 }
1659
1660 sub check_exchangerate {
1661   $main::lxdebug->enter_sub();
1662
1663   my ($self, $myconfig, $currency, $transdate, $fld) = @_;
1664
1665   if ($fld !~/^buy|sell$/) {
1666     $self->error('Fatal: check_exchangerate called with invalid buy/sell argument');
1667   }
1668
1669   unless ($transdate) {
1670     $main::lxdebug->leave_sub();
1671     return "";
1672   }
1673
1674   my ($defaultcurrency) = $self->get_default_currency($myconfig);
1675
1676   if ($currency eq $defaultcurrency) {
1677     $main::lxdebug->leave_sub();
1678     return 1;
1679   }
1680
1681   my $dbh   = $self->get_standard_dbh($myconfig);
1682   my $query = qq|SELECT e.$fld FROM exchangerate e
1683                  WHERE e.curr = ? AND e.transdate = ?|;
1684
1685   my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate);
1686
1687   $main::lxdebug->leave_sub();
1688
1689   return $exchangerate;
1690 }
1691
1692 sub get_all_currencies {
1693   $main::lxdebug->enter_sub();
1694
1695   my $self     = shift;
1696   my $myconfig = shift || \%::myconfig;
1697   my $dbh      = $self->get_standard_dbh($myconfig);
1698
1699   my $query = qq|SELECT curr FROM defaults|;
1700
1701   my ($curr)     = selectrow_query($self, $dbh, $query);
1702   my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr;
1703
1704   $main::lxdebug->leave_sub();
1705
1706   return @currencies;
1707 }
1708
1709 sub get_default_currency {
1710   $main::lxdebug->enter_sub();
1711
1712   my ($self, $myconfig) = @_;
1713   my @currencies        = $self->get_all_currencies($myconfig);
1714
1715   $main::lxdebug->leave_sub();
1716
1717   return $currencies[0];
1718 }
1719
1720 sub set_payment_options {
1721   $main::lxdebug->enter_sub();
1722
1723   my ($self, $myconfig, $transdate) = @_;
1724
1725   return $main::lxdebug->leave_sub() unless ($self->{payment_id});
1726
1727   my $dbh = $self->get_standard_dbh($myconfig);
1728
1729   my $query =
1730     qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | .
1731     qq|FROM payment_terms p | .
1732     qq|WHERE p.id = ?|;
1733
1734   ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
1735    $self->{payment_terms}, $self->{payment_description}) =
1736      selectrow_query($self, $dbh, $query, $self->{payment_id});
1737
1738   if ($transdate eq "") {
1739     if ($self->{invdate}) {
1740       $transdate = $self->{invdate};
1741     } else {
1742       $transdate = $self->{transdate};
1743     }
1744   }
1745
1746   $query =
1747     qq|SELECT ?::date + ?::integer AS netto_date, ?::date + ?::integer AS skonto_date | .
1748     qq|FROM payment_terms|;
1749   ($self->{netto_date}, $self->{skonto_date}) =
1750     selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto});
1751
1752   my ($invtotal, $total);
1753   my (%amounts, %formatted_amounts);
1754
1755   if ($self->{type} =~ /_order$/) {
1756     $amounts{invtotal} = $self->{ordtotal};
1757     $amounts{total}    = $self->{ordtotal};
1758
1759   } elsif ($self->{type} =~ /_quotation$/) {
1760     $amounts{invtotal} = $self->{quototal};
1761     $amounts{total}    = $self->{quototal};
1762
1763   } else {
1764     $amounts{invtotal} = $self->{invtotal};
1765     $amounts{total}    = $self->{total};
1766   }
1767   $amounts{skonto_in_percent} = 100.0 * $self->{percent_skonto};
1768
1769   map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts;
1770
1771   $amounts{skonto_amount}      = $amounts{invtotal} * $self->{percent_skonto};
1772   $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto});
1773   $amounts{total_wo_skonto}    = $amounts{total}    * (1 - $self->{percent_skonto});
1774
1775   foreach (keys %amounts) {
1776     $amounts{$_}           = $self->round_amount($amounts{$_}, 2);
1777     $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2);
1778   }
1779
1780   if ($self->{"language_id"}) {
1781     $query =
1782       qq|SELECT t.translation, l.output_numberformat, l.output_dateformat, l.output_longdates | .
1783       qq|FROM generic_translations t | .
1784       qq|LEFT JOIN language l ON t.language_id = l.id | .
1785       qq|WHERE (t.language_id = ?)
1786            AND (t.translation_id = ?)
1787            AND (t.translation_type = 'SL::DB::PaymentTerm/description_long')|;
1788     my ($description_long, $output_numberformat, $output_dateformat,
1789       $output_longdates) =
1790       selectrow_query($self, $dbh, $query,
1791                       $self->{"language_id"}, $self->{"payment_id"});
1792
1793     $self->{payment_terms} = $description_long if ($description_long);
1794
1795     if ($output_dateformat) {
1796       foreach my $key (qw(netto_date skonto_date)) {
1797         $self->{$key} =
1798           $main::locale->reformat_date($myconfig, $self->{$key},
1799                                        $output_dateformat,
1800                                        $output_longdates);
1801       }
1802     }
1803
1804     if ($output_numberformat &&
1805         ($output_numberformat ne $myconfig->{"numberformat"})) {
1806       my $saved_numberformat = $myconfig->{"numberformat"};
1807       $myconfig->{"numberformat"} = $output_numberformat;
1808       map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts;
1809       $myconfig->{"numberformat"} = $saved_numberformat;
1810     }
1811   }
1812
1813   $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g;
1814   $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g;
1815   $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g;
1816   $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g;
1817   $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g;
1818   $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g;
1819   $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g;
1820
1821   map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts;
1822
1823   $self->{skonto_in_percent} = $formatted_amounts{skonto_in_percent};
1824
1825   $main::lxdebug->leave_sub();
1826
1827 }
1828
1829 sub get_template_language {
1830   $main::lxdebug->enter_sub();
1831
1832   my ($self, $myconfig) = @_;
1833
1834   my $template_code = "";
1835
1836   if ($self->{language_id}) {
1837     my $dbh = $self->get_standard_dbh($myconfig);
1838     my $query = qq|SELECT template_code FROM language WHERE id = ?|;
1839     ($template_code) = selectrow_query($self, $dbh, $query, $self->{language_id});
1840   }
1841
1842   $main::lxdebug->leave_sub();
1843
1844   return $template_code;
1845 }
1846
1847 sub get_printer_code {
1848   $main::lxdebug->enter_sub();
1849
1850   my ($self, $myconfig) = @_;
1851
1852   my $template_code = "";
1853
1854   if ($self->{printer_id}) {
1855     my $dbh = $self->get_standard_dbh($myconfig);
1856     my $query = qq|SELECT template_code, printer_command FROM printers WHERE id = ?|;
1857     ($template_code, $self->{printer_command}) = selectrow_query($self, $dbh, $query, $self->{printer_id});
1858   }
1859
1860   $main::lxdebug->leave_sub();
1861
1862   return $template_code;
1863 }
1864
1865 sub get_shipto {
1866   $main::lxdebug->enter_sub();
1867
1868   my ($self, $myconfig) = @_;
1869
1870   my $template_code = "";
1871
1872   if ($self->{shipto_id}) {
1873     my $dbh = $self->get_standard_dbh($myconfig);
1874     my $query = qq|SELECT * FROM shipto WHERE shipto_id = ?|;
1875     my $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{shipto_id});
1876     map({ $self->{$_} = $ref->{$_} } keys(%$ref));
1877   }
1878
1879   $main::lxdebug->leave_sub();
1880 }
1881
1882 sub add_shipto {
1883   $main::lxdebug->enter_sub();
1884
1885   my ($self, $dbh, $id, $module) = @_;
1886
1887   my $shipto;
1888   my @values;
1889
1890   foreach my $item (qw(name department_1 department_2 street zipcode city country
1891                        contact cp_gender phone fax email)) {
1892     if ($self->{"shipto$item"}) {
1893       $shipto = 1 if ($self->{$item} ne $self->{"shipto$item"});
1894     }
1895     push(@values, $self->{"shipto${item}"});
1896   }
1897
1898   if ($shipto) {
1899     if ($self->{shipto_id}) {
1900       my $query = qq|UPDATE shipto set
1901                        shiptoname = ?,
1902                        shiptodepartment_1 = ?,
1903                        shiptodepartment_2 = ?,
1904                        shiptostreet = ?,
1905                        shiptozipcode = ?,
1906                        shiptocity = ?,
1907                        shiptocountry = ?,
1908                        shiptocontact = ?,
1909                        shiptocp_gender = ?,
1910                        shiptophone = ?,
1911                        shiptofax = ?,
1912                        shiptoemail = ?
1913                      WHERE shipto_id = ?|;
1914       do_query($self, $dbh, $query, @values, $self->{shipto_id});
1915     } else {
1916       my $query = qq|SELECT * FROM shipto
1917                      WHERE shiptoname = ? AND
1918                        shiptodepartment_1 = ? AND
1919                        shiptodepartment_2 = ? AND
1920                        shiptostreet = ? AND
1921                        shiptozipcode = ? AND
1922                        shiptocity = ? AND
1923                        shiptocountry = ? AND
1924                        shiptocontact = ? AND
1925                        shiptocp_gender = ? AND
1926                        shiptophone = ? AND
1927                        shiptofax = ? AND
1928                        shiptoemail = ? AND
1929                        module = ? AND
1930                        trans_id = ?|;
1931       my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id);
1932       if(!$insert_check){
1933         $query =
1934           qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2,
1935                                  shiptostreet, shiptozipcode, shiptocity, shiptocountry,
1936                                  shiptocontact, shiptocp_gender, shiptophone, shiptofax, shiptoemail, module)
1937              VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)|;
1938         do_query($self, $dbh, $query, $id, @values, $module);
1939       }
1940     }
1941   }
1942
1943   $main::lxdebug->leave_sub();
1944 }
1945
1946 sub get_employee {
1947   $main::lxdebug->enter_sub();
1948
1949   my ($self, $dbh) = @_;
1950
1951   $dbh ||= $self->get_standard_dbh(\%main::myconfig);
1952
1953   my $query = qq|SELECT id, name FROM employee WHERE login = ?|;
1954   ($self->{"employee_id"}, $self->{"employee"}) = selectrow_query($self, $dbh, $query, $self->{login});
1955   $self->{"employee_id"} *= 1;
1956
1957   $main::lxdebug->leave_sub();
1958 }
1959
1960 sub get_employee_data {
1961   $main::lxdebug->enter_sub();
1962
1963   my $self     = shift;
1964   my %params   = @_;
1965
1966   Common::check_params(\%params, qw(prefix));
1967   Common::check_params_x(\%params, qw(id));
1968
1969   if (!$params{id}) {
1970     $main::lxdebug->leave_sub();
1971     return;
1972   }
1973
1974   my $myconfig = \%main::myconfig;
1975   my $dbh      = $params{dbh} || $self->get_standard_dbh($myconfig);
1976
1977   my ($login)  = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
1978
1979   if ($login) {
1980     my $user = User->new(login => $login);
1981     map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
1982
1983     $self->{$params{prefix} . '_login'}   = $login;
1984     $self->{$params{prefix} . '_name'}  ||= $login;
1985   }
1986
1987   $main::lxdebug->leave_sub();
1988 }
1989
1990 sub get_duedate {
1991   $main::lxdebug->enter_sub();
1992
1993   my ($self, $myconfig, $reference_date) = @_;
1994
1995   $reference_date = $reference_date ? conv_dateq($reference_date) . '::DATE' : 'current_date';
1996
1997   my $dbh         = $self->get_standard_dbh($myconfig);
1998   my $payment_id;
1999
2000   if($self->{payment_id}) {
2001     $payment_id = $self->{payment_id};
2002   } elsif($self->{vendor_id}) {
2003     my $query = 'SELECT payment_id FROM vendor WHERE id = ?';
2004     ($payment_id) = selectrow_query($self, $dbh, $query, $self->{vendor_id});
2005   }
2006
2007   my $query       = qq|SELECT ${reference_date} + terms_netto FROM payment_terms WHERE id = ?|;
2008   my ($duedate)   = selectrow_query($self, $dbh, $query, $payment_id);
2009
2010   $main::lxdebug->leave_sub();
2011
2012   return $duedate;
2013 }
2014
2015 sub _get_contacts {
2016   $main::lxdebug->enter_sub();
2017
2018   my ($self, $dbh, $id, $key) = @_;
2019
2020   $key = "all_contacts" unless ($key);
2021
2022   if (!$id) {
2023     $self->{$key} = [];
2024     $main::lxdebug->leave_sub();
2025     return;
2026   }
2027
2028   my $query =
2029     qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
2030     qq|FROM contacts | .
2031     qq|WHERE cp_cv_id = ? | .
2032     qq|ORDER BY lower(cp_name)|;
2033
2034   $self->{$key} = selectall_hashref_query($self, $dbh, $query, $id);
2035
2036   $main::lxdebug->leave_sub();
2037 }
2038
2039 sub _get_projects {
2040   $main::lxdebug->enter_sub();
2041
2042   my ($self, $dbh, $key) = @_;
2043
2044   my ($all, $old_id, $where, @values);
2045
2046   if (ref($key) eq "HASH") {
2047     my $params = $key;
2048
2049     $key = "ALL_PROJECTS";
2050
2051     foreach my $p (keys(%{$params})) {
2052       if ($p eq "all") {
2053         $all = $params->{$p};
2054       } elsif ($p eq "old_id") {
2055         $old_id = $params->{$p};
2056       } elsif ($p eq "key") {
2057         $key = $params->{$p};
2058       }
2059     }
2060   }
2061
2062   if (!$all) {
2063     $where = "WHERE active ";
2064     if ($old_id) {
2065       if (ref($old_id) eq "ARRAY") {
2066         my @ids = grep({ $_ } @{$old_id});
2067         if (@ids) {
2068           $where .= " OR id IN (" . join(",", map({ "?" } @ids)) . ") ";
2069           push(@values, @ids);
2070         }
2071       } else {
2072         $where .= " OR (id = ?) ";
2073         push(@values, $old_id);
2074       }
2075     }
2076   }
2077
2078   my $query =
2079     qq|SELECT id, projectnumber, description, active | .
2080     qq|FROM project | .
2081     $where .
2082     qq|ORDER BY lower(projectnumber)|;
2083
2084   $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
2085
2086   $main::lxdebug->leave_sub();
2087 }
2088
2089 sub _get_shipto {
2090   $main::lxdebug->enter_sub();
2091
2092   my ($self, $dbh, $vc_id, $key) = @_;
2093
2094   $key = "all_shipto" unless ($key);
2095
2096   if ($vc_id) {
2097     # get shipping addresses
2098     my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
2099
2100     $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
2101
2102   } else {
2103     $self->{$key} = [];
2104   }
2105
2106   $main::lxdebug->leave_sub();
2107 }
2108
2109 sub _get_printers {
2110   $main::lxdebug->enter_sub();
2111
2112   my ($self, $dbh, $key) = @_;
2113
2114   $key = "all_printers" unless ($key);
2115
2116   my $query = qq|SELECT id, printer_description, printer_command, template_code FROM printers|;
2117
2118   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2119
2120   $main::lxdebug->leave_sub();
2121 }
2122
2123 sub _get_charts {
2124   $main::lxdebug->enter_sub();
2125
2126   my ($self, $dbh, $params) = @_;
2127   my ($key);
2128
2129   $key = $params->{key};
2130   $key = "all_charts" unless ($key);
2131
2132   my $transdate = quote_db_date($params->{transdate});
2133
2134   my $query =
2135     qq|SELECT c.id, c.accno, c.description, c.link, c.charttype, tk.taxkey_id, tk.tax_id | .
2136     qq|FROM chart c | .
2137     qq|LEFT JOIN taxkeys tk ON | .
2138     qq|(tk.id = (SELECT id FROM taxkeys | .
2139     qq|          WHERE taxkeys.chart_id = c.id AND startdate <= $transdate | .
2140     qq|          ORDER BY startdate DESC LIMIT 1)) | .
2141     qq|ORDER BY c.accno|;
2142
2143   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2144
2145   $main::lxdebug->leave_sub();
2146 }
2147
2148 sub _get_taxcharts {
2149   $main::lxdebug->enter_sub();
2150
2151   my ($self, $dbh, $params) = @_;
2152
2153   my $key = "all_taxcharts";
2154   my @where;
2155
2156   if (ref $params eq 'HASH') {
2157     $key = $params->{key} if ($params->{key});
2158     if ($params->{module} eq 'AR') {
2159       push @where, 'taxkey NOT IN (8, 9, 18, 19)';
2160
2161     } elsif ($params->{module} eq 'AP') {
2162       push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)';
2163     }
2164
2165   } elsif ($params) {
2166     $key = $params;
2167   }
2168
2169   my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
2170
2171   my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
2172
2173   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2174
2175   $main::lxdebug->leave_sub();
2176 }
2177
2178 sub _get_taxzones {
2179   $main::lxdebug->enter_sub();
2180
2181   my ($self, $dbh, $key) = @_;
2182
2183   $key = "all_taxzones" unless ($key);
2184
2185   my $query = qq|SELECT * FROM tax_zones ORDER BY id|;
2186
2187   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2188
2189   $main::lxdebug->leave_sub();
2190 }
2191
2192 sub _get_employees {
2193   $main::lxdebug->enter_sub();
2194
2195   my ($self, $dbh, $default_key, $key) = @_;
2196
2197   $key = $default_key unless ($key);
2198   $self->{$key} = selectall_hashref_query($self, $dbh, qq|SELECT * FROM employee ORDER BY lower(name)|);
2199
2200   $main::lxdebug->leave_sub();
2201 }
2202
2203 sub _get_business_types {
2204   $main::lxdebug->enter_sub();
2205
2206   my ($self, $dbh, $key) = @_;
2207
2208   my $options       = ref $key eq 'HASH' ? $key : { key => $key };
2209   $options->{key} ||= "all_business_types";
2210   my $where         = '';
2211
2212   if (exists $options->{salesman}) {
2213     $where = 'WHERE ' . ($options->{salesman} ? '' : 'NOT ') . 'COALESCE(salesman)';
2214   }
2215
2216   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, qq|SELECT * FROM business $where ORDER BY lower(description)|);
2217
2218   $main::lxdebug->leave_sub();
2219 }
2220
2221 sub _get_languages {
2222   $main::lxdebug->enter_sub();
2223
2224   my ($self, $dbh, $key) = @_;
2225
2226   $key = "all_languages" unless ($key);
2227
2228   my $query = qq|SELECT * FROM language ORDER BY id|;
2229
2230   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2231
2232   $main::lxdebug->leave_sub();
2233 }
2234
2235 sub _get_dunning_configs {
2236   $main::lxdebug->enter_sub();
2237
2238   my ($self, $dbh, $key) = @_;
2239
2240   $key = "all_dunning_configs" unless ($key);
2241
2242   my $query = qq|SELECT * FROM dunning_config ORDER BY dunning_level|;
2243
2244   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2245
2246   $main::lxdebug->leave_sub();
2247 }
2248
2249 sub _get_currencies {
2250 $main::lxdebug->enter_sub();
2251
2252   my ($self, $dbh, $key) = @_;
2253
2254   $key = "all_currencies" unless ($key);
2255
2256   my $query = qq|SELECT curr AS currency FROM defaults|;
2257
2258   $self->{$key} = [split(/\:/ , selectfirst_hashref_query($self, $dbh, $query)->{currency})];
2259
2260   $main::lxdebug->leave_sub();
2261 }
2262
2263 sub _get_payments {
2264 $main::lxdebug->enter_sub();
2265
2266   my ($self, $dbh, $key) = @_;
2267
2268   $key = "all_payments" unless ($key);
2269
2270   my $query = qq|SELECT * FROM payment_terms ORDER BY sortkey|;
2271
2272   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2273
2274   $main::lxdebug->leave_sub();
2275 }
2276
2277 sub _get_customers {
2278   $main::lxdebug->enter_sub();
2279
2280   my ($self, $dbh, $key) = @_;
2281
2282   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
2283   $options->{key}  ||= "all_customers";
2284   my $limit_clause   = $options->{limit} ? "LIMIT $options->{limit}" : '';
2285
2286   my @where;
2287   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
2288   push @where, qq|NOT obsolete|                                            if !$options->{with_obsolete};
2289   my $where_str = @where ? "WHERE " . join(" AND ", map { "($_)" } @where) : '';
2290
2291   my $query = qq|SELECT * FROM customer $where_str ORDER BY name $limit_clause|;
2292   $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query);
2293
2294   $main::lxdebug->leave_sub();
2295 }
2296
2297 sub _get_vendors {
2298   $main::lxdebug->enter_sub();
2299
2300   my ($self, $dbh, $key) = @_;
2301
2302   $key = "all_vendors" unless ($key);
2303
2304   my $query = qq|SELECT * FROM vendor WHERE NOT obsolete ORDER BY name|;
2305
2306   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2307
2308   $main::lxdebug->leave_sub();
2309 }
2310
2311 sub _get_departments {
2312   $main::lxdebug->enter_sub();
2313
2314   my ($self, $dbh, $key) = @_;
2315
2316   $key = "all_departments" unless ($key);
2317
2318   my $query = qq|SELECT * FROM department ORDER BY description|;
2319
2320   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2321
2322   $main::lxdebug->leave_sub();
2323 }
2324
2325 sub _get_warehouses {
2326   $main::lxdebug->enter_sub();
2327
2328   my ($self, $dbh, $param) = @_;
2329
2330   my ($key, $bins_key);
2331
2332   if ('' eq ref $param) {
2333     $key = $param;
2334
2335   } else {
2336     $key      = $param->{key};
2337     $bins_key = $param->{bins};
2338   }
2339
2340   my $query = qq|SELECT w.* FROM warehouse w
2341                  WHERE (NOT w.invalid) AND
2342                    ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
2343                  ORDER BY w.sortkey|;
2344
2345   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2346
2347   if ($bins_key) {
2348     $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?
2349                 ORDER BY description|;
2350     my $sth = prepare_query($self, $dbh, $query);
2351
2352     foreach my $warehouse (@{ $self->{$key} }) {
2353       do_statement($self, $sth, $query, $warehouse->{id});
2354       $warehouse->{$bins_key} = [];
2355
2356       while (my $ref = $sth->fetchrow_hashref()) {
2357         push @{ $warehouse->{$bins_key} }, $ref;
2358       }
2359     }
2360     $sth->finish();
2361   }
2362
2363   $main::lxdebug->leave_sub();
2364 }
2365
2366 sub _get_simple {
2367   $main::lxdebug->enter_sub();
2368
2369   my ($self, $dbh, $table, $key, $sortkey) = @_;
2370
2371   my $query  = qq|SELECT * FROM $table|;
2372   $query    .= qq| ORDER BY $sortkey| if ($sortkey);
2373
2374   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2375
2376   $main::lxdebug->leave_sub();
2377 }
2378
2379 #sub _get_groups {
2380 #  $main::lxdebug->enter_sub();
2381 #
2382 #  my ($self, $dbh, $key) = @_;
2383 #
2384 #  $key ||= "all_groups";
2385 #
2386 #  my $groups = $main::auth->read_groups();
2387 #
2388 #  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
2389 #
2390 #  $main::lxdebug->leave_sub();
2391 #}
2392
2393 sub get_lists {
2394   $main::lxdebug->enter_sub();
2395
2396   my $self = shift;
2397   my %params = @_;
2398
2399   my $dbh = $self->get_standard_dbh(\%main::myconfig);
2400   my ($sth, $query, $ref);
2401
2402   my $vc = $self->{"vc"} eq "customer" ? "customer" : "vendor";
2403   my $vc_id = $self->{"${vc}_id"};
2404
2405   if ($params{"contacts"}) {
2406     $self->_get_contacts($dbh, $vc_id, $params{"contacts"});
2407   }
2408
2409   if ($params{"shipto"}) {
2410     $self->_get_shipto($dbh, $vc_id, $params{"shipto"});
2411   }
2412
2413   if ($params{"projects"} || $params{"all_projects"}) {
2414     $self->_get_projects($dbh, $params{"all_projects"} ?
2415                          $params{"all_projects"} : $params{"projects"},
2416                          $params{"all_projects"} ? 1 : 0);
2417   }
2418
2419   if ($params{"printers"}) {
2420     $self->_get_printers($dbh, $params{"printers"});
2421   }
2422
2423   if ($params{"languages"}) {
2424     $self->_get_languages($dbh, $params{"languages"});
2425   }
2426
2427   if ($params{"charts"}) {
2428     $self->_get_charts($dbh, $params{"charts"});
2429   }
2430
2431   if ($params{"taxcharts"}) {
2432     $self->_get_taxcharts($dbh, $params{"taxcharts"});
2433   }
2434
2435   if ($params{"taxzones"}) {
2436     $self->_get_taxzones($dbh, $params{"taxzones"});
2437   }
2438
2439   if ($params{"employees"}) {
2440     $self->_get_employees($dbh, "all_employees", $params{"employees"});
2441   }
2442
2443   if ($params{"salesmen"}) {
2444     $self->_get_employees($dbh, "all_salesmen", $params{"salesmen"});
2445   }
2446
2447   if ($params{"business_types"}) {
2448     $self->_get_business_types($dbh, $params{"business_types"});
2449   }
2450
2451   if ($params{"dunning_configs"}) {
2452     $self->_get_dunning_configs($dbh, $params{"dunning_configs"});
2453   }
2454
2455   if($params{"currencies"}) {
2456     $self->_get_currencies($dbh, $params{"currencies"});
2457   }
2458
2459   if($params{"customers"}) {
2460     $self->_get_customers($dbh, $params{"customers"});
2461   }
2462
2463   if($params{"vendors"}) {
2464     if (ref $params{"vendors"} eq 'HASH') {
2465       $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit});
2466     } else {
2467       $self->_get_vendors($dbh, $params{"vendors"});
2468     }
2469   }
2470
2471   if($params{"payments"}) {
2472     $self->_get_payments($dbh, $params{"payments"});
2473   }
2474
2475   if($params{"departments"}) {
2476     $self->_get_departments($dbh, $params{"departments"});
2477   }
2478
2479   if ($params{price_factors}) {
2480     $self->_get_simple($dbh, 'price_factors', $params{price_factors}, 'sortkey');
2481   }
2482
2483   if ($params{warehouses}) {
2484     $self->_get_warehouses($dbh, $params{warehouses});
2485   }
2486
2487 #  if ($params{groups}) {
2488 #    $self->_get_groups($dbh, $params{groups});
2489 #  }
2490
2491   if ($params{partsgroup}) {
2492     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
2493   }
2494
2495   $main::lxdebug->leave_sub();
2496 }
2497
2498 # this sub gets the id and name from $table
2499 sub get_name {
2500   $main::lxdebug->enter_sub();
2501
2502   my ($self, $myconfig, $table) = @_;
2503
2504   # connect to database
2505   my $dbh = $self->get_standard_dbh($myconfig);
2506
2507   $table = $table eq "customer" ? "customer" : "vendor";
2508   my $arap = $self->{arap} eq "ar" ? "ar" : "ap";
2509
2510   my ($query, @values);
2511
2512   if (!$self->{openinvoices}) {
2513     my $where;
2514     if ($self->{customernumber} ne "") {
2515       $where = qq|(vc.customernumber ILIKE ?)|;
2516       push(@values, '%' . $self->{customernumber} . '%');
2517     } else {
2518       $where = qq|(vc.name ILIKE ?)|;
2519       push(@values, '%' . $self->{$table} . '%');
2520     }
2521
2522     $query =
2523       qq~SELECT vc.id, vc.name,
2524            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2525          FROM $table vc
2526          WHERE $where AND (NOT vc.obsolete)
2527          ORDER BY vc.name~;
2528   } else {
2529     $query =
2530       qq~SELECT DISTINCT vc.id, vc.name,
2531            vc.street || ' ' || vc.zipcode || ' ' || vc.city || ' ' || vc.country AS address
2532          FROM $arap a
2533          JOIN $table vc ON (a.${table}_id = vc.id)
2534          WHERE NOT (a.amount = a.paid) AND (vc.name ILIKE ?)
2535          ORDER BY vc.name~;
2536     push(@values, '%' . $self->{$table} . '%');
2537   }
2538
2539   $self->{name_list} = selectall_hashref_query($self, $dbh, $query, @values);
2540
2541   $main::lxdebug->leave_sub();
2542
2543   return scalar(@{ $self->{name_list} });
2544 }
2545
2546 # the selection sub is used in the AR, AP, IS, IR, DO and OE module
2547 #
2548 sub all_vc {
2549   $main::lxdebug->enter_sub();
2550
2551   my ($self, $myconfig, $table, $module) = @_;
2552
2553   my $ref;
2554   my $dbh = $self->get_standard_dbh;
2555
2556   $table = $table eq "customer" ? "customer" : "vendor";
2557
2558   # build selection list
2559   # Hotfix für Bug 1837 - Besser wäre es alte Buchungsbelege
2560   # OHNE Auswahlliste (reines Textfeld) zu laden. Hilft aber auch
2561   # nicht für veränderbare Belege (oe, do, ...)
2562   my $obsolete = "WHERE NOT obsolete" unless $self->{id};
2563   my $query = qq|SELECT count(*) FROM $table $obsolete|;
2564   my ($count) = selectrow_query($self, $dbh, $query);
2565
2566   if ($count < $myconfig->{vclimit}) {
2567     $query = qq|SELECT id, name, salesman_id
2568                 FROM $table $obsolete
2569                 ORDER BY name|;
2570     $self->{"all_$table"} = selectall_hashref_query($self, $dbh, $query);
2571   }
2572
2573   # get self
2574   $self->get_employee($dbh);
2575
2576   # setup sales contacts
2577   $query = qq|SELECT e.id, e.name
2578               FROM employee e
2579               WHERE (e.sales = '1') AND (NOT e.id = ?)|;
2580   $self->{all_employees} = selectall_hashref_query($self, $dbh, $query, $self->{employee_id});
2581
2582   # this is for self
2583   push(@{ $self->{all_employees} },
2584        { id   => $self->{employee_id},
2585          name => $self->{employee} });
2586
2587   # sort the whole thing
2588   @{ $self->{all_employees} } =
2589     sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };
2590
2591
2592     # prepare query for departments
2593     $query = qq|SELECT id, description
2594                 FROM department
2595                 ORDER BY description|;
2596
2597   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2598
2599   # get languages
2600   $query = qq|SELECT id, description
2601               FROM language
2602               ORDER BY id|;
2603
2604   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2605
2606   # get printer
2607   $query = qq|SELECT printer_description, id
2608               FROM printers
2609               ORDER BY printer_description|;
2610
2611   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2612
2613   # get payment terms
2614   $query = qq|SELECT id, description
2615               FROM payment_terms
2616               ORDER BY sortkey|;
2617
2618   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
2619
2620   $main::lxdebug->leave_sub();
2621 }
2622
2623 sub language_payment {
2624   $main::lxdebug->enter_sub();
2625
2626   my ($self, $myconfig) = @_;
2627
2628   my $dbh = $self->get_standard_dbh($myconfig);
2629   # get languages
2630   my $query = qq|SELECT id, description
2631                  FROM language
2632                  ORDER BY id|;
2633
2634   $self->{languages} = selectall_hashref_query($self, $dbh, $query);
2635
2636   # get printer
2637   $query = qq|SELECT printer_description, id
2638               FROM printers
2639               ORDER BY printer_description|;
2640
2641   $self->{printers} = selectall_hashref_query($self, $dbh, $query);
2642
2643   # get payment terms
2644   $query = qq|SELECT id, description
2645               FROM payment_terms
2646               ORDER BY sortkey|;
2647
2648   $self->{payment_terms} = selectall_hashref_query($self, $dbh, $query);
2649
2650   # get buchungsgruppen
2651   $query = qq|SELECT id, description
2652               FROM buchungsgruppen|;
2653
2654   $self->{BUCHUNGSGRUPPEN} = selectall_hashref_query($self, $dbh, $query);
2655
2656   $main::lxdebug->leave_sub();
2657 }
2658
2659 # this is only used for reports
2660 sub all_departments {
2661   $main::lxdebug->enter_sub();
2662
2663   my ($self, $myconfig, $table) = @_;
2664
2665   my $dbh = $self->get_standard_dbh($myconfig);
2666
2667   my $query = qq|SELECT id, description
2668                  FROM department
2669                  ORDER BY description|;
2670   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
2671
2672   delete($self->{all_departments}) unless (@{ $self->{all_departments} || [] });
2673
2674   $main::lxdebug->leave_sub();
2675 }
2676
2677 sub create_links {
2678   $main::lxdebug->enter_sub();
2679
2680   my ($self, $module, $myconfig, $table, $provided_dbh) = @_;
2681
2682   my ($fld, $arap);
2683   if ($table eq "customer") {
2684     $fld = "buy";
2685     $arap = "ar";
2686   } else {
2687     $table = "vendor";
2688     $fld = "sell";
2689     $arap = "ap";
2690   }
2691
2692   $self->all_vc($myconfig, $table, $module);
2693
2694   # get last customers or vendors
2695   my ($query, $sth, $ref);
2696
2697   my $dbh = $provided_dbh ? $provided_dbh : $self->get_standard_dbh($myconfig);
2698   my %xkeyref = ();
2699
2700   if (!$self->{id}) {
2701
2702     my $transdate = "current_date";
2703     if ($self->{transdate}) {
2704       $transdate = $dbh->quote($self->{transdate});
2705     }
2706
2707     # now get the account numbers
2708 #    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
2709 #                FROM chart c, taxkeys tk
2710 #                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
2711 #                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
2712 #                ORDER BY c.accno|;
2713
2714 #  same query as above, but without expensive subquery for each row. about 80% faster
2715     $query = qq|
2716       SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id
2717         FROM chart c
2718         -- find newest entries in taxkeys
2719         INNER JOIN (
2720           SELECT chart_id, MAX(startdate) AS startdate
2721           FROM taxkeys
2722           WHERE (startdate <= $transdate)
2723           GROUP BY chart_id
2724         ) tk ON (c.id = tk.chart_id)
2725         -- and load all of those entries
2726         INNER JOIN taxkeys tk2
2727            ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
2728        WHERE (c.link LIKE ?)
2729       ORDER BY c.accno|;
2730
2731     $sth = $dbh->prepare($query);
2732
2733     do_statement($self, $sth, $query, '%' . $module . '%');
2734
2735     $self->{accounts} = "";
2736     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2737
2738       foreach my $key (split(/:/, $ref->{link})) {
2739         if ($key =~ /\Q$module\E/) {
2740
2741           # cross reference for keys
2742           $xkeyref{ $ref->{accno} } = $key;
2743
2744           push @{ $self->{"${module}_links"}{$key} },
2745             { accno       => $ref->{accno},
2746               description => $ref->{description},
2747               taxkey      => $ref->{taxkey_id},
2748               tax_id      => $ref->{tax_id} };
2749
2750           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2751         }
2752       }
2753     }
2754   }
2755
2756   # get taxkeys and description
2757   $query = qq|SELECT id, taxkey, taxdescription FROM tax|;
2758   $self->{TAXKEY} = selectall_hashref_query($self, $dbh, $query);
2759
2760   if (($module eq "AP") || ($module eq "AR")) {
2761     # get tax rates and description
2762     $query = qq|SELECT * FROM tax|;
2763     $self->{TAX} = selectall_hashref_query($self, $dbh, $query);
2764   }
2765
2766   if ($self->{id}) {
2767     $query =
2768       qq|SELECT
2769            a.cp_id, a.invnumber, a.transdate, a.${table}_id, a.datepaid,
2770            a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
2771            a.intnotes, a.department_id, a.amount AS oldinvtotal,
2772            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
2773            a.globalproject_id,
2774            c.name AS $table,
2775            d.description AS department,
2776            e.name AS employee
2777          FROM $arap a
2778          JOIN $table c ON (a.${table}_id = c.id)
2779          LEFT JOIN employee e ON (e.id = a.employee_id)
2780          LEFT JOIN department d ON (d.id = a.department_id)
2781          WHERE a.id = ?|;
2782     $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
2783
2784     foreach my $key (keys %$ref) {
2785       $self->{$key} = $ref->{$key};
2786     }
2787
2788     # remove any trailing whitespace
2789     $self->{currency} =~ s/\s*$//;
2790
2791     my $transdate = "current_date";
2792     if ($self->{transdate}) {
2793       $transdate = $dbh->quote($self->{transdate});
2794     }
2795
2796     # now get the account numbers
2797     $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
2798                 FROM chart c
2799                 LEFT JOIN taxkeys tk ON (tk.chart_id = c.id)
2800                 WHERE c.link LIKE ?
2801                   AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1)
2802                     OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL)
2803                 ORDER BY c.accno|;
2804
2805     $sth = $dbh->prepare($query);
2806     do_statement($self, $sth, $query, "%$module%");
2807
2808     $self->{accounts} = "";
2809     while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
2810
2811       foreach my $key (split(/:/, $ref->{link})) {
2812         if ($key =~ /\Q$module\E/) {
2813
2814           # cross reference for keys
2815           $xkeyref{ $ref->{accno} } = $key;
2816
2817           push @{ $self->{"${module}_links"}{$key} },
2818             { accno       => $ref->{accno},
2819               description => $ref->{description},
2820               taxkey      => $ref->{taxkey_id},
2821               tax_id      => $ref->{tax_id} };
2822
2823           $self->{accounts} .= "$ref->{accno} " unless $key =~ /tax/;
2824         }
2825       }
2826     }
2827
2828
2829     # get amounts from individual entries
2830     $query =
2831       qq|SELECT
2832            c.accno, c.description,
2833            a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey,
2834            p.projectnumber,
2835            t.rate, t.id
2836          FROM acc_trans a
2837          LEFT JOIN chart c ON (c.id = a.chart_id)
2838          LEFT JOIN project p ON (p.id = a.project_id)
2839          LEFT JOIN tax t ON (t.id= (SELECT tk.tax_id FROM taxkeys tk
2840                                     WHERE (tk.taxkey_id=a.taxkey) AND
2841                                       ((CASE WHEN a.chart_id IN (SELECT chart_id FROM taxkeys WHERE taxkey_id = a.taxkey)
2842                                         THEN tk.chart_id = a.chart_id
2843                                         ELSE 1 = 1
2844                                         END)
2845                                        OR (c.link='%tax%')) AND
2846                                       (startdate <= a.transdate) ORDER BY startdate DESC LIMIT 1))
2847          WHERE a.trans_id = ?
2848          AND a.fx_transaction = '0'
2849          ORDER BY a.acc_trans_id, a.transdate|;
2850     $sth = $dbh->prepare($query);
2851     do_statement($self, $sth, $query, $self->{id});
2852
2853     # get exchangerate for currency
2854     $self->{exchangerate} =
2855       $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2856     my $index = 0;
2857
2858     # store amounts in {acc_trans}{$key} for multiple accounts
2859     while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
2860       $ref->{exchangerate} =
2861         $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
2862       if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
2863         $index++;
2864       }
2865       if (($xkeyref{ $ref->{accno} } =~ /paid/) && ($self->{type} eq "credit_note")) {
2866         $ref->{amount} *= -1;
2867       }
2868       $ref->{index} = $index;
2869
2870       push @{ $self->{acc_trans}{ $xkeyref{ $ref->{accno} } } }, $ref;
2871     }
2872
2873     $sth->finish;
2874     $query =
2875       qq|SELECT
2876            d.curr AS currencies, d.closedto, d.revtrans,
2877            (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2878            (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
2879          FROM defaults d|;
2880     $ref = selectfirst_hashref_query($self, $dbh, $query);
2881     map { $self->{$_} = $ref->{$_} } keys %$ref;
2882
2883   } else {
2884
2885     # get date
2886     $query =
2887        qq|SELECT
2888             current_date AS transdate, d.curr AS currencies, d.closedto, d.revtrans,
2889             (SELECT c.accno FROM chart c WHERE d.fxgain_accno_id = c.id) AS fxgain_accno,
2890             (SELECT c.accno FROM chart c WHERE d.fxloss_accno_id = c.id) AS fxloss_accno
2891           FROM defaults d|;
2892     $ref = selectfirst_hashref_query($self, $dbh, $query);
2893     map { $self->{$_} = $ref->{$_} } keys %$ref;
2894
2895     if ($self->{"$self->{vc}_id"}) {
2896
2897       # only setup currency
2898       ($self->{currency}) = split(/:/, $self->{currencies}) if !$self->{currency};
2899
2900     } else {
2901
2902       $self->lastname_used($dbh, $myconfig, $table, $module);
2903
2904       # get exchangerate for currency
2905       $self->{exchangerate} =
2906         $self->get_exchangerate($dbh, $self->{currency}, $self->{transdate}, $fld);
2907
2908     }
2909
2910   }
2911
2912   $main::lxdebug->leave_sub();
2913 }
2914
2915 sub lastname_used {
2916   $main::lxdebug->enter_sub();
2917
2918   my ($self, $dbh, $myconfig, $table, $module) = @_;
2919
2920   my ($arap, $where);
2921
2922   $table         = $table eq "customer" ? "customer" : "vendor";
2923   my %column_map = ("a.curr"                  => "currency",
2924                     "a.${table}_id"           => "${table}_id",
2925                     "a.department_id"         => "department_id",
2926                     "d.description"           => "department",
2927                     "ct.name"                 => $table,
2928                     "ct.curr"                 => "cv_curr",
2929                     "current_date + ct.terms" => "duedate",
2930     );
2931
2932   if ($self->{type} =~ /delivery_order/) {
2933     $arap  = 'delivery_orders';
2934     delete $column_map{"a.curr"};
2935     delete $column_map{"ct.curr"};
2936
2937   } elsif ($self->{type} =~ /_order/) {
2938     $arap  = 'oe';
2939     $where = "quotation = '0'";
2940
2941   } elsif ($self->{type} =~ /_quotation/) {
2942     $arap  = 'oe';
2943     $where = "quotation = '1'";
2944
2945   } elsif ($table eq 'customer') {
2946     $arap  = 'ar';
2947
2948   } else {
2949     $arap  = 'ap';
2950
2951   }
2952
2953   $where           = "($where) AND" if ($where);
2954   my $query        = qq|SELECT MAX(id) FROM $arap
2955                         WHERE $where ${table}_id > 0|;
2956   my ($trans_id)   = selectrow_query($self, $dbh, $query);
2957   $trans_id       *= 1;
2958
2959   my $column_spec  = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
2960   $query           = qq|SELECT $column_spec
2961                         FROM $arap a
2962                         LEFT JOIN $table     ct ON (a.${table}_id = ct.id)
2963                         LEFT JOIN department d  ON (a.department_id = d.id)
2964                         WHERE a.id = ?|;
2965   my $ref          = selectfirst_hashref_query($self, $dbh, $query, $trans_id);
2966
2967   map { $self->{$_} = $ref->{$_} } values %column_map;
2968
2969   # remove any trailing whitespace
2970   $self->{currency} =~ s/\s*$// if $self->{currency};
2971   $self->{cv_curr} =~ s/\s*$// if $self->{cv_curr};
2972
2973   # if customer/vendor currency is set use this
2974   $self->{currency} = $self->{cv_curr} if $self->{cv_curr};
2975
2976   $main::lxdebug->leave_sub();
2977 }
2978
2979 sub current_date {
2980   $main::lxdebug->enter_sub();
2981
2982   my $self     = shift;
2983   my $myconfig = shift || \%::myconfig;
2984   my ($thisdate, $days) = @_;
2985
2986   my $dbh = $self->get_standard_dbh($myconfig);
2987   my $query;
2988
2989   $days *= 1;
2990   if ($thisdate) {
2991     my $dateformat = $myconfig->{dateformat};
2992     $dateformat .= "yy" if $myconfig->{dateformat} !~ /^y/;
2993     $thisdate = $dbh->quote($thisdate);
2994     $query = qq|SELECT to_date($thisdate, '$dateformat') + $days AS thisdate|;
2995   } else {
2996     $query = qq|SELECT current_date AS thisdate|;
2997   }
2998
2999   ($thisdate) = selectrow_query($self, $dbh, $query);
3000
3001   $main::lxdebug->leave_sub();
3002
3003   return $thisdate;
3004 }
3005
3006 sub like {
3007   $main::lxdebug->enter_sub();
3008
3009   my ($self, $string) = @_;
3010
3011   if ($string !~ /%/) {
3012     $string = "%$string%";
3013   }
3014
3015   $string =~ s/\'/\'\'/g;
3016
3017   $main::lxdebug->leave_sub();
3018
3019   return $string;
3020 }
3021
3022 sub redo_rows {
3023   $main::lxdebug->enter_sub();
3024
3025   my ($self, $flds, $new, $count, $numrows) = @_;
3026
3027   my @ndx = ();
3028
3029   map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count;
3030
3031   my $i = 0;
3032
3033   # fill rows
3034   foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
3035     $i++;
3036     my $j = $item->{ndx} - 1;
3037     map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
3038   }
3039
3040   # delete empty rows
3041   for $i ($count + 1 .. $numrows) {
3042     map { delete $self->{"${_}_$i"} } @{$flds};
3043   }
3044
3045   $main::lxdebug->leave_sub();
3046 }
3047
3048 sub update_status {
3049   $main::lxdebug->enter_sub();
3050
3051   my ($self, $myconfig) = @_;
3052
3053   my ($i, $id);
3054
3055   my $dbh = $self->dbconnect_noauto($myconfig);
3056
3057   my $query = qq|DELETE FROM status
3058                  WHERE (formname = ?) AND (trans_id = ?)|;
3059   my $sth = prepare_query($self, $dbh, $query);
3060
3061   if ($self->{formname} =~ /(check|receipt)/) {
3062     for $i (1 .. $self->{rowcount}) {
3063       do_statement($self, $sth, $query, $self->{formname}, $self->{"id_$i"} * 1);
3064     }
3065   } else {
3066     do_statement($self, $sth, $query, $self->{formname}, $self->{id});
3067   }
3068   $sth->finish();
3069
3070   my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3071   my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3072
3073   my %queued = split / /, $self->{queued};
3074   my @values;
3075
3076   if ($self->{formname} =~ /(check|receipt)/) {
3077
3078     # this is a check or receipt, add one entry for each lineitem
3079     my ($accno) = split /--/, $self->{account};
3080     $query = qq|INSERT INTO status (trans_id, printed, spoolfile, formname, chart_id)
3081                 VALUES (?, ?, ?, ?, (SELECT c.id FROM chart c WHERE c.accno = ?))|;
3082     @values = ($printed, $queued{$self->{formname}}, $self->{prinform}, $accno);
3083     $sth = prepare_query($self, $dbh, $query);
3084
3085     for $i (1 .. $self->{rowcount}) {
3086       if ($self->{"checked_$i"}) {
3087         do_statement($self, $sth, $query, $self->{"id_$i"}, @values);
3088       }
3089     }
3090     $sth->finish();
3091
3092   } else {
3093     $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
3094                 VALUES (?, ?, ?, ?, ?)|;
3095     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed,
3096              $queued{$self->{formname}}, $self->{formname});
3097   }
3098
3099   $dbh->commit;
3100   $dbh->disconnect;
3101
3102   $main::lxdebug->leave_sub();
3103 }
3104
3105 sub save_status {
3106   $main::lxdebug->enter_sub();
3107
3108   my ($self, $dbh) = @_;
3109
3110   my ($query, $printed, $emailed);
3111
3112   my $formnames  = $self->{printed};
3113   my $emailforms = $self->{emailed};
3114
3115   $query = qq|DELETE FROM status
3116                  WHERE (formname = ?) AND (trans_id = ?)|;
3117   do_query($self, $dbh, $query, $self->{formname}, $self->{id});
3118
3119   # this only applies to the forms
3120   # checks and receipts are posted when printed or queued
3121
3122   if ($self->{queued}) {
3123     my %queued = split / /, $self->{queued};
3124
3125     foreach my $formname (keys %queued) {
3126       $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3127       $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0";
3128
3129       $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname)
3130                   VALUES (?, ?, ?, ?, ?)|;
3131       do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname);
3132
3133       $formnames  =~ s/\Q$self->{formname}\E//;
3134       $emailforms =~ s/\Q$self->{formname}\E//;
3135
3136     }
3137   }
3138
3139   # save printed, emailed info
3140   $formnames  =~ s/^ +//g;
3141   $emailforms =~ s/^ +//g;
3142
3143   my %status = ();
3144   map { $status{$_}{printed} = 1 } split / +/, $formnames;
3145   map { $status{$_}{emailed} = 1 } split / +/, $emailforms;
3146
3147   foreach my $formname (keys %status) {
3148     $printed = ($formnames  =~ /\Q$self->{formname}\E/) ? "1" : "0";
3149     $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0";
3150
3151     $query = qq|INSERT INTO status (trans_id, printed, emailed, formname)
3152                 VALUES (?, ?, ?, ?)|;
3153     do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $formname);
3154   }
3155
3156   $main::lxdebug->leave_sub();
3157 }
3158
3159 #--- 4 locale ---#
3160 # $main::locale->text('SAVED')
3161 # $main::locale->text('DELETED')
3162 # $main::locale->text('ADDED')
3163 # $main::locale->text('PAYMENT POSTED')
3164 # $main::locale->text('POSTED')
3165 # $main::locale->text('POSTED AS NEW')
3166 # $main::locale->text('ELSE')
3167 # $main::locale->text('SAVED FOR DUNNING')
3168 # $main::locale->text('DUNNING STARTED')
3169 # $main::locale->text('PRINTED')
3170 # $main::locale->text('MAILED')
3171 # $main::locale->text('SCREENED')
3172 # $main::locale->text('CANCELED')
3173 # $main::locale->text('invoice')
3174 # $main::locale->text('proforma')
3175 # $main::locale->text('sales_order')
3176 # $main::locale->text('pick_list')
3177 # $main::locale->text('purchase_order')
3178 # $main::locale->text('bin_list')
3179 # $main::locale->text('sales_quotation')
3180 # $main::locale->text('request_quotation')
3181
3182 sub save_history {
3183   $main::lxdebug->enter_sub();
3184
3185   my $self = shift;
3186   my $dbh  = shift || $self->get_standard_dbh;
3187
3188   if(!exists $self->{employee_id}) {
3189     &get_employee($self, $dbh);
3190   }
3191
3192   my $query =
3193    qq|INSERT INTO history_erp (trans_id, employee_id, addition, what_done, snumbers) | .
3194    qq|VALUES (?, (SELECT id FROM employee WHERE login = ?), ?, ?, ?)|;
3195   my @values = (conv_i($self->{id}), $self->{login},
3196                 $self->{addition}, $self->{what_done}, "$self->{snumbers}");
3197   do_query($self, $dbh, $query, @values);
3198
3199   $dbh->commit;
3200
3201   $main::lxdebug->leave_sub();
3202 }
3203
3204 sub get_history {
3205   $main::lxdebug->enter_sub();
3206
3207   my ($self, $dbh, $trans_id, $restriction, $order) = @_;
3208   my ($orderBy, $desc) = split(/\-\-/, $order);
3209   $order = " ORDER BY " . ($order eq "" ? " h.itime " : ($desc == 1 ? $orderBy . " DESC " : $orderBy . " "));
3210   my @tempArray;
3211   my $i = 0;
3212   if ($trans_id ne "") {
3213     my $query =
3214       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 | .
3215       qq|FROM history_erp h | .
3216       qq|LEFT JOIN employee emp ON (emp.id = h.employee_id) | .
3217       qq|WHERE (trans_id = | . $trans_id . qq|) $restriction | .
3218       $order;
3219
3220     my $sth = $dbh->prepare($query) || $self->dberror($query);
3221
3222     $sth->execute() || $self->dberror("$query");
3223
3224     while(my $hash_ref = $sth->fetchrow_hashref()) {
3225       $hash_ref->{addition} = $main::locale->text($hash_ref->{addition});
3226       $hash_ref->{what_done} = $main::locale->text($hash_ref->{what_done});
3227       $hash_ref->{snumbers} =~ s/^.+_(.*)$/$1/g;
3228       $tempArray[$i++] = $hash_ref;
3229     }
3230     $main::lxdebug->leave_sub() and return \@tempArray
3231       if ($i > 0 && $tempArray[0] ne "");
3232   }
3233   $main::lxdebug->leave_sub();
3234   return 0;
3235 }
3236
3237 sub update_defaults {
3238   $main::lxdebug->enter_sub();
3239
3240   my ($self, $myconfig, $fld, $provided_dbh) = @_;
3241
3242   my $dbh;
3243   if ($provided_dbh) {
3244     $dbh = $provided_dbh;
3245   } else {
3246     $dbh = $self->dbconnect_noauto($myconfig);
3247   }
3248   my $query = qq|SELECT $fld FROM defaults FOR UPDATE|;
3249   my $sth   = $dbh->prepare($query);
3250
3251   $sth->execute || $self->dberror($query);
3252   my ($var) = $sth->fetchrow_array;
3253   $sth->finish;
3254
3255   if ($var =~ m/\d+$/) {
3256     my $new_var  = (substr $var, $-[0]) * 1 + 1;
3257     my $len_diff = length($var) - $-[0] - length($new_var);
3258     $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
3259
3260   } else {
3261     $var = $var . '1';
3262   }
3263
3264   $query = qq|UPDATE defaults SET $fld = ?|;
3265   do_query($self, $dbh, $query, $var);
3266
3267   if (!$provided_dbh) {
3268     $dbh->commit;
3269     $dbh->disconnect;
3270   }
3271
3272   $main::lxdebug->leave_sub();
3273
3274   return $var;
3275 }
3276
3277 sub update_business {
3278   $main::lxdebug->enter_sub();
3279
3280   my ($self, $myconfig, $business_id, $provided_dbh) = @_;
3281
3282   my $dbh;
3283   if ($provided_dbh) {
3284     $dbh = $provided_dbh;
3285   } else {
3286     $dbh = $self->dbconnect_noauto($myconfig);
3287   }
3288   my $query =
3289     qq|SELECT customernumberinit FROM business
3290        WHERE id = ? FOR UPDATE|;
3291   my ($var) = selectrow_query($self, $dbh, $query, $business_id);
3292
3293   return undef unless $var;
3294
3295   if ($var =~ m/\d+$/) {
3296     my $new_var  = (substr $var, $-[0]) * 1 + 1;
3297     my $len_diff = length($var) - $-[0] - length($new_var);
3298     $var         = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var;
3299
3300   } else {
3301     $var = $var . '1';
3302   }
3303
3304   $query = qq|UPDATE business
3305               SET customernumberinit = ?
3306               WHERE id = ?|;
3307   do_query($self, $dbh, $query, $var, $business_id);
3308
3309   if (!$provided_dbh) {
3310     $dbh->commit;
3311     $dbh->disconnect;
3312   }
3313
3314   $main::lxdebug->leave_sub();
3315
3316   return $var;
3317 }
3318
3319 sub get_partsgroup {
3320   $main::lxdebug->enter_sub();
3321
3322   my ($self, $myconfig, $p) = @_;
3323   my $target = $p->{target} || 'all_partsgroup';
3324
3325   my $dbh = $self->get_standard_dbh($myconfig);
3326
3327   my $query = qq|SELECT DISTINCT pg.id, pg.partsgroup
3328                  FROM partsgroup pg
3329                  JOIN parts p ON (p.partsgroup_id = pg.id) |;
3330   my @values;
3331
3332   if ($p->{searchitems} eq 'part') {
3333     $query .= qq|WHERE p.inventory_accno_id > 0|;
3334   }
3335   if ($p->{searchitems} eq 'service') {
3336     $query .= qq|WHERE p.inventory_accno_id IS NULL|;
3337   }
3338   if ($p->{searchitems} eq 'assembly') {
3339     $query .= qq|WHERE p.assembly = '1'|;
3340   }
3341   if ($p->{searchitems} eq 'labor') {
3342     $query .= qq|WHERE (p.inventory_accno_id > 0) AND (p.income_accno_id IS NULL)|;
3343   }
3344
3345   $query .= qq|ORDER BY partsgroup|;
3346
3347   if ($p->{all}) {
3348     $query = qq|SELECT id, partsgroup FROM partsgroup
3349                 ORDER BY partsgroup|;
3350   }
3351
3352   if ($p->{language_code}) {
3353     $query = qq|SELECT DISTINCT pg.id, pg.partsgroup,
3354                   t.description AS translation
3355                 FROM partsgroup pg
3356                 JOIN parts p ON (p.partsgroup_id = pg.id)
3357                 LEFT JOIN translation t ON ((t.trans_id = pg.id) AND (t.language_code = ?))
3358                 ORDER BY translation|;
3359     @values = ($p->{language_code});
3360   }
3361
3362   $self->{$target} = selectall_hashref_query($self, $dbh, $query, @values);
3363
3364   $main::lxdebug->leave_sub();
3365 }
3366
3367 sub get_pricegroup {
3368   $main::lxdebug->enter_sub();
3369
3370   my ($self, $myconfig, $p) = @_;
3371
3372   my $dbh = $self->get_standard_dbh($myconfig);
3373
3374   my $query = qq|SELECT p.id, p.pricegroup
3375                  FROM pricegroup p|;
3376
3377   $query .= qq| ORDER BY pricegroup|;
3378
3379   if ($p->{all}) {
3380     $query = qq|SELECT id, pricegroup FROM pricegroup
3381                 ORDER BY pricegroup|;
3382   }
3383
3384   $self->{all_pricegroup} = selectall_hashref_query($self, $dbh, $query);
3385
3386   $main::lxdebug->leave_sub();
3387 }
3388
3389 sub all_years {
3390 # usage $form->all_years($myconfig, [$dbh])
3391 # return list of all years where bookings found
3392 # (@all_years)
3393
3394   $main::lxdebug->enter_sub();
3395
3396   my ($self, $myconfig, $dbh) = @_;
3397
3398   $dbh ||= $self->get_standard_dbh($myconfig);
3399
3400   # get years
3401   my $query = qq|SELECT (SELECT MIN(transdate) FROM acc_trans),
3402                    (SELECT MAX(transdate) FROM acc_trans)|;
3403   my ($startdate, $enddate) = selectrow_query($self, $dbh, $query);
3404
3405   if ($myconfig->{dateformat} =~ /^yy/) {
3406     ($startdate) = split /\W/, $startdate;
3407     ($enddate) = split /\W/, $enddate;
3408   } else {
3409     (@_) = split /\W/, $startdate;
3410     $startdate = $_[2];
3411     (@_) = split /\W/, $enddate;
3412     $enddate = $_[2];
3413   }
3414
3415   my @all_years;
3416   $startdate = substr($startdate,0,4);
3417   $enddate = substr($enddate,0,4);
3418
3419   while ($enddate >= $startdate) {
3420     push @all_years, $enddate--;
3421   }
3422
3423   return @all_years;
3424
3425   $main::lxdebug->leave_sub();
3426 }
3427
3428 sub backup_vars {
3429   $main::lxdebug->enter_sub();
3430   my $self = shift;
3431   my @vars = @_;
3432
3433   map { $self->{_VAR_BACKUP}->{$_} = $self->{$_} if exists $self->{$_} } @vars;
3434
3435   $main::lxdebug->leave_sub();
3436 }
3437
3438 sub restore_vars {
3439   $main::lxdebug->enter_sub();
3440
3441   my $self = shift;
3442   my @vars = @_;
3443
3444   map { $self->{$_} = $self->{_VAR_BACKUP}->{$_} if exists $self->{_VAR_BACKUP}->{$_} } @vars;
3445
3446   $main::lxdebug->leave_sub();
3447 }
3448
3449 sub prepare_for_printing {
3450   my ($self) = @_;
3451
3452   $self->{templates} ||= $::myconfig{templates};
3453   $self->{formname}  ||= $self->{type};
3454   $self->{media}     ||= 'email';
3455
3456   die "'media' other than 'email', 'file', 'printer' is not supported yet" unless $self->{media} =~ m/^(?:email|file|printer)$/;
3457
3458   # set shipto from billto unless set
3459   my $has_shipto = any { $self->{"shipto$_"} } qw(name street zipcode city country contact);
3460   if (!$has_shipto && ($self->{type} =~ m/^(?:purchase_order|request_quotation)$/)) {
3461     $self->{shiptoname}   = $::myconfig{company};
3462     $self->{shiptostreet} = $::myconfig{address};
3463   }
3464
3465   my $language = $self->{language} ? '_' . $self->{language} : '';
3466
3467   my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);
3468   if ($self->{language_id}) {
3469     ($language_tc, $output_numberformat, $output_dateformat, $output_longdates) = AM->get_language_details(\%::myconfig, $self, $self->{language_id});
3470   } else {
3471     $output_dateformat   = $::myconfig{dateformat};
3472     $output_numberformat = $::myconfig{numberformat};
3473     $output_longdates    = 1;
3474   }
3475
3476   # Retrieve accounts for tax calculation.
3477   IC->retrieve_accounts(\%::myconfig, $self, map { $_ => $self->{"id_$_"} } 1 .. $self->{rowcount});
3478
3479   if ($self->{type} =~ /_delivery_order$/) {
3480     DO->order_details();
3481   } elsif ($self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/) {
3482     OE->order_details(\%::myconfig, $self);
3483   } else {
3484     IS->invoice_details(\%::myconfig, $self, $::locale);
3485   }
3486
3487   # Chose extension & set source file name
3488   my $extension = 'html';
3489   if ($self->{format} eq 'postscript') {
3490     $self->{postscript}   = 1;
3491     $extension            = 'tex';
3492   } elsif ($self->{"format"} =~ /pdf/) {
3493     $self->{pdf}          = 1;
3494     $extension            = $self->{'format'} =~ m/opendocument/i ? 'odt' : 'tex';
3495   } elsif ($self->{"format"} =~ /opendocument/) {
3496     $self->{opendocument} = 1;
3497     $extension            = 'odt';
3498   } elsif ($self->{"format"} =~ /excel/) {
3499     $self->{excel}        = 1;
3500     $extension            = 'xls';
3501   }
3502
3503   my $printer_code    = $self->{printer_code} ? '_' . $self->{printer_code} : '';
3504   my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : '';
3505   $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
3506
3507   # Format dates.
3508   $self->format_dates($output_dateformat, $output_longdates,
3509                       qw(invdate orddate quodate pldate duedate reqdate transdate shippingdate deliverydate validitydate paymentdate datepaid
3510                          transdate_oe deliverydate_oe employee_startdate employee_enddate),
3511                       grep({ /^(?:datepaid|transdate_oe|reqdate|deliverydate|deliverydate_oe|transdate)_\d+$/ } keys(%{$self})));
3512
3513   $self->reformat_numbers($output_numberformat, 2,
3514                           qw(invtotal ordtotal quototal subtotal linetotal listprice sellprice netprice discount tax taxbase total paid),
3515                           grep({ /^(?:linetotal|listprice|sellprice|netprice|taxbase|discount|paid|subtotal|total|tax)_\d+$/ } keys(%{$self})));
3516
3517   $self->reformat_numbers($output_numberformat, undef, qw(qty price_factor), grep({ /^qty_\d+$/} keys(%{$self})));
3518
3519   my ($cvar_date_fields, $cvar_number_fields) = CVar->get_field_format_list('module' => 'CT', 'prefix' => 'vc_');
3520
3521   if (scalar @{ $cvar_date_fields }) {
3522     $self->format_dates($output_dateformat, $output_longdates, @{ $cvar_date_fields });
3523   }
3524
3525   while (my ($precision, $field_list) = each %{ $cvar_number_fields }) {
3526     $self->reformat_numbers($output_numberformat, $precision, @{ $field_list });
3527   }
3528
3529   return $self;
3530 }
3531
3532 sub format_dates {
3533   my ($self, $dateformat, $longformat, @indices) = @_;
3534
3535   $dateformat ||= $::myconfig{dateformat};
3536
3537   foreach my $idx (@indices) {
3538     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3539       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3540         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $dateformat, $longformat);
3541       }
3542     }
3543
3544     next unless defined $self->{$idx};
3545
3546     if (!ref($self->{$idx})) {
3547       $self->{$idx} = $::locale->reformat_date(\%::myconfig, $self->{$idx}, $dateformat, $longformat);
3548
3549     } elsif (ref($self->{$idx}) eq "ARRAY") {
3550       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3551         $self->{$idx}->[$i] = $::locale->reformat_date(\%::myconfig, $self->{$idx}->[$i], $dateformat, $longformat);
3552       }
3553     }
3554   }
3555 }
3556
3557 sub reformat_numbers {
3558   my ($self, $numberformat, $places, @indices) = @_;
3559
3560   return if !$numberformat || ($numberformat eq $::myconfig{numberformat});
3561
3562   foreach my $idx (@indices) {
3563     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3564       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3565         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i]);
3566       }
3567     }
3568
3569     next unless defined $self->{$idx};
3570
3571     if (!ref($self->{$idx})) {
3572       $self->{$idx} = $self->parse_amount(\%::myconfig, $self->{$idx});
3573
3574     } elsif (ref($self->{$idx}) eq "ARRAY") {
3575       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3576         $self->{$idx}->[$i] = $self->parse_amount(\%::myconfig, $self->{$idx}->[$i]);
3577       }
3578     }
3579   }
3580
3581   my $saved_numberformat    = $::myconfig{numberformat};
3582   $::myconfig{numberformat} = $numberformat;
3583
3584   foreach my $idx (@indices) {
3585     if ($self->{TEMPLATE_ARRAYS} && (ref($self->{TEMPLATE_ARRAYS}->{$idx}) eq "ARRAY")) {
3586       for (my $i = 0; $i < scalar(@{ $self->{TEMPLATE_ARRAYS}->{$idx} }); $i++) {
3587         $self->{TEMPLATE_ARRAYS}->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{TEMPLATE_ARRAYS}->{$idx}->[$i], $places);
3588       }
3589     }
3590
3591     next unless defined $self->{$idx};
3592
3593     if (!ref($self->{$idx})) {
3594       $self->{$idx} = $self->format_amount(\%::myconfig, $self->{$idx}, $places);
3595
3596     } elsif (ref($self->{$idx}) eq "ARRAY") {
3597       for (my $i = 0; $i < scalar(@{ $self->{$idx} }); $i++) {
3598         $self->{$idx}->[$i] = $self->format_amount(\%::myconfig, $self->{$idx}->[$i], $places);
3599       }
3600     }
3601   }
3602
3603   $::myconfig{numberformat} = $saved_numberformat;
3604 }
3605
3606 1;
3607
3608 __END__
3609
3610 =head1 NAME
3611
3612 SL::Form.pm - main data object.
3613
3614 =head1 SYNOPSIS
3615
3616 This is the main data object of Lx-Office.
3617 Unfortunately it also acts as a god object for certain data retrieval procedures used in the entry points.
3618 Points of interest for a beginner are:
3619
3620  - $form->error            - renders a generic error in html. accepts an error message
3621  - $form->get_standard_dbh - returns a database connection for the
3622
3623 =head1 SPECIAL FUNCTIONS
3624
3625 =head2 C<update_business> PARAMS
3626
3627 PARAMS (not named):
3628  \%config,     - config hashref
3629  $business_id, - business id
3630  $dbh          - optional database handle
3631
3632 handles business (thats customer/vendor types) sequences.
3633
3634 special behaviour for empty strings in customerinitnumber field:
3635 will in this case not increase the value, and return undef.
3636
3637 =head2 C<redirect_header> $url
3638
3639 Generates a HTTP redirection header for the new C<$url>. Constructs an
3640 absolute URL including scheme, host name and port. If C<$url> is a
3641 relative URL then it is considered relative to Lx-Office base URL.
3642
3643 This function C<die>s if headers have already been created with
3644 C<$::form-E<gt>header>.
3645
3646 Examples:
3647
3648   print $::form->redirect_header('oe.pl?action=edit&id=1234');
3649   print $::form->redirect_header('http://www.lx-office.org/');
3650
3651 =head2 C<header>
3652
3653 Generates a general purpose http/html header and includes most of the scripts
3654 and stylesheets needed. Stylesheets can be added with L<use_stylesheet>.
3655
3656 Only one header will be generated. If the method was already called in this
3657 request it will not output anything and return undef. Also if no
3658 HTTP_USER_AGENT is found, no header is generated.
3659
3660 Although header does not accept parameters itself, it will honor special
3661 hashkeys of its Form instance:
3662
3663 =over 4
3664
3665 =item refresh_time
3666
3667 =item refresh_url
3668
3669 If one of these is set, a http-equiv refresh is generated. Missing parameters
3670 default to 3 seconds and the refering url.
3671
3672 =item stylesheet
3673
3674 Either a scalar or an array ref. Will be inlined into the header. Add
3675 stylesheets with the L<use_stylesheet> function.
3676
3677 =item landscape
3678
3679 If true, a css snippet will be generated that sets the page in landscape mode.
3680
3681 =item favicon
3682
3683 Used to override the default favicon.
3684
3685 =item title
3686
3687 A html page title will be generated from this
3688
3689 =back
3690
3691 =cut