SL/Form.pm

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