SL/Form.pm

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