X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=da832f8712aa0266f02055b98d7224bcf2327643;hb=73c7fcda3fffdde721d283e8828a2954bdfcf561;hp=14e3ed20f0c24688b96c02f20805191508edc6dc;hpb=a36ab47a71cde9bb7eda8f01caa823cdedc36208;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 14e3ed20f..da832f871 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -251,6 +251,7 @@ sub new { my $self = {}; + no warnings 'once'; if ($LXDebug::watch_form) { require SL::Watchdog; tie %{ $self }, 'SL::Watchdog'; @@ -463,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(); @@ -623,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) { @@ -674,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; @@ -696,11 +696,13 @@ sub header { push @header, "" if -f $self->{favicon}; push @header, '', '', - '', + '', '', '', '', - ''; + '', + '', + ''; push @header, $self->{javascript} if $self->{javascript}; push @header, map { $_->show_javascript } @{ $self->{AJAX} || [] }; push @header, "" if $self->{fokus}; @@ -720,10 +722,15 @@ sub header { |; } + my %doctypes = ( + strict => qq||, + transitional => qq||, + frameset => qq||, + ); + # output print $self->create_http_response(content_type => 'text/html', charset => $db_charset); - print "\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 < @@ -732,9 +739,9 @@ sub header { EOT print " $_\n" for @header; print < - - + + + - $extra_code + $params{extra_code} $title_hack @@ -759,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(); @@ -777,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 { @@ -842,10 +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}}) { @@ -1116,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'); @@ -1314,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; @@ -1367,7 +1371,7 @@ sub parse_template { $myconfig->{signature} =~ s/\n/
\n/g; $mail->{message} .= "
\n--
\n$myconfig->{signature}\n
"; - open(IN, $self->{tmpfile}) + open(IN, "<", $self->{tmpfile}) or $self->error($self->cleanup . "$self->{tmpfile} : $!"); while () { $mail->{message} .= $_; @@ -1397,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; @@ -1408,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 ; + open OUT, '>', $self->{OUT} or $self->error($self->cleanup . "$self->{OUT} : $!"); + print OUT $_ while ; close OUT; seek IN, 0, 0; @@ -1537,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 = ; close(FH); @@ -2750,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 @@ -2833,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); @@ -2881,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); @@ -2944,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}); @@ -2986,7 +3001,7 @@ sub create_links { $query = qq|SELECT c.accno, c.description, - a.source, a.amount, a.memo, a.transdate, a.gldate, 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 @@ -3120,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(); }