use Data::Dumper;
use Carp;
-use Config;
use CGI;
use Cwd;
use Encode;
use List::MoreUtils qw(all any apply);
use SL::DB::Tax;
use SL::Helper::File qw(:all);
+use SL::Helper::Number;
use SL::Helper::CreatePDF qw(merge_pdfs);
use strict;
my $session_cookie_value = $main::auth->get_session_id();
if ($session_cookie_value) {
- $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
- '-value' => $session_cookie_value,
- '-path' => $uri->path,
- '-secure' => $::request->is_https);
+ $session_cookie = $cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
+ '-value' => $session_cookie_value,
+ '-path' => $uri->path,
+ '-expires' => '+' . $::auth->{session_timeout} . 'm',
+ '-secure' => $::request->is_https);
}
}
return @columns;
}
#
-sub format_amount {
- $main::lxdebug->enter_sub(2);
+sub format_amount {
my ($self, $myconfig, $amount, $places, $dash) = @_;
- $amount ||= 0;
- $dash ||= '';
- my $neg = $amount < 0;
- my $force_places = defined $places && $places >= 0;
-
- $amount = $self->round_amount($amount, abs $places) if $force_places;
- $neg = 0 if $amount == 0; # don't show negative zero
- $amount = sprintf "%.*f", ($force_places ? $places : 10), abs $amount; # 6 is default for %fa
-
- # before the sprintf amount was a number, afterwards it's a string. because of the dynamic nature of perl
- # this is easy to confuse, so keep in mind: before this comment no s///, m//, concat or other strong ops on
- # $amount. after this comment no +,-,*,/,abs. it will only introduce subtle bugs.
-
- $amount =~ s/0*$// unless defined $places && $places == 0; # cull trailing 0s
-
- my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
- my @p = split(/\./, $amount); # split amount at decimal point
-
- $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
- $amount = $p[0];
- if ($places || $p[1]) {
- $amount .= $d[0]
- . ( $p[1] || '' )
- . (0 x max(abs($places || 0) - length ($p[1]||''), 0)); # pad the fraction
- }
-
- $amount = do {
- ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) :
- ($dash =~ /DRCR/) ? ($neg ? "$amount " . $main::locale->text('DR') : "$amount " . $main::locale->text('CR') ) :
- ($neg ? "-$amount" : "$amount" ) ;
- };
-
- $main::lxdebug->leave_sub(2);
- return $amount;
+ SL::Helper::Number::_format_number($amount, $places, %$myconfig, dash => $dash);
}
sub format_amount_units {
#
sub parse_amount {
- $main::lxdebug->enter_sub(2);
-
my ($self, $myconfig, $amount) = @_;
-
- if (!defined($amount) || ($amount eq '')) {
- $main::lxdebug->leave_sub(2);
- return 0;
- }
-
- if ( ($myconfig->{numberformat} eq '1.000,00')
- || ($myconfig->{numberformat} eq '1000,00')) {
- $amount =~ s/\.//g;
- $amount =~ s/,/\./g;
- }
-
- if ($myconfig->{numberformat} eq "1'000.00") {
- $amount =~ s/\'//g;
- }
-
- $amount =~ s/,//g;
-
- $main::lxdebug->leave_sub(2);
-
- # Make sure no code wich is not a math expression ends up in eval().
- return 0 unless $amount =~ /^ [\s \d \( \) \- \+ \* \/ \. ]* $/x;
-
- # Prevent numbers from being parsed as octals;
- $amount =~ s{ (?<! [\d.] ) 0+ (?= [1-9] ) }{}gx;
-
- return scalar(eval($amount)) * 1 ;
+ SL::Helper::Number::_parse_number($amount, %$myconfig);
}
-sub round_amount {
- my ($self, $amount, $places, $adjust) = @_;
-
- return 0 if !defined $amount;
-
- $places //= 0;
-
- if ($adjust) {
- my $precision = $::instance_conf->get_precision || 0.01;
- return $self->round_amount( $self->round_amount($amount / $precision, 0) * $precision, $places);
- }
-
- # We use Perl's knowledge of string representation for
- # rounding. First, convert the floating point number to a string
- # with a high number of places. Then split the string on the decimal
- # sign and use integer calculation for rounding the decimal places
- # part. If an overflow occurs then apply that overflow to the part
- # before the decimal sign as well using integer arithmetic again.
-
- my $int_amount = int(abs $amount);
- my $str_places = max(min(10, 16 - length("$int_amount") - $places), $places);
- my $amount_str = sprintf '%.*f', $places + $str_places, abs($amount);
-
- return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
-
- my ($pre, $post) = ($1, $2);
- my $decimals = '1' . substr($post, 0, $places);
-
- my $propagation_limit = $Config{i32size} == 4 ? 7 : 18;
- my $add_for_rounding = substr($post, $places, 1) >= 5 ? 1 : 0;
-
- if ($places > $propagation_limit) {
- $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding);
- $pre = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2';
-
- } else {
- $decimals += $add_for_rounding;
- $pre += 1 if substr($decimals, 0, 1) eq '2';
- }
-
- $amount = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0);
-
- return $amount;
-}
+sub round_amount { shift; goto &SL::Helper::Number::_round_number; }
sub parse_template {
$main::lxdebug->enter_sub();
return $formname_translations{$formname};
}
+sub get_cusordnumber_translation {
+ $main::lxdebug->enter_sub();
+ my ($self, $formname) = @_;
+
+ $formname ||= $self->{formname};
+
+ $self->{recipient_locale} ||= Locale->lang_to_locale($self->{language});
+ local $::locale = Locale->new($self->{recipient_locale});
+
+
+ $main::lxdebug->leave_sub();
+ return $main::locale->text('Your Order');
+}
+
sub get_number_prefix_for_type {
$main::lxdebug->enter_sub();
my ($self) = @_;
$subject .= " " . $self->{"${prefix}number"}
}
+ if ($self->{cusordnumber}) {
+ $subject = $self->get_cusordnumber_translation() . ' ' . $self->{cusordnumber} . ' / ' . $subject;
+ }
+
$main::lxdebug->leave_sub();
return $subject;
}
$self->{"employee_${_}"} = $defaults->$_ for qw(address businessnumber co_ustid company duns sepa_creditor_id taxnumber);
}
- # Load shipping address from database. If shipto_id is set then it's
- # one from the customer's/vendor's master data. Otherwise look an a
- # customized address linking back to the current record.
- my $shipto_module = $self->{type} =~ /_delivery_order$/ ? 'DO'
- : $self->{type} =~ /sales_order|sales_quotation|request_quotation|purchase_order/ ? 'OE'
- : 'AR';
- my $shipto = $self->{shipto_id} ? SL::DB::Shipto->new(shipto_id => $self->{shipto_id})->load
- : SL::DB::Manager::Shipto->get_first(where => [ module => $shipto_module, trans_id => $self->{id} ]);
- if ($shipto) {
- $self->{$_} = $shipto->$_ for grep { m{^shipto} } map { $_->name } @{ $shipto->meta->columns };
- $self->{"shiptocvar_" . $_->config->name} = $_->value_as_text for @{ $shipto->cvars_by_config };
- }
-
my $language = $self->{language} ? '_' . $self->{language} : '';
my ($language_tc, $output_numberformat, $output_dateformat, $output_longdates);