Strict in 4 Dateien wieder deaktiviert.
[kivitendo-erp.git] / SL / Form.pm
index fd07f55..0ec6b8a 100644 (file)
 #======================================================================
 
 package Form;
+
+#use strict;
+
 use Data::Dumper;
 
 use CGI;
 use CGI::Ajax;
 use Cwd;
-use List::Util qw(min max);
+use IO::File;
 use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
@@ -57,7 +60,7 @@ use List::Util qw(first max min sum);
 
 my $standard_dbh;
 
-sub DESTROY {
+END {
   if ($standard_dbh) {
     $standard_dbh->disconnect();
     undef $standard_dbh;
@@ -222,7 +225,7 @@ sub new {
   $self->{action}  =  lc $self->{action};
   $self->{action}  =~ s/( |-|,|\#)/_/g;
 
-  $self->{version} =  "2.4.3";
+  $self->{version} =  "2.6.0 beta 1";
 
   $main::lxdebug->leave_sub();
 
@@ -471,7 +474,7 @@ sub isblank {
   my ($self, $name, $msg) = @_;
 
   my $curr = $self;
-  foreach my $part (split /\./, $name) {
+  foreach my $part (split m/\./, $name) {
     if (!$curr->{$part} || ($curr->{$part} =~ /^\s*$/)) {
       $self->error($msg);
     }
@@ -512,7 +515,7 @@ sub create_http_response {
   }
 
   my %cgi_params = ('-type' => $params{content_type});
-  $cgi_params{'-charset'} = $params{charset} if ($parmas{charset});
+  $cgi_params{'-charset'} = $params{charset} if ($params{charset});
 
   my $output = $cgi->header('-cookie' => $session_cookie,
                             %cgi_params);
@@ -533,7 +536,7 @@ sub header {
     return;
   }
 
-  my ($stylesheet, $favicon);
+  my ($stylesheet, $favicon, $pagelayout);
 
   if ($ENV{HTTP_USER_AGENT}) {
     my $doctype;
@@ -591,7 +594,7 @@ sub header {
       ? "$self->{title} - $self->{titlebar}"
       : $self->{titlebar};
     my $ajax = "";
-    foreach $item (@ { $self->{AJAX} }) {
+    foreach my $item (@ { $self->{AJAX} }) {
       $ajax .= $item->show_javascript();
     }
 
@@ -599,17 +602,17 @@ sub header {
                                       'charset'      => $db_charset,);
     print qq|${doctype}<html>
 <head>
+  <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=${db_charset}">
   <title>$self->{titlebar}</title>
   $stylesheet
   $pagelayout
   $favicon
-  <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=${db_charset}">
   $jsscript
   $ajax
 
   <script type="text/javascript">
   <!--
-    function fokus() {
+    function focus() {
       $fokus
     }
   //-->
@@ -617,15 +620,15 @@ sub header {
 
   <meta name="robots" content="noindex,nofollow" />
   <script type="text/javascript" src="js/highlight_input.js"></script>
-  <link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
 
+  <link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
   <script type="text/javascript" src="js/tabcontent.js">
 
   /***********************************************
-  * Tab Content script- Dynamic Drive DHTML code library (www.dynamicdrive.com)
-  * This notice MUST stay intact for legal use
-  * Visit Dynamic Drive at http://www.dynamicdrive.com/ for full source code
-  ***********************************************/
+   * Tab Content script v2.2- © Dynamic Drive DHTML code library (www.dynamicdrive.com)
+   * This notice MUST stay intact for legal use
+   * Visit Dynamic Drive at http://www.dynamicdrive.com/ for full source code
+   ***********************************************/
 
   </script>
 
@@ -639,6 +642,20 @@ sub header {
   $main::lxdebug->leave_sub();
 }
 
+sub ajax_response_header {
+  $main::lxdebug->enter_sub();
+
+  my ($self) = @_;
+
+  my $db_charset = $main::dbcharset ? $main::dbcharset : Common::DEFAULT_CHARSET;
+  my $cgi        = $main::cgi || CGI->new('');
+  my $output     = $cgi->header('-charset' => $db_charset);
+
+  $main::lxdebug->leave_sub();
+
+  return $output;
+}
+
 sub _prepare_html_template {
   $main::lxdebug->enter_sub();
 
@@ -691,6 +708,7 @@ sub _prepare_html_template {
     $additional_params->{"myconfig_jsc_dateformat"} = $jsc_dateformat;
   }
 
+  $additional_params->{"conf_dbcharset"}              = $main::dbcharset;
   $additional_params->{"conf_webdav"}                 = $main::webdav;
   $additional_params->{"conf_lizenzen"}               = $main::lizenzen;
   $additional_params->{"conf_latex_templates"}        = $main::latex;
@@ -730,19 +748,34 @@ sub parse_html_template {
 
   map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self };
 
+  my $in = IO::File->new($file, 'r');
+
+  if (!$in) {
+    print STDERR "Error opening template file: $!";
+    $main::lxdebug->leave_sub();
+    return '';
+  }
+
+  my $input = join('', <$in>);
+  $in->close();
+
+  if ($main::locale) {
+    $input = $main::locale->{iconv}->convert($input);
+  }
+
   my $output;
-  if (!$template->process($file, $additional_params, \$output)) {
+  if (!$template->process(\$input, $additional_params, \$output)) {
     print STDERR $template->error();
   }
 
-  $output = $main::locale->{iconv}->convert($output) if ($main::locale);
-
   $main::lxdebug->leave_sub();
 
   return $output;
 }
 
 sub show_generic_error {
+  $main::lxdebug->enter_sub();
+
   my ($self, $error, %params) = @_;
 
   my $add_params = {
@@ -764,15 +797,19 @@ sub show_generic_error {
     $add_params->{SHOW_BACK_BUTTON} = 1;
   }
 
-  $self->{title} = $title if ($title);
+  $self->{title} = $params{title} if $params{title};
 
   $self->header();
   print $self->parse_html_template("generic/error", $add_params);
 
+  $main::lxdebug->leave_sub();
+
   die("Error: $error\n");
 }
 
 sub show_generic_information {
+  $main::lxdebug->enter_sub();
+
   my ($self, $text, $title) = @_;
 
   my $add_params = {
@@ -785,7 +822,9 @@ sub show_generic_information {
   $self->header();
   print $self->parse_html_template("generic/information", $add_params);
 
-  die("Information: $error\n");
+  $main::lxdebug->leave_sub();
+
+  die("Information: $text\n");
 }
 
 # write Trigger JavaScript-Code ($qty = quantity of Triggers)
@@ -808,8 +847,8 @@ sub write_trigger {
     "yyyy-mm-dd" => "%Y-%m-%d",
     );
 
-  my $ifFormat = defined($dateformats{$myconfig{"dateformat"}}) ?
-    $dateformats{$myconfig{"dateformat"}} : "%d.%m.%Y";
+  my $ifFormat = defined($dateformats{$myconfig->{"dateformat"}}) ?
+    $dateformats{$myconfig->{"dateformat"}} : "%d.%m.%Y";
 
   my @triggers;
   while ($#_ >= 2) {
@@ -842,7 +881,7 @@ sub redirect {
 
   if ($self->{callback}) {
 
-    ($script, $argv) = split(/\?/, $self->{callback}, 2);
+    my ($script, $argv) = split(/\?/, $self->{callback}, 2);
     $script =~ s|.*/||;
     $script =~ s|[^a-zA-Z0-9_\.]||g;
     exec("perl", "$script", $argv);
@@ -920,16 +959,19 @@ sub format_amount_units {
   my $self             = shift;
   my %params           = @_;
 
-  Common::check_params(\%params, qw(amount part_unit));
-
   my $myconfig         = \%main::myconfig;
-  my $amount           = $params{amount};
+  my $amount           = $params{amount} * 1;
   my $places           = $params{places};
   my $part_unit_name   = $params{part_unit};
   my $amount_unit_name = $params{amount_unit};
   my $conv_units       = $params{conv_units};
   my $max_places       = $params{max_places};
 
+  if (!$part_unit_name) {
+    $main::lxdebug->leave_sub();
+    return '';
+  }
+
   AM->retrieve_all_units();
   my $all_units        = $main::all_units;
 
@@ -949,6 +991,7 @@ sub format_amount_units {
   $amount       *= $conv_unit->{factor};
 
   my @values;
+  my $num;
 
   foreach my $unit (@$conv_units) {
     my $last = $unit->{name} eq $part_unit->{name};
@@ -1076,13 +1119,11 @@ sub parse_template {
   # Copy the notes from the invoice/sales order etc. back to the variable "notes" because that is where most templates expect it to be.
   $self->{"notes"} = $self->{ $self->{"formname"} . "notes" };
 
-  map({ $self->{"employee_${_}"} = $myconfig->{$_}; }
-      qw(email tel fax name signature company address businessnumber
-         co_ustid taxnumber duns));
+  if (!$self->{employee_id}) {
+    map { $self->{"employee_${_}"} = $myconfig->{$_}; } qw(email tel fax name signature company address businessnumber co_ustid taxnumber duns);
+  }
 
-  map({ $self->{"${_}"} = $myconfig->{$_}; }
-      qw(co_ustid));
-              
+  map { $self->{"${_}"} = $myconfig->{$_}; } qw(co_ustid);
 
   $self->{copies} = 1 if (($self->{copies} *= 1) <= 0);
 
@@ -1277,14 +1318,19 @@ sub generate_attachment_filename {
   my $attachment_filename = $main::locale->unquote_special_chars('HTML', $self->get_formname_translation());
   my $prefix              = $self->get_number_prefix_for_type();
 
-  if ($attachment_filename && $self->{"${prefix}number"}) {
+  if ($self->{preview} && (first { $self->{type} eq $_ } qw(invoice credit_note))) {
+    $attachment_filename .= ' (' . $main::locale->text('Preview') . ')' . $self->get_extension_for_format();
+
+  } elsif ($attachment_filename && $self->{"${prefix}number"}) {
     $attachment_filename .=  "_" . $self->{"${prefix}number"} . $self->get_extension_for_format();
-    $attachment_filename  =  $main::locale->quote_special_chars('filenames', $attachment_filename);
-    $attachment_filename  =~ s|[\s/\\]+|_|g;
+
   } else {
     $attachment_filename = "";
   }
 
+  $attachment_filename =  $main::locale->quote_special_chars('filenames', $attachment_filename);
+  $attachment_filename =~ s|[\s/\\]+|_|g;
+
   return $attachment_filename;
 }
 
@@ -1334,6 +1380,7 @@ sub datetonum {
   $main::lxdebug->enter_sub();
 
   my ($self, $date, $myconfig) = @_;
+  my ($yy, $mm, $dd);
 
   if ($date && $date =~ /\D/) {
 
@@ -1392,7 +1439,7 @@ sub dbconnect_noauto {
   my ($self, $myconfig) = @_;
   
   # connect to database
-  $dbh =
+  my $dbh =
     DBI->connect($myconfig->{dbconnect}, $myconfig->{dbuser},
                  $myconfig->{dbpasswd}, { AutoCommit => 0 })
     or $self->dberror;
@@ -1412,6 +1459,11 @@ sub get_standard_dbh {
 
   my ($self, $myconfig) = @_;
 
+  if ($standard_dbh && !$standard_dbh->{Active}) {
+    $main::lxdebug->message(LXDebug::INFO, "get_standard_dbh: \$standard_dbh is defined but not Active anymore");
+    undef $standard_dbh;
+  }
+
   $standard_dbh ||= $self->dbconnect_noauto($myconfig);
 
   $main::lxdebug->leave_sub(2);
@@ -1847,28 +1899,31 @@ sub get_employee {
   $main::lxdebug->leave_sub();
 }
 
-sub get_salesman {
+sub get_employee_data {
   $main::lxdebug->enter_sub();
 
-  my ($self, $myconfig, $salesman_id) = @_;
+  my $self     = shift;
+  my %params   = @_;
 
-  $main::lxdebug->leave_sub() and return unless $salesman_id;
+  Common::check_params(\%params, qw(prefix));
+  Common::check_params_x(\%params, qw(id));
 
-  my $dbh = $self->get_standard_dbh($myconfig);
+  if (!$params{id}) {
+    $main::lxdebug->leave_sub();
+    return;
+  }
+
+  my $myconfig = \%main::myconfig;
+  my $dbh      = $params{dbh} || $self->get_standard_dbh($myconfig);
 
-  my ($login) =
-    selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|,
-                    $salesman_id);
+  my ($login)  = selectrow_query($self, $dbh, qq|SELECT login FROM employee WHERE id = ?|, conv_i($params{id}));
 
   if ($login) {
-    my $user = new User($main::memberfile, $login);
-    map({ $self->{"salesman_$_"} = $user->{$_}; }
-        qw(address businessnumber co_ustid company duns email fax name
-           taxnumber tel));
-    $self->{salesman_login} = $login;
+    my $user = User->new($login);
+    map { $self->{$params{prefix} . "_${_}"} = $user->{$_}; } qw(address businessnumber co_ustid company duns email fax name signature taxnumber tel);
 
-    $self->{salesman_name} = $login
-      if ($self->{salesman_name} eq "");
+    $self->{$params{prefix} . '_login'}   = $login;
+    $self->{$params{prefix} . '_name'}  ||= $login;
   }
 
   $main::lxdebug->leave_sub();
@@ -1893,6 +1948,12 @@ sub _get_contacts {
 
   $key = "all_contacts" unless ($key);
 
+  if (!$id) {
+    $self->{$key} = [];
+    $main::lxdebug->leave_sub();
+    return;
+  }
+
   my $query =
     qq|SELECT cp_id, cp_cv_id, cp_name, cp_givenname, cp_abteilung | .
     qq|FROM contacts | .
@@ -1961,10 +2022,15 @@ sub _get_shipto {
 
   $key = "all_shipto" unless ($key);
 
-  # get shipping addresses
-  my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
+  if ($vc_id) {
+    # get shipping addresses
+    my $query = qq|SELECT * FROM shipto WHERE trans_id = ?|;
 
-  $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
+    $self->{$key} = selectall_hashref_query($self, $dbh, $query, $vc_id);
+
+  } else {
+    $self->{$key} = [];
+  }
 
   $main::lxdebug->leave_sub();
 }
@@ -1987,6 +2053,7 @@ sub _get_charts {
   $main::lxdebug->enter_sub();
 
   my ($self, $dbh, $params) = @_;
+  my ($key);
 
   $key = $params->{key};
   $key = "all_charts" unless ($key);
@@ -2010,11 +2077,27 @@ sub _get_charts {
 sub _get_taxcharts {
   $main::lxdebug->enter_sub();
 
-  my ($self, $dbh, $key) = @_;
+  my ($self, $dbh, $params) = @_;
+
+  my $key = "all_taxcharts";
+  my @where;
+
+  if (ref $params eq 'HASH') {
+    $key = $params->{key} if ($params->{key});
+    if ($params->{module} eq 'AR') {
+      push @where, 'taxkey NOT IN (8, 9, 18, 19)';
+
+    } elsif ($params->{module} eq 'AP') {
+      push @where, 'taxkey NOT IN (1, 2, 3, 12, 13)';
+    }
 
-  $key = "all_taxcharts" unless ($key);
+  } elsif ($params) {
+    $key = $params;
+  }
+
+  my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where);
 
-  my $query = qq|SELECT * FROM tax ORDER BY taxkey|;
+  my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
 
   $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
@@ -2120,7 +2203,7 @@ sub _get_customers {
   my ($self, $dbh, $key, $limit) = @_;
 
   $key = "all_customers" unless ($key);
-  $limit_clause = "LIMIT $limit" if $limit;
+  my $limit_clause = "LIMIT $limit" if $limit;
 
   my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|;
 
@@ -2162,41 +2245,22 @@ sub _get_warehouses {
 
   my ($self, $dbh, $param) = @_;
 
-  my ($key, $bins_key, $q_access, @values);
+  my ($key, $bins_key);
 
   if ('' eq ref $param) {
     $key = $param;
+
   } else {
     $key      = $param->{key};
     $bins_key = $param->{bins};
-
-    if ($param->{access}) {
-      $q_access =
-        qq| AND EXISTS (
-              SELECT wa.employee_id
-              FROM warehouse_access wa
-              WHERE (wa.employee_id  = (SELECT id FROM employee WHERE login = ?))
-                AND (wa.warehouse_id = w.id)
-                AND (wa.access IN ('ro', 'rw')))|;
-      push @values, $param->{access};
-    }
-
-    if ($param->{no_personal}) {
-      $q_access .= qq| AND (w.personal_warehouse_of IS NULL)|;
-
-    } elsif ($param->{personal}) {
-      $q_access .= qq| AND (w.personal_warehouse_of = ?)|;
-      push @values, conv_i($param->{personal});
-    }
   }
 
   my $query = qq|SELECT w.* FROM warehouse w
                  WHERE (NOT w.invalid) AND
                    ((SELECT COUNT(b.*) FROM bin b WHERE b.warehouse_id = w.id) > 0)
-                   $q_access
                  ORDER BY w.sortkey|;
 
-  $self->{$key} = selectall_hashref_query($self, $dbh, $query, @values);
+  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
 
   if ($bins_key) {
     $query = qq|SELECT id, description FROM bin WHERE warehouse_id = ?|;
@@ -2229,19 +2293,19 @@ sub _get_simple {
   $main::lxdebug->leave_sub();
 }
 
-sub _get_groups {
-  $main::lxdebug->enter_sub();
-
-  my ($self, $dbh, $key) = @_;
-
-  $key ||= "all_groups";
-
-  my $groups = $main::auth->read_groups();
-
-  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
-
-  $main::lxdebug->leave_sub();
-}
+#sub _get_groups {
+#  $main::lxdebug->enter_sub();
+#
+#  my ($self, $dbh, $key) = @_;
+#
+#  $key ||= "all_groups";
+#
+#  my $groups = $main::auth->read_groups();
+#
+#  $self->{$key} = selectall_hashref_query($self, $dbh, $query);
+#
+#  $main::lxdebug->leave_sub();
+#}
 
 sub get_lists {
   $main::lxdebug->enter_sub();
@@ -2341,9 +2405,10 @@ sub get_lists {
     $self->_get_warehouses($dbh, $params{warehouses});
   }
 
-  if ($params{groups}) {
-    $self->_get_groups($dbh, $params{groups});
-  }
+#  if ($params{groups}) {
+#    $self->_get_groups($dbh, $params{groups});
+#  }
+
   if ($params{partsgroup}) {
     $self->get_partsgroup(\%main::myconfig, { all => 1, target => $params{partsgroup} });
   }
@@ -2582,7 +2647,7 @@ sub create_links {
     do_statement($self, $sth, $query, '%' . $module . '%');
 
     $self->{accounts} = "";
-    while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
+    while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
 
       foreach my $key (split(/:/, $ref->{link})) {
         if ($key =~ /\Q$module\E/) {
@@ -2629,7 +2694,7 @@ sub create_links {
          WHERE a.id = ?|;
     $ref = selectfirst_hashref_query($self, $dbh, $query, $self->{id});
 
-    foreach $key (keys %$ref) {
+    foreach my $key (keys %$ref) {
       $self->{$key} = $ref->{$key};
     }
 
@@ -2651,7 +2716,7 @@ sub create_links {
     do_statement($self, $sth, $query, "%$module%");
 
     $self->{accounts} = "";
-    while ($ref = $sth->fetchrow_hashref(NAME_lc)) {
+    while ($ref = $sth->fetchrow_hashref("NAME_lc")) {
 
       foreach my $key (split(/:/, $ref->{link})) {
         if ($key =~ /\Q$module\E/) {
@@ -2701,7 +2766,7 @@ sub create_links {
     my $index = 0;
 
     # store amounts in {acc_trans}{$key} for multiple accounts
-    while (my $ref = $sth->fetchrow_hashref(NAME_lc)) {
+    while (my $ref = $sth->fetchrow_hashref("NAME_lc")) {
       $ref->{exchangerate} =
         $self->get_exchangerate($dbh, $self->{currency}, $ref->{transdate}, $fld);
       if (!($xkeyref{ $ref->{accno} } =~ /tax/)) {
@@ -2762,36 +2827,52 @@ sub lastname_used {
 
   my ($self, $dbh, $myconfig, $table, $module) = @_;
 
-  my $arap  = ($table eq 'customer') ? "ar" : "ap";
-  $table = $table eq "customer" ? "customer" : "vendor";
-  my $where = "1 = 1";
+  my ($arap, $where);
+
+  $table         = $table eq "customer" ? "customer" : "vendor";
+  my %column_map = ("a.curr"                  => "currency",
+                    "a.${table}_id"           => "${table}_id",
+                    "a.department_id"         => "department_id",
+                    "d.description"           => "department",
+                    "ct.name"                 => $table,
+                    "current_date + ct.terms" => "duedate",
+    );
 
-  if ($self->{type} =~ /_order/) {
+  if ($self->{type} =~ /delivery_order/) {
+    $arap  = 'delivery_orders';
+    delete $column_map{"a.curr"};
+
+  } elsif ($self->{type} =~ /_order/) {
     $arap  = 'oe';
     $where = "quotation = '0'";
-  }
-  if ($self->{type} =~ /_quotation/) {
+
+  } elsif ($self->{type} =~ /_quotation/) {
     $arap  = 'oe';
     $where = "quotation = '1'";
+
+  } elsif ($table eq 'customer') {
+    $arap  = 'ar';
+
+  } else {
+    $arap  = 'ap';
+
   }
 
-  my $query = qq|SELECT MAX(id) FROM $arap
-                 WHERE $where AND ${table}_id > 0|;
-  my ($trans_id) = selectrow_query($self, $dbh, $query);
+  $where           = "($where) AND" if ($where);
+  my $query        = qq|SELECT MAX(id) FROM $arap
+                        WHERE $where ${table}_id > 0|;
+  my ($trans_id)   = selectrow_query($self, $dbh, $query);
+  $trans_id       *= 1;
 
-  $trans_id *= 1;
-  $query =
-    qq|SELECT
-         a.curr, a.${table}_id, a.department_id,
-         d.description AS department,
-         ct.name, current_date + ct.terms AS duedate
-       FROM $arap a
-       LEFT JOIN $table ct ON (a.${table}_id = ct.id)
-       LEFT JOIN department d ON (a.department_id = d.id)
-       WHERE a.id = ?|;
-  ($self->{currency},   $self->{"${table}_id"}, $self->{department_id},
-   $self->{department}, $self->{$table},        $self->{duedate})
-    = selectrow_query($self, $dbh, $query, $trans_id);
+  my $column_spec  = join(', ', map { "${_} AS $column_map{$_}" } keys %column_map);
+  $query           = qq|SELECT $column_spec
+                        FROM $arap a
+                        LEFT JOIN $table     ct ON (a.${table}_id = ct.id)
+                        LEFT JOIN department d  ON (a.department_id = d.id)
+                        WHERE a.id = ?|;
+  my $ref          = selectfirst_hashref_query($self, $dbh, $query, $trans_id);
+
+  map { $self->{$_} = $ref->{$_} } values %column_map;
 
   $main::lxdebug->leave_sub();
 }
@@ -2851,7 +2932,7 @@ sub redo_rows {
   # fill rows
   foreach my $item (sort { $a->{num} <=> $b->{num} } @ndx) {
     $i++;
-    $j = $item->{ndx} - 1;
+    my $j = $item->{ndx} - 1;
     map { $self->{"${_}_$i"} = $new->[$j]->{$_} } @{$flds};
   }