SL/Form.pm

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