Fehler beim kopieren von Daten auf ein Filehandle
[kivitendo-erp.git] / SL / Form.pm
index cef5995..da832f8 100644 (file)
@@ -251,6 +251,7 @@ sub new {
 
   my $self = {};
 
+  no warnings 'once';
   if ($LXDebug::watch_form) {
     require SL::Watchdog;
     tie %{ $self }, 'SL::Watchdog';
@@ -258,6 +259,16 @@ sub new {
 
   bless $self, $type;
 
+  $main::lxdebug->leave_sub();
+
+  return $self;
+}
+
+sub read_cgi_input {
+  $main::lxdebug->enter_sub();
+
+  my ($self) = @_;
+
   $self->_input_to_hash($ENV{QUERY_STRING}) if $ENV{QUERY_STRING};
   $self->_input_to_hash($ARGV[0])           if @ARGV && $ARGV[0];
 
@@ -268,6 +279,12 @@ sub new {
     $uploads = $self->_request_to_hash($content);
   }
 
+  if ($self->{RESTORE_FORM_FROM_SESSION_ID}) {
+    my %temp_form;
+    $::auth->restore_form_from_session(delete $self->{RESTORE_FORM_FROM_SESSION_ID}, form => \%temp_form);
+    $self->_input_to_hash(join '&', map { $self->escape($_) . '=' . $self->escape($temp_form{$_}) } keys %temp_form);
+  }
+
   my $db_charset   = $::lx_office_conf{system}->{dbcharset};
   $db_charset    ||= Common::DEFAULT_CHARSET;
 
@@ -447,11 +464,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();
@@ -607,8 +624,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) {
@@ -658,7 +674,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;
 
@@ -680,11 +696,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};
@@ -704,10 +722,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>
@@ -716,9 +739,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">
 
   /***********************************************
@@ -728,7 +751,7 @@ EOT
    ***********************************************/
 
   </script>
-  $extra_code
+  $params{extra_code}
   $title_hack
  </head>
 
@@ -743,8 +766,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();
 
@@ -761,8 +783,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 {
@@ -819,7 +840,6 @@ sub _prepare_html_template {
 
   $additional_params->{"conf_dbcharset"}              = $::lx_office_conf{system}->{dbcharset};
   $additional_params->{"conf_webdav"}                 = $::lx_office_conf{features}->{webdav};
-  $additional_params->{"conf_lizenzen"}               = $::lx_office_conf{features}->{lizenzen};
   $additional_params->{"conf_latex_templates"}        = $::lx_office_conf{print_templates}->{latex};
   $additional_params->{"conf_opendocument_templates"} = $::lx_office_conf{print_templates}->{opendocument};
   $additional_params->{"conf_vertreter"}              = $::lx_office_conf{features}->{vertreter};
@@ -827,9 +847,11 @@ sub _prepare_html_template {
   $additional_params->{"conf_parts_image_css"}        = $::lx_office_conf{features}->{parts_image_css};
   $additional_params->{"conf_parts_listing_images"}   = $::lx_office_conf{features}->{parts_listing_images};
   $additional_params->{"conf_parts_show_image"}       = $::lx_office_conf{features}->{parts_show_image};
+  $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}}) {
@@ -866,7 +888,7 @@ sub parse_html_template {
 sub init_template {
   my $self = shift;
 
-  return if $self->template;
+  return $self->template if $self->template;
 
   return $self->template(Template->new({
      'INTERPOLATE'  => 0,
@@ -995,6 +1017,16 @@ sub write_trigger {
   return $jsscript;
 }    #end sub write_trigger
 
+sub _store_redirect_info_in_session {
+  my ($self) = @_;
+
+  return unless $self->{callback} =~ m:^ ( [^\?/]+ \.pl ) \? (.+) :x;
+
+  my ($controller, $params) = ($1, $2);
+  my $form                  = { map { map { $self->unescape($_) } split /=/, $_, 2 } split m/\&/, $params };
+  $self->{callback}         = "${controller}?RESTORE_FORM_FROM_SESSION_ID=" . $::auth->save_form_in_session(form => $form);
+}
+
 sub redirect {
   $main::lxdebug->enter_sub();
 
@@ -1004,6 +1036,7 @@ sub redirect {
     $self->info($msg);
 
   } else {
+    $self->_store_redirect_info_in_session;
     print $::form->redirect_header($self->{callback});
   }
 
@@ -1089,8 +1122,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');
@@ -1164,7 +1196,7 @@ sub parse_amount {
   if (   ($myconfig->{numberformat} eq '1.000,00')
       || ($myconfig->{numberformat} eq '1000,00')) {
     $amount =~ s/\.//g;
-    $amount =~ s/,/\./;
+    $amount =~ s/,/\./g;
   }
 
   if ($myconfig->{numberformat} eq "1'000.00") {
@@ -1175,7 +1207,9 @@ sub parse_amount {
 
   $main::lxdebug->leave_sub(2);
 
-  return ($amount * 1);
+  # Make sure no code wich is not a math expression ends up in eval().
+  return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
+  return scalar(eval($amount)) * 1 ;
 }
 
 sub round_amount {
@@ -1285,26 +1319,25 @@ sub parse_template {
 
   if ($template->uses_temp_file() || $self->{media} eq 'email') {
     $out = $self->{OUT};
-    $self->{OUT} = ">$self->{tmpfile}";
+    $self->{OUT} = "$self->{tmpfile}";
   }
 
   my $result;
 
   if ($self->{OUT}) {
-    open OUT, "$self->{OUT}" or $self->error("$self->{OUT} : $!");
-    $result = $template->parse(*OUT);
-    close OUT;
-
+    open(OUT, ">", $self->{OUT}) or $self->error("$self->{OUT} : $!");
   } else {
+    *OUT = ($::dispatcher->get_standard_filehandles)[1];
     $self->header;
-    $result = $template->parse(*STDOUT);
   }
 
-  if (!$result) {
+  if (!$template->parse(*OUT)) {
     $self->cleanup();
     $self->error("$self->{IN} : " . $template->get_error());
   }
 
+  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;
     $self->cleanup;
@@ -1338,7 +1371,7 @@ sub parse_template {
         $myconfig->{signature} =~ s/\n/<br>\n/g;
         $mail->{message} .= "<br>\n-- <br>\n$myconfig->{signature}\n<br>";
 
-        open(IN, $self->{tmpfile})
+        open(IN, "<", $self->{tmpfile})
           or $self->error($self->cleanup . "$self->{tmpfile} : $!");
         while (<IN>) {
           $mail->{message} .= $_;
@@ -1368,7 +1401,7 @@ sub parse_template {
       $self->{OUT} = $out;
 
       my $numbytes = (-s $self->{tmpfile});
-      open(IN, $self->{tmpfile})
+      open(IN, "<", $self->{tmpfile})
         or $self->error($self->cleanup . "$self->{tmpfile} : $!");
       binmode IN;
 
@@ -1379,8 +1412,8 @@ sub parse_template {
       #print(STDERR "OUT $self->{OUT}\n");
       for my $i (1 .. $self->{copies}) {
         if ($self->{OUT}) {
-          open OUT, $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
-          print OUT while <IN>;
+          open OUT, '>', $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!");
+          print OUT $_ while <IN>;
           close OUT;
           seek IN, 0, 0;
 
@@ -1508,12 +1541,17 @@ sub generate_email_subject {
 sub cleanup {
   $main::lxdebug->enter_sub();
 
-  my $self = shift;
+  my ($self, $application) = @_;
+
+  my $error_code = $?;
 
   chdir("$self->{tmpdir}");
 
   my @err = ();
-  if (-f "$self->{tmpfile}.err") {
+  if ((-1 == $error_code) || (127 == (($error_code) >> 8))) {
+    push @err, $::locale->text('The application "#1" was not found on the system.', $application || 'pdflatex') . ' ' . $::locale->text('Please contact your administrator.');
+
+  } elsif (-f "$self->{tmpfile}.err") {
     open(FH, "$self->{tmpfile}.err");
     @err = <FH>;
     close(FH);
@@ -1873,12 +1911,12 @@ sub set_payment_options {
   my $dbh = $self->get_standard_dbh($myconfig);
 
   my $query =
-    qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long | .
+    qq|SELECT p.terms_netto, p.terms_skonto, p.percent_skonto, p.description_long , p.description | .
     qq|FROM payment_terms p | .
     qq|WHERE p.id = ?|;
 
   ($self->{terms_netto}, $self->{terms_skonto}, $self->{percent_skonto},
-   $self->{payment_terms}) =
+   $self->{payment_terms}, $self->{payment_description}) =
      selectrow_query($self, $dbh, $query, $self->{payment_id});
 
   if ($transdate eq "") {
@@ -2721,20 +2759,12 @@ 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);
 
   # get languages
@@ -2804,15 +2834,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);
 
@@ -2852,11 +2876,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);
 
@@ -2900,6 +2941,7 @@ sub create_links {
            a.duedate, a.ordnumber, a.taxincluded, a.curr AS currency, a.notes,
            a.intnotes, a.department_id, a.amount AS oldinvtotal,
            a.paid AS oldtotalpaid, a.employee_id, a.gldate, a.type,
+           a.globalproject_id,
            c.name AS $table,
            d.description AS department,
            e.name AS employee
@@ -2914,6 +2956,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});
@@ -2956,7 +3001,7 @@ sub create_links {
     $query =
       qq|SELECT
            c.accno, c.description,
-           a.source, a.amount, a.memo, a.transdate, a.cleared, a.project_id, a.taxkey,
+           a.acc_trans_id, a.source, a.amount, a.memo, a.transdate, a.gldate, a.cleared, a.project_id, a.taxkey,
            p.projectnumber,
            t.rate, t.id
          FROM acc_trans a
@@ -3090,6 +3135,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();
 }