X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;ds=sidebyside;f=SL%2FForm.pm;h=f43578bb623e43a5c15fb7e5deef0c0a8529215d;hb=cdfebb5085afaf1fe0f0278ca6172d5fe009bd9c;hp=d1dbfb631a2cabbf973293d1f409f8b001d37cf4;hpb=6a751412f2815f29cc8c7a1143197beb0f7c8dc3;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index d1dbfb631..f43578bb6 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -39,7 +39,6 @@ package Form; use Data::Dumper; use Cwd; -use HTML::Template; use Template; use SL::Template; use CGI::Ajax; @@ -49,6 +48,7 @@ use SL::Menu; use SL::User; use SL::Common; use CGI; +use List::Util qw(max min sum); my $standard_dbh; @@ -98,7 +98,8 @@ sub _request_to_hash { if (($line eq $boundary) || ($line eq "$boundary\r")) { $params{$name} =~ s|\r?\n$|| if $name; - undef $name, $filename; + undef $name; + undef $filename; $headers_done = 0; $content_type = "text/plain"; @@ -294,11 +295,7 @@ sub error { } else { - if ($self->{error_function}) { - &{ $self->{error_function} }($msg); - } else { - die "Error: $msg\n"; - } + die "Error: $msg\n"; } $main::lxdebug->leave_sub(); @@ -335,20 +332,17 @@ sub info { $main::lxdebug->leave_sub(); } +# calculates the number of rows in a textarea based on the content and column number +# can be capped with maxrows sub numtextrows { $main::lxdebug->enter_sub(); - my ($self, $str, $cols, $maxrows) = @_; - my $rows = 0; - - map { $rows += int(((length) - 2) / $cols) + 1 } split /\r/, $str; - - $maxrows = $rows unless defined $maxrows; + my $rows = sum map { int((length() - 2) / $cols) + 1 } split /\r/, $str; + $maxrows ||= $rows; $main::lxdebug->leave_sub(); - - return ($rows > $maxrows) ? $maxrows : $rows; + return min $rows, $maxrows; } sub dberror { @@ -385,11 +379,22 @@ sub header { my ($stylesheet, $favicon); if ($ENV{HTTP_USER_AGENT}) { + my $doctype; - if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = - qq| - |; + if ($ENV{'HTTP_USER_AGENT'} =~ m/MSIE\s+\d/) { + # Only set the DOCTYPE for Internet Explorer. Other browsers have problems displaying the menu otherwise. + $doctype = qq|\n|; + } + + my $stylesheets = "$self->{stylesheet} $self->{stylesheets}"; + + $stylesheets =~ s|^\s*||; + $stylesheets =~ s|\s*$||; + foreach my $file (split m/\s+/, $stylesheets) { + $file =~ s|.*/||; + next if (! -f "css/$file"); + + $stylesheet .= qq|\n|; } $self->{favicon} = "favicon.ico" unless $self->{favicon}; @@ -433,7 +438,7 @@ sub header { } print qq|Content-Type: text/html; charset=${db_charset}; - +${doctype} $self->{titlebar} $stylesheet @@ -550,47 +555,20 @@ sub parse_html_template { $file = $self->_prepare_html_template($file, $additional_params); - my $template = HTML::Template->new("filename" => $file, - "die_on_bad_params" => 0, - "strict" => 0, - "case_sensitive" => 1, - "loop_context_vars" => 1, - "global_vars" => 1); - - foreach my $key ($template->param()) { - my $param = $additional_params->{$key} || $self->{$key}; - $param = [] if (($template->query("name" => $key) eq "LOOP") && (ref($param) ne "ARRAY")); - $template->param($key => $param); - } - - my $output = $template->output(); - - $output = $main::locale->{iconv}->convert($output) if ($main::locale); - - $main::lxdebug->leave_sub(); - - return $output; -} - -sub parse_html_template2 { - $main::lxdebug->enter_sub(); - - my ($self, $file, $additional_params) = @_; - - $additional_params ||= { }; - - $file = $self->_prepare_html_template($file, $additional_params); - - my $template = Template->new({ 'INTERPOLATE' => 0, - 'EVAL_PERL' => 0, - 'ABSOLUTE' => 1, - 'CACHE_SIZE' => 0, + my $template = Template->new({ 'INTERPOLATE' => 0, + 'EVAL_PERL' => 0, + 'ABSOLUTE' => 1, + 'CACHE_SIZE' => 0, + 'PLUGIN_BASE' => 'SL::Template::Plugin', + 'INCLUDE_PATH' => '.:templates/webpages', }) || die; map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; my $output; - $template->process($file, $additional_params, \$output); + if (!$template->process($file, $additional_params, \$output)) { + print STDERR $template->error(); + } $output = $main::locale->{iconv}->convert($output) if ($main::locale); @@ -602,9 +580,10 @@ sub parse_html_template2 { sub show_generic_error { my ($self, $error, $title, $action) = @_; - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_error"} = $error; + my $add_params = { + 'title_error' => $title, + 'label_error' => $error, + }; my @vars; if ($action) { @@ -617,21 +596,26 @@ sub show_generic_error { } $add_params->{"VARIABLES"} = \@vars; + $self->{title} = $title if ($title); + $self->header(); - print($self->parse_html_template("generic/error", $add_params)); + print $self->parse_html_template("generic/error", $add_params); die("Error: $error\n"); } sub show_generic_information { - my ($self, $error, $title) = @_; + my ($self, $text, $title) = @_; - my $add_params = {}; - $add_params->{"title"} = $title if ($title); - $self->{"label_information"} = $error; + my $add_params = { + 'title_information' => $title, + 'label_information' => $text, + }; + + $self->{title} = $title if ($title); $self->header(); - print($self->parse_html_template("generic/information", $add_params)); + print $self->parse_html_template("generic/information", $add_params); die("Information: $error\n"); } @@ -692,7 +676,7 @@ sub redirect { ($script, $argv) = split(/\?/, $self->{callback}, 2); $script =~ s|.*/||; - $script =~ s|[^a-zA-Z_\.]||g; + $script =~ s|[^a-zA-Z0-9_\.]||g; exec("perl", "$script", $argv); } else { @@ -723,18 +707,23 @@ sub format_amount { if ($amount eq "") { $amount = 0; } - my $neg = ($amount =~ s/-//); - + + # Hey watch out! The amount can be an exponential term like 1.13686837721616e-13 + + my $neg = ($amount =~ s/^-//); + my $exp = ($amount =~ m/[e]/) ? 1 : 0; + if (defined($places) && ($places ne '')) { - if ($places < 0) { - $amount *= 1; - $places *= -1; - - my ($actual_places) = ($amount =~ /\.(\d+)/); - $actual_places = length($actual_places); - $places = $actual_places > $places ? $actual_places : $places; + if (not $exp) { + if ($places < 0) { + $amount *= 1; + $places *= -1; + + my ($actual_places) = ($amount =~ /\.(\d+)/); + $actual_places = length($actual_places); + $places = $actual_places > $places ? $actual_places : $places; + } } - $amount = $self->round_amount($amount, $places); } @@ -757,6 +746,22 @@ sub format_amount { return $amount; } # + +sub format_string { + $main::lxdebug->enter_sub(2); + + my $self = shift; + my $input = shift; + + $input =~ s/(^|[^\#]) \# (\d+) /$1$_[$2 - 1]/gx; + $input =~ s/(^|[^\#]) \#\{(\d+)\}/$1$_[$2 - 1]/gx; + $input =~ s/\#\#/\#/g; + + $main::lxdebug->leave_sub(2); + + return $input; +} + sub parse_amount { $main::lxdebug->enter_sub(2); @@ -844,6 +849,10 @@ sub parse_template { qw(company address signature)); map({ $self->{$_} =~ s/\\n/\n/g; } qw(company address signature)); + map({ $self->{"${_}"} = $myconfig->{$_}; } + qw(co_ustid)); + + $self->{copies} = 1 if (($self->{copies} *= 1) <= 0); # OUT is used for the media, screen, printer, email @@ -988,18 +997,18 @@ sub get_formname_translation { $formname ||= $self->{formname}; my %formname_translations = ( - bin_list => $main::locale->text('Bin List'), - credit_note => $main::locale->text('Credit Note'), - invoice => $main::locale->text('Invoice'), - packing_list => $main::locale->text('Packing List'), - pick_list => $main::locale->text('Pick List'), - proforma => $main::locale->text('Proforma Invoice'), - purchase_order => $main::locale->text('Purchase Order'), - request_quotation => $main::locale->text('RFQ'), - sales_order => $main::locale->text('Confirmation'), - sales_quotation => $main::locale->text('Quotation'), - storno_invoice => $main::locale->text('Storno Invoice'), - storno_packing_list => $main::locale->text('Storno Packing List'), + bin_list => $main::locale->text('Bin List'), + credit_note => $main::locale->text('Credit Note'), + invoice => $main::locale->text('Invoice'), + packing_list => $main::locale->text('Packing List'), + pick_list => $main::locale->text('Pick List'), + proforma => $main::locale->text('Proforma Invoice'), + purchase_order => $main::locale->text('Purchase Order'), + request_quotation => $main::locale->text('RFQ'), + sales_order => $main::locale->text('Confirmation'), + sales_quotation => $main::locale->text('Quotation'), + storno_invoice => $main::locale->text('Storno Invoice'), + storno_packing_list => $main::locale->text('Storno Packing List'), ); return $formname_translations{$formname} @@ -1177,13 +1186,13 @@ sub update_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $buy, $sell) = @_; - + my ($query); # some sanity check for currency if ($curr eq '') { $main::lxdebug->leave_sub(); return; } - my $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); my ($defaultcurrency) = split m/:/, $currency; @@ -1194,7 +1203,7 @@ sub update_exchangerate { return; } - my $query = qq|SELECT e.curr FROM exchangerate e + $query = qq|SELECT e.curr FROM exchangerate e WHERE e.curr = ? AND e.transdate = ? FOR UPDATE|; my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); @@ -1259,13 +1268,14 @@ sub get_exchangerate { $main::lxdebug->enter_sub(); my ($self, $dbh, $curr, $transdate, $fld) = @_; + my ($query); unless ($transdate) { $main::lxdebug->leave_sub(); return 1; } - my $query = qq|SELECT curr FROM defaults|; + $query = qq|SELECT curr FROM defaults|; my ($currency) = selectrow_query($self, $dbh, $query); my ($defaultcurrency) = split m/:/, $currency; @@ -1275,7 +1285,7 @@ sub get_exchangerate { return 1; } - my $query = qq|SELECT e.$fld FROM exchangerate e + $query = qq|SELECT e.$fld FROM exchangerate e WHERE e.curr = ? AND e.transdate = ?|; my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); @@ -1365,12 +1375,32 @@ sub set_payment_options { ($self->{netto_date}, $self->{skonto_date}) = selectrow_query($self, $dbh, $query, $transdate, $self->{terms_netto}, $transdate, $self->{terms_skonto}); - my $total = ($self->{invtotal}) ? $self->{invtotal} : $self->{ordtotal}; - my $skonto_amount = $self->parse_amount($myconfig, $total) * - $self->{percent_skonto}; + my ($invtotal, $total); + my (%amounts, %formatted_amounts); + + if ($self->{type} =~ /_order$/) { + $amounts{invtotal} = $self->{ordtotal}; + $amounts{total} = $self->{ordtotal}; + + } elsif ($self->{type} =~ /_quotation$/) { + $amounts{invtotal} = $self->{quototal}; + $amounts{total} = $self->{quototal}; + + } else { + $amounts{invtotal} = $self->{invtotal}; + $amounts{total} = $self->{total}; + } + + map { $amounts{$_} = $self->parse_amount($myconfig, $amounts{$_}) } keys %amounts; - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); + $amounts{skonto_amount} = $amounts{invtotal} * $self->{percent_skonto}; + $amounts{invtotal_wo_skonto} = $amounts{invtotal} * (1 - $self->{percent_skonto}); + $amounts{total_wo_skonto} = $amounts{total} * (1 - $self->{percent_skonto}); + + foreach (keys %amounts) { + $amounts{$_} = $self->round_amount($amounts{$_}, 2); + $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}, 2); + } if ($self->{"language_id"}) { $query = @@ -1398,23 +1428,21 @@ sub set_payment_options { ($output_numberformat ne $myconfig->{"numberformat"})) { my $saved_numberformat = $myconfig->{"numberformat"}; $myconfig->{"numberformat"} = $output_numberformat; - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); + map { $formatted_amounts{$_} = $self->format_amount($myconfig, $amounts{$_}) } keys %amounts; $myconfig->{"numberformat"} = $saved_numberformat; } } $self->{payment_terms} =~ s/<%netto_date%>/$self->{netto_date}/g; $self->{payment_terms} =~ s/<%skonto_date%>/$self->{skonto_date}/g; - $self->{payment_terms} =~ s/<%skonto_amount%>/$self->{skonto_amount}/g; - $self->{payment_terms} =~ s/<%total%>/$self->{total}/g; - $self->{payment_terms} =~ s/<%invtotal%>/$self->{invtotal}/g; $self->{payment_terms} =~ s/<%currency%>/$self->{currency}/g; $self->{payment_terms} =~ s/<%terms_netto%>/$self->{terms_netto}/g; $self->{payment_terms} =~ s/<%account_number%>/$self->{account_number}/g; $self->{payment_terms} =~ s/<%bank%>/$self->{bank}/g; $self->{payment_terms} =~ s/<%bank_code%>/$self->{bank_code}/g; + map { $self->{payment_terms} =~ s/<%${_}%>/$formatted_amounts{$_}/g; } keys %formatted_amounts; + $main::lxdebug->leave_sub(); } @@ -1818,11 +1846,12 @@ $main::lxdebug->enter_sub(); sub _get_customers { $main::lxdebug->enter_sub(); - my ($self, $dbh, $key) = @_; + my ($self, $dbh, $key, $limit) = @_; $key = "all_customers" unless ($key); + $limit_clause = "LIMIT $limit" if $limit; - my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name|; + my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|; $self->{$key} = selectall_hashref_query($self, $dbh, $query); @@ -1857,6 +1886,20 @@ sub _get_departments { $main::lxdebug->leave_sub(); } +sub _get_price_factors { + $main::lxdebug->enter_sub(); + + my ($self, $dbh, $key) = @_; + + $key ||= "all_price_factors"; + + my $query = qq|SELECT * FROM price_factors ORDER BY sortkey|; + + $self->{$key} = selectall_hashref_query($self, $dbh, $query); + + $main::lxdebug->leave_sub(); +} + sub get_lists { $main::lxdebug->enter_sub(); @@ -1924,11 +1967,19 @@ sub get_lists { } if($params{"customers"}) { - $self->_get_customers($dbh, $params{"customers"}); + if (ref $params{"customers"} eq 'HASH') { + $self->_get_customers($dbh, $params{"customers"}{key}, $params{"customers"}{limit}); + } else { + $self->_get_customers($dbh, $params{"customers"}); + } } if($params{"vendors"}) { - $self->_get_vendors($dbh, $params{"vendors"}); + if (ref $params{"vendors"} eq 'HASH') { + $self->_get_vendors($dbh, $params{"vendors"}{key}, $params{"vendors"}{limit}); + } else { + $self->_get_vendors($dbh, $params{"vendors"}); + } } if($params{"payments"}) { @@ -1939,6 +1990,10 @@ sub get_lists { $self->_get_departments($dbh, $params{"departments"}); } + if ($params{price_factors}) { + $self->_get_price_factors($dbh, $params{price_factors}); + } + $main::lxdebug->leave_sub(); } @@ -2176,7 +2231,7 @@ sub create_links { while ($ref = $sth->fetchrow_hashref(NAME_lc)) { foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /$module/) { + if ($key =~ /\Q$module\E/) { # cross reference for keys $xkeyref{ $ref->{accno} } = $key; @@ -2235,7 +2290,7 @@ sub create_links { LEFT JOIN taxkeys tk ON (tk.chart_id = c.id) WHERE c.link LIKE ? AND (tk.id = (SELECT id FROM taxkeys WHERE taxkeys.chart_id = c.id AND startdate <= $transdate ORDER BY startdate DESC LIMIT 1) - OR c.link LIKE '%_tax%') + OR c.link LIKE '%_tax%' OR c.taxkey_id IS NULL) ORDER BY c.accno|; $sth = $dbh->prepare($query); @@ -2245,7 +2300,7 @@ sub create_links { while ($ref = $sth->fetchrow_hashref(NAME_lc)) { foreach my $key (split(/:/, $ref->{link})) { - if ($key =~ /$module/) { + if ($key =~ /\Q$module\E/) { # cross reference for keys $xkeyref{ $ref->{accno} } = $key; @@ -2435,8 +2490,7 @@ sub redo_rows { my @ndx = (); - map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } - (1 .. $count); + map { push @ndx, { num => $new->[$_ - 1]->{runningnumber}, ndx => $_ } } 1 .. $count; my $i = 0; @@ -2477,8 +2531,8 @@ sub update_status { } $sth->finish(); - my $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - my $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + my $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + my $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; my %queued = split / /, $self->{queued}; my @values; @@ -2522,7 +2576,7 @@ sub save_status { my $formnames = $self->{printed}; my $emailforms = $self->{emailed}; - my $query = qq|DELETE FROM status + $query = qq|DELETE FROM status WHERE (formname = ?) AND (trans_id = ?)|; do_query($self, $dbh, $query, $self->{formname}, $self->{id}); @@ -2533,15 +2587,15 @@ sub save_status { my %queued = split / /, $self->{queued}; foreach my $formname (keys %queued) { - $printed = ($self->{printed} =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($self->{emailed} =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($self->{printed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; + $emailed = ($self->{emailed} =~ /\Q$self->{formname}\E/) ? "1" : "0"; $query = qq|INSERT INTO status (trans_id, printed, emailed, spoolfile, formname) VALUES (?, ?, ?, ?, ?)|; do_query($self, $dbh, $query, $self->{id}, $printed, $emailed, $queued{$formname}, $formname); - $formnames =~ s/$self->{formname}//; - $emailforms =~ s/$self->{formname}//; + $formnames =~ s/\Q$self->{formname}\E//; + $emailforms =~ s/\Q$self->{formname}\E//; } } @@ -2555,8 +2609,8 @@ sub save_status { map { $status{$_}{emailed} = 1 } split / +/, $emailforms; foreach my $formname (keys %status) { - $printed = ($formnames =~ /$self->{formname}/) ? "1" : "0"; - $emailed = ($emailforms =~ /$self->{formname}/) ? "1" : "0"; + $printed = ($formnames =~ /\Q$self->{formname}\E/) ? "1" : "0"; + $emailed = ($emailforms =~ /\Q$self->{formname}\E/) ? "1" : "0"; $query = qq|INSERT INTO status (trans_id, printed, emailed, formname) VALUES (?, ?, ?, ?)|;