SL/Form.pm

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