X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=25d437fd1a2517af3266e15895994eae44a75d3f;hb=6216f7b53a81a73641a2d98ea43f363b6a615b07;hp=50b2e025d68bb394de22840248ebd506b4dd602d;hpb=ce47a2340ef118b494854deae1b0ddc74b1d1c5a;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index 50b2e025d..25d437fd1 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -40,6 +40,7 @@ use Data::Dumper; use Cwd; use HTML::Template; +use Template; use SL::Template; use CGI::Ajax; use SL::DBUtils; @@ -180,7 +181,7 @@ sub new { $self->{action} = lc $self->{action}; $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.4.2"; + $self->{version} = "2.4.3"; $main::lxdebug->leave_sub(); @@ -293,11 +294,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(); @@ -385,10 +382,15 @@ sub header { if ($ENV{HTTP_USER_AGENT}) { - if ($self->{stylesheet} && (-f "css/$self->{stylesheet}")) { - $stylesheet = - qq| - |; + 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}; @@ -474,7 +476,7 @@ sub header { $main::lxdebug->leave_sub(); } -sub parse_html_template { +sub _prepare_html_template { $main::lxdebug->enter_sub(); my ($self, $file, $additional_params) = @_; @@ -508,14 +510,6 @@ sub parse_html_template { die($info); } - my $template = HTML::Template->new("filename" => $file, - "die_on_bad_params" => 0, - "strict" => 0, - "case_sensitive" => 1, - "loop_context_vars" => 1, - "global_vars" => 1); - - $additional_params = {} unless ($additional_params); if ($self->{"DEBUG"}) { $additional_params->{"DEBUG"} = $self->{"DEBUG"}; } @@ -539,16 +533,70 @@ sub parse_html_template { $additional_params->{"conf_latex_templates"} = $main::latex; $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates; - my @additional_param_names = keys(%{$additional_params}); + if (%main::debug_options) { + map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options; + } + + $main::lxdebug->leave_sub(); + + return $file; +} + +sub parse_html_template { + $main::lxdebug->enter_sub(); + + my ($self, $file, $additional_params) = @_; + + $additional_params ||= { }; + + $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 = $self->{$key}; - $param = $additional_params->{$key} if (grep(/^${key}$/, @additional_param_names)); + 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, + }) || die; + + map { $additional_params->{$_} ||= $self->{$_} } keys %{ $self }; + + my $output; + if (!$template->process($file, $additional_params, \$output)) { + print STDERR $template->error(); + } + + $output = $main::locale->{iconv}->convert($output) if ($main::locale); + $main::lxdebug->leave_sub(); return $output; @@ -645,7 +693,9 @@ sub redirect { if ($self->{callback}) { - ($script, $argv) = split(/\?/, $self->{callback}); + ($script, $argv) = split(/\?/, $self->{callback}, 2); + $script =~ s|.*/||; + $script =~ s|[^a-zA-Z0-9_\.]||g; exec("perl", "$script", $argv); } else { @@ -676,18 +726,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); } @@ -710,6 +765,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); @@ -797,6 +868,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 @@ -935,8 +1010,10 @@ Content-Length: $numbytes $main::lxdebug->leave_sub(); } -sub generate_attachment_filename { - my ($self) = @_; +sub get_formname_translation { + my ($self, $formname) = @_; + + $formname ||= $self->{formname}; my %formname_translations = ( bin_list => $main::locale->text('Bin List'), @@ -953,7 +1030,13 @@ sub generate_attachment_filename { storno_packing_list => $main::locale->text('Storno Packing List'), ); - my $attachment_filename = $formname_translations{$self->{"formname"}}; + return $formname_translations{$formname} +} + +sub generate_attachment_filename { + my ($self) = @_; + + my $attachment_filename = $self->get_formname_translation(); my $prefix = (grep { $self->{"type"} eq $_ } qw(invoice credit_note)) ? "inv" : ($self->{"type"} =~ /_quotation$/) ? "quo" @@ -1127,6 +1210,16 @@ sub update_exchangerate { if ($curr eq '') { $main::lxdebug->leave_sub(); return; + } + my $query = qq|SELECT curr FROM defaults|; + + my ($currency) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $currency; + + + if ($curr eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return; } my $query = qq|SELECT e.curr FROM exchangerate e @@ -1134,6 +1227,16 @@ sub update_exchangerate { FOR UPDATE|; my $sth = prepare_execute_query($self, $dbh, $query, $curr, $transdate); + if ($buy == 0) { + $buy = ""; + } + if ($sell == 0) { + $sell = ""; + } + + $buy = conv_i($buy, "NULL"); + $sell = conv_i($sell, "NULL"); + my $set; if ($buy != 0 && $sell != 0) { $set = "buy = $buy, sell = $sell"; @@ -1148,6 +1251,7 @@ sub update_exchangerate { SET $set WHERE curr = ? AND transdate = ?|; + } else { $query = qq|INSERT INTO exchangerate (curr, buy, sell, transdate) VALUES (?, $buy, $sell, ?)|; @@ -1165,12 +1269,15 @@ sub save_exchangerate { my $dbh = $self->dbconnect($myconfig); - my ($buy, $sell) = (0, 0); + my ($buy, $sell); + $buy = $rate if $fld eq 'buy'; $sell = $rate if $fld eq 'sell'; + $self->update_exchangerate($dbh, $currency, $transdate, $buy, $sell); + $dbh->disconnect; $main::lxdebug->leave_sub(); @@ -1186,13 +1293,21 @@ sub get_exchangerate { return 1; } + my $query = qq|SELECT curr FROM defaults|; + + my ($currency) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $currency; + + if ($currency eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return 1; + } + my $query = qq|SELECT e.$fld FROM exchangerate e WHERE e.curr = ? AND e.transdate = ?|; my ($exchangerate) = selectrow_query($self, $dbh, $query, $curr, $transdate); - if (!$exchangerate) { - $exchangerate = 1; - } + $main::lxdebug->leave_sub(); @@ -1209,14 +1324,19 @@ sub check_exchangerate { return ""; } - my $dbh = $self->dbconnect($myconfig); + my ($defaultcurrency) = $self->get_default_currency($myconfig); + + if ($currency eq $defaultcurrency) { + $main::lxdebug->leave_sub(); + return 1; + } + my $dbh = $self->get_standard_dbh($myconfig); my $query = qq|SELECT e.$fld FROM exchangerate e WHERE e.curr = ? AND e.transdate = ?|; + my ($exchangerate) = selectrow_query($self, $dbh, $query, $currency, $transdate); - $dbh->disconnect(); - $exchangerate = 1 if ($exchangerate == 0); $exchangerate = 1 if ($exchangerate eq ""); $main::lxdebug->leave_sub(); @@ -1224,6 +1344,23 @@ sub check_exchangerate { return $exchangerate; } +sub get_default_currency { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + my $dbh = $self->get_standard_dbh($myconfig); + + my $query = qq|SELECT curr FROM defaults|; + + my ($curr) = selectrow_query($self, $dbh, $query); + my ($defaultcurrency) = split m/:/, $curr; + + $main::lxdebug->leave_sub(); + + return $defaultcurrency; +} + + sub set_payment_options { $main::lxdebug->enter_sub(); @@ -1256,12 +1393,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}; - $self->{skonto_amount} = - $self->format_amount($myconfig, $skonto_amount, 2); + } 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; + + $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 = @@ -1289,23 +1446,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(); } @@ -1370,6 +1525,7 @@ sub add_shipto { my $shipto; my @values; + foreach my $item (qw(name department_1 department_2 street zipcode city country contact phone fax email)) { if ($self->{"shipto$item"}) { @@ -1377,6 +1533,7 @@ sub add_shipto { } push(@values, $self->{"shipto${item}"}); } + if ($shipto) { if ($self->{shipto_id}) { my $query = qq|UPDATE shipto set @@ -1405,8 +1562,10 @@ sub add_shipto { shiptocontact = ? AND shiptophone = ? AND shiptofax = ? AND - shiptoemail = ?|; - my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values); + shiptoemail = ? AND + module = ? AND + trans_id = ?|; + my $insert_check = selectfirst_hashref_query($self, $dbh, $query, @values, $module, $id); if(!$insert_check){ $query = qq|INSERT INTO shipto (trans_id, shiptoname, shiptodepartment_1, shiptodepartment_2, @@ -1744,6 +1903,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(); @@ -1826,6 +1999,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(); } @@ -2063,7 +2240,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; @@ -2122,7 +2299,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); @@ -2132,7 +2309,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; @@ -2364,8 +2541,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; @@ -2420,15 +2597,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//; } } @@ -2442,8 +2619,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 (?, ?, ?, ?)|; @@ -2549,8 +2726,14 @@ sub update_defaults { my ($var) = $sth->fetchrow_array; $sth->finish; - $var =~ s/\d+$/ sprintf '%0*d', length($&), $&+1 /e; - $var ||= 1; + if ($var =~ m/\d+$/) { + my $new_var = (substr $var, $-[0]) * 1 + 1; + my $len_diff = length($var) - $-[0] - length($new_var); + $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var; + + } else { + $var = $var . '1'; + } $query = qq|UPDATE defaults SET $fld = ?|; do_query($self, $dbh, $query, $var); @@ -2581,8 +2764,15 @@ sub update_business { WHERE id = ? FOR UPDATE|; my ($var) = selectrow_query($self, $dbh, $query, $business_id); - $var =~ s/\d+$/ sprintf '%0*d', length($&), $&+1 /e; - + if ($var =~ m/\d+$/) { + my $new_var = (substr $var, $-[0]) * 1 + 1; + my $len_diff = length($var) - $-[0] - length($new_var); + $var = substr($var, 0, $-[0]) . ($len_diff > 0 ? '0' x $len_diff : '') . $new_var; + + } else { + $var = $var . '1'; + } + $query = qq|UPDATE business SET customernumberinit = ? WHERE id = ?|; @@ -2706,30 +2896,4 @@ sub all_years { $main::lxdebug->leave_sub(); } -sub mark_as_paid { - $main::lxdebug->enter_sub(); - - my ($self, $myconfig, $db_name) = @_; - - if($self->{mark_as_paid}) { - my $dbh ||= $self->get_standard_dbh($myconfig); - my $query = qq|UPDATE $db_name SET paid = amount WHERE id = ?|; - do_query($self, $dbh, $query, $self->{id}); - $dbh->commit(); - $self->redirect($main::locale->text("Marked as paid")); - } - else { - my $referer = $ENV{HTTP_REFERER}; - $referer =~ s/^(.*)action\=.*\&(.*)$/$1action\=mark_as_paid\&mark_as_paid\=1\&login\=$self->{login}\&password\=$self->{password}\&id\=$self->{id}\&$2/; - $self->header(); - print qq||; - print qq|

|.$main::locale->text('Mark as paid?').qq|

|; - print qq| |; - print qq||; - print qq||; - } - - $main::lxdebug->leave_sub(); -} - 1;