Merge branch 'master' of vc.linet-services.de:public/lx-office-erp
[kivitendo-erp.git] / SL / Form.pm
index e44f397..37e4a21 100644 (file)
@@ -40,7 +40,6 @@ package Form;
 use Data::Dumper;
 
 use CGI;
-use CGI::Ajax;
 use Cwd;
 use Encode;
 use File::Copy;
@@ -251,6 +250,7 @@ sub new {
 
   my $self = {};
 
+  no warnings 'once';
   if ($LXDebug::watch_form) {
     require SL::Watchdog;
     tie %{ $self }, 'SL::Watchdog';
@@ -463,11 +463,11 @@ sub hide_form {
   my $self = shift;
 
   if (@_) {
-    map({ print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
+    map({ print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n"); } @_);
   } else {
     for (sort keys %$self) {
       next if (($_ eq "header") || (ref($self->{$_}) ne ""));
-      print($main::cgi->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
+      print($::request->{cgi}->hidden("-name" => $_, "-default" => $self->{$_}) . "\n");
     }
   }
   $main::lxdebug->leave_sub();
@@ -623,8 +623,7 @@ sub create_http_response {
   my $self     = shift;
   my %params   = @_;
 
-  my $cgi      = $main::cgi;
-  $cgi       ||= CGI->new('');
+  my $cgi      = $::request->{cgi};
 
   my $session_cookie;
   if (defined $main::auth) {
@@ -674,7 +673,7 @@ sub header {
 
   # extra code is currently only used by menuv3 and menuv4 to set their css.
   # it is strongly deprecated, and will be changed in a future version.
-  my ($self, $extra_code) = @_;
+  my ($self, %params) = @_;
   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
   my @header;
 
@@ -696,11 +695,13 @@ sub header {
   push @header, "<link rel='shortcut icon' href='$self->{favicon}' type='image/x-icon'>" if -f $self->{favicon};
   push @header, '<script type="text/javascript" src="js/jquery.js"></script>',
                 '<script type="text/javascript" src="js/common.js"></script>',
-                '<style type="text/css">@import url(js/jscalendar/calendar-win2k-1.css);</style>',
+                '<link rel="stylesheet" type="text/css" href="js/jscalendar/calendar-win2k-1.css">',
                 '<script type="text/javascript" src="js/jscalendar/calendar.js"></script>',
                 '<script type="text/javascript" src="js/jscalendar/lang/calendar-de.js"></script>',
                 '<script type="text/javascript" src="js/jscalendar/calendar-setup.js"></script>',
-                '<script type="text/javascript" src="js/part_selection.js"></script>';
+                '<script type="text/javascript" src="js/part_selection.js"></script>',
+                '<script type="text/javascript" src="js/jquery-ui.js"></script>',
+                '<link rel="stylesheet" type="text/css" href="css/ui-lightness/jquery-ui-1.8.12.custom.css">';
   push @header, $self->{javascript} if $self->{javascript};
   push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] };
   push @header, "<script type='text/javascript'>function fokus(){ document.$self->{fokus}.focus(); }</script>" if $self->{fokus};
@@ -720,10 +721,15 @@ sub header {
     </script>|;
   }
 
+  my  %doctypes = (
+    strict       => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|,
+    transitional => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|,
+    frameset     => qq|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|,
+  );
+
   # output
   print $self->create_http_response(content_type => 'text/html', charset => $db_charset);
-  print "<!DOCTYPE HTML PUBLIC '-//W3C//DTD HTML 4.01//EN' 'http://www.w3.org/TR/html4/strict.dtd'>\n"
-    if  $ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/; # Other browsers may choke on menu scripts with DOCTYPE.
+  print $doctypes{$params{doctype} || 'transitional'}, $/;
   print <<EOT;
 <html>
  <head>
@@ -732,9 +738,9 @@ sub header {
 EOT
   print "  $_\n" for @header;
   print <<EOT;
-  <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css" />
-  <meta name="robots" content="noindex,nofollow" />
-  <link rel="stylesheet" type="text/css" href="css/tabcontent.css" />
+  <link rel="stylesheet" href="css/jquery.autocomplete.css" type="text/css">
+  <meta name="robots" content="noindex,nofollow">
+  <link rel="stylesheet" type="text/css" href="css/tabcontent.css">
   <script type="text/javascript" src="js/tabcontent.js">
 
   /***********************************************
@@ -744,7 +750,7 @@ EOT
    ***********************************************/
 
   </script>
-  $extra_code
+  $params{extra_code}
   $title_hack
  </head>
 
@@ -759,8 +765,7 @@ sub ajax_response_header {
   my ($self) = @_;
 
   my $db_charset = $::lx_office_conf{system}->{dbcharset} || Common::DEFAULT_CHARSET;
-  my $cgi        = $main::cgi || CGI->new('');
-  my $output     = $cgi->header('-charset' => $db_charset);
+  my $output     = $::request->{cgi}->header('-charset' => $db_charset);
 
   $main::lxdebug->leave_sub();
 
@@ -777,8 +782,7 @@ sub redirect_header {
   die "Headers already sent" if $self->{header};
   $self->{header} = 1;
 
-  my $cgi = $main::cgi || CGI->new('');
-  return $cgi->redirect($new_uri);
+  return $::request->{cgi}->redirect($new_uri);
 }
 
 sub set_standard_title {
@@ -845,8 +849,8 @@ sub _prepare_html_template {
   $additional_params->{"conf_payments_changeable"}    = $::lx_office_conf{features}->{payments_changeable};
   $additional_params->{"INSTANCE_CONF"}               = $::instance_conf;
 
-  if (%main::debug_options) {
-    map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options;
+  if (my $debug_options = $::lx_office_conf{debug}{options}) {
+    map { $additional_params->{'DEBUG_' . uc($_)} = $debug_options->{$_} } keys %$debug_options;
   }
 
   if ($main::auth && $main::auth->{RIGHTS} && $main::auth->{RIGHTS}->{$self->{login}}) {
@@ -1117,8 +1121,7 @@ sub format_amount_units {
     return '';
   }
 
-  AM->retrieve_all_units();
-  my $all_units        = $main::all_units;
+  my $all_units        = AM->retrieve_all_units;
 
   if (('' eq ref $conv_units) && ($conv_units =~ /convertible/)) {
     $conv_units = AM->convertible_units($all_units, $part_unit_name, $conv_units eq 'convertible_not_smaller');
@@ -1323,7 +1326,7 @@ sub parse_template {
   if ($self->{OUT}) {
     open(OUT, ">", $self->{OUT}) or $self->error("$self->{OUT} : $!");
   } else {
-    open(OUT, ">&", \*STDOUT) or $self->error("STDOUT : $!");
+    *OUT = ($::dispatcher->get_standard_filehandles)[1];
     $self->header;
   }
 
@@ -1332,7 +1335,7 @@ sub parse_template {
     $self->error("$self->{IN} : " . $template->get_error());
   }
 
-  close OUT;
+  close OUT if $self->{OUT};
 
   if ($self->{media} eq 'file') {
     copy(join('/', $self->{cwd}, $userspath, $self->{tmpfile}), $out =~ m|^/| ? $out : join('/', $self->{cwd}, $out)) if $template->uses_temp_file;
@@ -1409,7 +1412,8 @@ sub parse_template {
       for my $i (1 .. $self->{copies}) {
         if ($self->{OUT}) {
           open OUT, '>', $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
-          print OUT while <IN>;
+          print OUT $_ while <IN>;
+          close OUT;
           seek IN, 0, 0;
 
         } else {
@@ -1424,10 +1428,8 @@ Content-Length: $numbytes
 
 |;
 
-          open(OUT, ">&", \*STDOUT) or $self->error($self->cleanup . "$!: STDOUT");
-          $::locale->with_raw_io(*OUT, sub { print while <IN> });
+          $::locale->with_raw_io(\*STDOUT, sub { print while <IN> });
         }
-        close OUT;
       }
 
       close(IN);
@@ -2338,7 +2340,7 @@ sub _get_taxcharts {
     $key = $params;
   }
 
-  my $where = ' WHERE ' . join(' AND ', map { "($_)" } @where) if (@where);
+  my $where = @where ? ' WHERE ' . join(' AND ', map { "($_)" } @where) : '';
 
   my $query = qq|SELECT * FROM tax $where ORDER BY taxkey|;
 
@@ -2453,7 +2455,7 @@ sub _get_customers {
 
   my $options        = ref $key eq 'HASH' ? $key : { key => $key };
   $options->{key}  ||= "all_customers";
-  my $limit_clause   = "LIMIT $options->{limit}" if $options->{limit};
+  my $limit_clause   = $options->{limit} ? "LIMIT $options->{limit}" : '';
 
   my @where;
   push @where, qq|business_id IN (SELECT id FROM business WHERE salesman)| if  $options->{business_is_salesman};
@@ -2756,19 +2758,11 @@ sub all_vc {
   @{ $self->{all_employees} } =
     sort { $a->{name} cmp $b->{name} } @{ $self->{all_employees} };
 
-  if ($module eq 'AR') {
 
     # prepare query for departments
-    $query = qq|SELECT id, description
-                FROM department
-                WHERE role = 'P'
-                ORDER BY description|;
-
-  } else {
     $query = qq|SELECT id, description
                 FROM department
                 ORDER BY description|;
-  }
 
   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
 
@@ -2839,15 +2833,9 @@ sub all_departments {
   my ($self, $myconfig, $table) = @_;
 
   my $dbh = $self->get_standard_dbh($myconfig);
-  my $where;
-
-  if ($table eq 'customer') {
-    $where = "WHERE role = 'P' ";
-  }
 
   my $query = qq|SELECT id, description
                  FROM department
-                 $where
                  ORDER BY description|;
   $self->{all_departments} = selectall_hashref_query($self, $dbh, $query);
 
@@ -2887,11 +2875,28 @@ sub create_links {
     }
 
     # now get the account numbers
-    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
-                FROM chart c, taxkeys tk
-                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
-                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
-                ORDER BY c.accno|;
+#    $query = qq|SELECT c.accno, c.description, c.link, c.taxkey_id, tk.tax_id
+#                FROM chart c, taxkeys tk
+#                WHERE (c.link LIKE ?) AND (c.id = tk.chart_id) AND tk.id =
+#                  (SELECT id FROM taxkeys WHERE (taxkeys.chart_id = c.id) AND (startdate <= $transdate) ORDER BY startdate DESC LIMIT 1)
+#                ORDER BY c.accno|;
+
+#  same query as above, but without expensive subquery for each row. about 80% faster
+    $query = qq|
+      SELECT c.accno, c.description, c.link, c.taxkey_id, tk2.tax_id
+        FROM chart c
+        -- find newest entries in taxkeys
+        INNER JOIN (
+          SELECT chart_id, MAX(startdate) AS startdate
+          FROM taxkeys
+          WHERE (startdate <= $transdate)
+          GROUP BY chart_id
+        ) tk ON (c.id = tk.chart_id)
+        -- and load all of those entries
+        INNER JOIN taxkeys tk2
+           ON (tk.chart_id = tk2.chart_id AND tk.startdate = tk2.startdate)
+       WHERE (c.link LIKE ?)
+      ORDER BY c.accno|;
 
     $sth = $dbh->prepare($query);
 
@@ -2950,6 +2955,9 @@ sub create_links {
       $self->{$key} = $ref->{$key};
     }
 
+    # remove any trailing whitespace
+    $self->{currency} =~ s/\s*$//;
+
     my $transdate = "current_date";
     if ($self->{transdate}) {
       $transdate = $dbh->quote($self->{transdate});
@@ -3126,6 +3134,9 @@ sub lastname_used {
 
   map { $self->{$_} = $ref->{$_} } values %column_map;
 
+  # remove any trailing whitespace
+  $self->{currency} =~ s/\s*$// if $self->{currency};
+
   $main::lxdebug->leave_sub();
 }
 
@@ -3653,8 +3664,8 @@ sub prepare_for_printing {
     $extension            = 'xls';
   }
 
-  my $printer_code    = '_' . $self->{printer_code} if $self->{printer_code};
-  my $email_extension = '_email' if -f "$self->{templates}/$self->{formname}_email${language}${printer_code}.${extension}";
+  my $printer_code    = $self->{printer_code} ? '_' . $self->{printer_code} : '';
+  my $email_extension = -f "$::myconfig{templates}/$self->{formname}_email${language}.${extension}" ? '_email' : '';
   $self->{IN}         = "$self->{formname}${email_extension}${language}${printer_code}.${extension}";
 
   # Format dates.