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