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