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