X-Git-Url: http://wagnertech.de/git?a=blobdiff_plain;f=SL%2FForm.pm;h=32a82e08bd3595baf0fff992a8a909309f95d2fa;hb=161005107167fd80ef1d9e95d5066ec142661ee0;hp=e0207243ff409bce4610b60d60f16b8a02327d4f;hpb=93c6ec51f6bb239eb52c3e0b0d1adf87f57796ee;p=kivitendo-erp.git diff --git a/SL/Form.pm b/SL/Form.pm index e0207243f..32a82e08b 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -203,7 +203,10 @@ sub _recode_recursively { if (any { ref $param eq $_ } qw(Form HASH)) { foreach my $key (keys %{ $param }) { if (!ref $param->{$key}) { - $param->{$key} = $iconv->convert($param->{$key}); + # Workaround for a bug: converting $param->{$key} directly + # leads to 'undef'. I don't know why. Converting a copy works, + # though. + $param->{$key} = $iconv->convert("" . $param->{$key}); } else { _recode_recursively($iconv, $param->{$key}); } @@ -212,7 +215,10 @@ sub _recode_recursively { } elsif (ref $param eq 'ARRAY') { foreach my $idx (0 .. scalar(@{ $param }) - 1) { if (!ref $param->[$idx]) { - $param->[$idx] = $iconv->convert($param->[$idx]); + # Workaround for a bug: converting $param->[$idx] directly + # leads to 'undef'. I don't know why. Converting a copy works, + # though. + $param->[$idx] = $iconv->convert("" . $param->[$idx]); } else { _recode_recursively($iconv, $param->[$idx]); } @@ -264,7 +270,7 @@ sub new { $self->{action} = lc $self->{action}; $self->{action} =~ s/( |-|,|\#)/_/g; - $self->{version} = "2.6.0"; + $self->{version} = "2.6.1"; $main::lxdebug->leave_sub(); @@ -714,7 +720,7 @@ sub _prepare_html_template { my ($self, $file, $additional_params) = @_; my $language; - if (!defined(%main::myconfig) || !defined($main::myconfig{"countrycode"})) { + if (!%::myconfig || !$::myconfig{"countrycode"}) { $language = $main::language; } else { $language = $main::myconfig{"countrycode"}; @@ -766,6 +772,7 @@ sub _prepare_html_template { $additional_params->{"conf_latex_templates"} = $main::latex; $additional_params->{"conf_opendocument_templates"} = $main::opendocument_templates; $additional_params->{"conf_vertreter"} = $main::vertreter; + $additional_params->{"conf_show_best_before"} = $main::show_best_before; if (%main::debug_options) { map { $additional_params->{'DEBUG_' . uc($_)} = $main::debug_options{$_} } keys %main::debug_options; @@ -1120,13 +1127,13 @@ sub round_amount { my ($self, $amount, $places) = @_; my $round_amount; - # Rounding like "Kaufmannsrunden" - # Descr. http://de.wikipedia.org/wiki/Rundung - # Inspired by - # http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html - # Solves Bug: 189 - # Udo Spallek - $amount = $amount * (10**($places)); + # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung ) + + # Round amounts to eight places before rounding to the requested + # number of places. This gets rid of errors due to internal floating + # point representation. + $amount = $self->round_amount($amount, 8) if $places < 8; + $amount = $amount * (10**($places)); $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places)); $main::lxdebug->leave_sub(2); @@ -1732,7 +1739,7 @@ sub check_exchangerate { return $exchangerate; } -sub get_default_currency { +sub get_all_currencies { $main::lxdebug->enter_sub(); my ($self, $myconfig) = @_; @@ -1740,14 +1747,24 @@ sub get_default_currency { my $query = qq|SELECT curr FROM defaults|; - my ($curr) = selectrow_query($self, $dbh, $query); - my ($defaultcurrency) = split m/:/, $curr; + my ($curr) = selectrow_query($self, $dbh, $query); + my @currencies = grep { $_ } map { s/\s//g; $_ } split m/:/, $curr; $main::lxdebug->leave_sub(); - return $defaultcurrency; + return @currencies; } +sub get_default_currency { + $main::lxdebug->enter_sub(); + + my ($self, $myconfig) = @_; + my @currencies = $self->get_all_currencies($myconfig); + + $main::lxdebug->leave_sub(); + + return $currencies[0]; +} sub set_payment_options { $main::lxdebug->enter_sub(); @@ -2293,14 +2310,15 @@ $main::lxdebug->enter_sub(); sub _get_customers { $main::lxdebug->enter_sub(); - my ($self, $dbh, $key, $limit) = @_; + my ($self, $dbh, $key) = @_; - $key = "all_customers" unless ($key); - my $limit_clause = "LIMIT $limit" if $limit; + my $options = ref $key eq 'HASH' ? $key : { key => $key }; + $options->{key} ||= "all_customers"; + my $limit_clause = "LIMIT $options->{limit}" if $options->{limit}; + my $where = $options->{business_is_salesman} ? qq| AND business_id IN (SELECT id FROM business WHERE salesman)| : ''; - my $query = qq|SELECT * FROM customer WHERE NOT obsolete ORDER BY name $limit_clause|; - - $self->{$key} = selectall_hashref_query($self, $dbh, $query); + my $query = qq|SELECT * FROM customer WHERE NOT obsolete $where ORDER BY name $limit_clause|; + $self->{ $options->{key} } = selectall_hashref_query($self, $dbh, $query); $main::lxdebug->leave_sub(); } @@ -2467,11 +2485,7 @@ sub get_lists { } if($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"}); - } + $self->_get_customers($dbh, $params{"customers"}); } if($params{"vendors"}) { @@ -2573,7 +2587,7 @@ sub all_vc { my ($count) = selectrow_query($self, $dbh, $query); # build selection list - if ($count < $myconfig->{vclimit}) { + if ($count <= $myconfig->{vclimit}) { $query = qq|SELECT id, name, salesman_id FROM $table WHERE NOT obsolete ORDER BY name|;