return @columns;
}
-
+#
sub format_amount {
$main::lxdebug->enter_sub(2);
my ($self, $myconfig, $amount, $places, $dash) = @_;
+ my $neg = ($amount =~ s/-//);
- #Workaround for $format_amount calls without $places
- if (!defined $places) {
- (my $dec) = ($amount =~ /\.(\d+)/);
- $places = length $dec;
- }
-
- if ($places =~ /\d/) {
- $amount = $self->round_amount($amount, $places);
- }
-
- # is the amount negative
- my $negative = ($amount < 0);
- my $fillup = "";
+ $amount = $self->round_amount($amount, $places) if ($places =~ /\d/);
- if ($amount != 0) {
- if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00'))
- {
- my ($whole, $dec) = split /\./, "$amount";
- $whole =~ s/-//;
- $amount = join '', reverse split //, $whole;
- $fillup = "0" x ($places - length($dec));
+ my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
+ my @p = split /\./, $amount ; # split amount at decimal point
- if ($myconfig->{numberformat} eq '1,000.00') {
- $amount =~ s/\d{3,}?/$&,/g;
- $amount =~ s/,$//;
- $amount = join '', reverse split //, $amount;
- $amount .= "\.$dec" . $fillup if ($places ne '' && $places * 1 != 0);
- }
-
- if ($myconfig->{numberformat} eq '1.000,00') {
- $amount =~ s/\d{3,}?/$&./g;
- $amount =~ s/\.$//;
- $amount = join '', reverse split //, $amount;
- $amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0);
- }
-
- if ($myconfig->{numberformat} eq '1000,00') {
- $amount = "$whole";
- $amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0);
- }
-
- if ($dash =~ /-/) {
- $amount = ($negative) ? "($amount)" : "$amount";
- } elsif ($dash =~ /DRCR/) {
- $amount = ($negative) ? "$amount DR" : "$amount CR";
- } else {
- $amount = ($negative) ? "-$amount" : "$amount";
- }
- }
- } else {
- if ($dash eq "0" && $places) {
- if ($myconfig->{numberformat} eq '1.000,00') {
- $amount = "0" . "," . "0" x $places;
- } else {
- $amount = "0" . "." . "0" x $places;
- }
- } else {
- $amount = ($dash ne "") ? "$dash" : "0";
- }
- }
+ $p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters
+ $amount = $p[0];
+ $amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne '');
+
+ $amount = do {
+ ($dash =~ /-/) ? ($neg ? "($amount)" : "$amount" ) :
+ ($dash =~ /DRCR/) ? ($neg ? "$amount DR" : "$amount CR" ) :
+ ($neg ? "-$amount" : "$amount" ) ;
+ };
+
$main::lxdebug->leave_sub(2);
-
return $amount;
}
-
+#
sub parse_amount {
$main::lxdebug->enter_sub(2);
my $sum = 0;
# } Moritz Bunkus
+ # The old fixed notation of <%variable%> is changed to a new dynamic one.
+ my ${pre} = '<%'; # Variable Prefix, must be regex save!
+ my ${suf} = '%>'; # Variable Suffix, must be regex save!
+
+
# Make sure that all *notes* (intnotes, partnotes_*, notes etc) are converted to markup correctly.
$self->format_string(grep(/notes/, keys(%{$self})));
$two_passes = 0;
# first we generate a tmpfile
- # read file and replace <%variable%>
+ # read file and replace ${pre}variable${suf}
while ($_ = shift) {
$par = "";
$var = $_;
- # Switch <%analyse%> for template checking
- # If <%analyse%> is set in the template, you'll find the
+ # Switch ${pre}analyse${suf} for template checking
+ # If ${pre}analyse${suf} is set in the template, you'll find the
# parsed output in the user Directory for analysing
# Latex errors
- # <%analyse%> is a switch (allways off, on if set), not a Variable
+ # ${pre}analyse${suf} is a switch (allways off, on if set), not a Variable
# Set $form->{analysing}="" for system state: never analyse.
# Set $form->{analysing}="1" for system state: ever analyse.
- $self->{analysing} = "1" if (/<%analyse%>/ && !defined $self->{analysing});
+ $self->{analysing} = "1" if (/${pre}analyse${suf}/ && !defined $self->{analysing});
$two_passes = 1 if (/\\pageref/);
# { Moritz Bunkus
# detect pagebreak block and its parameters
- if (/\s*<%pagebreak ([0-9]+) ([0-9]+) ([0-9]+)%>/) {
+ if (/\s*${pre}pagebreak ([0-9]+) ([0-9]+) ([0-9]+)${suf}/) {
$chars_per_line = $1;
$lines_on_first_page = $2;
$lines_on_second_page = $3;
while ($_ = shift) {
- last if (/\s*<%end pagebreak%>/);
+ last if (/\s*${pre}end pagebreak${suf}/);
$pagebreak .= $_;
}
}
# } Moritz Bunkus
-
- if (/\s*<%foreach /) {
+
+ if (/\s*${pre}foreach /) {
# this one we need for the count
chomp $var;
- $var =~ s/\s*<%foreach (.+?)%>/$1/;
+ $var =~ s/\s*${pre}foreach (.+?)${suf}/$1/;
while ($_ = shift) {
- last if (/\s*<%end /);
+ last if (/\s*${pre}end /);
# store line in $par
$par .= $_;
# { Moritz Bunkus
# Try to detect whether a manual page break is necessary
- # but only if there was a <%pagebreak ...%> block before
+ # but only if there was a ${pre}pagebreak ...${suf} block before
if ($chars_per_line) {
my $lines =
) {
my $pb = $pagebreak;
- # replace the special variables <%sumcarriedforward%>
- # and <%lastpage%>
+ # replace the special variables ${pre}sumcarriedforward${suf}
+ # and ${pre}lastpage${suf}
my $psum = $self->format_amount($myconfig, $sum, 2);
- $pb =~ s/<%sumcarriedforward%>/$psum/g;
- $pb =~ s/<%lastpage%>/$current_page/g;
+ $pb =~ s/${pre}sumcarriedforward${suf}/$psum/g;
+ $pb =~ s/${pre}lastpage${suf}/$current_page/g;
# only "normal" variables are supported here
- # (no <%if, no <%foreach, no <%include)
+ # (no ${pre}if, no ${pre}foreach, no ${pre}include)
- $pb =~ s/<%(.+?)%>/$self->{$1}/g;
+ $pb =~ s/${pre}(.+?)${suf}/$self->{$1}/g;
# page break block is ready to rock
print(OUT $pb);
# don't parse par, we need it for each line
$_ = $par;
- s/<%(.+?)%>/$self->{$1}[$i]/mg;
+ s/${pre}(.+?)${suf}/$self->{$1}[$i]/mg;
print OUT;
}
next;
}
# if not comes before if!
- if (/\s*<%if not /) {
+ if (/\s*${pre}if not /) {
# check if it is not set and display
chop;
- s/\s*<%if not (.+?)%>/$1/;
+ s/\s*${pre}if not (.+?)${suf}/$1/;
unless ($self->{$_}) {
while ($_ = shift) {
- last if (/\s*<%end /);
+ last if (/\s*${pre}end /);
# store line in $par
$par .= $_;
} else {
while ($_ = shift) {
- last if (/\s*<%end /);
+ last if (/\s*${pre}end /);
}
next;
}
}
- if (/\s*<%if /) {
+ if (/\s*${pre}if /) {
# check if it is set and display
chop;
- s/\s*<%if (.+?)%>/$1/;
+ s/\s*${pre}if (.+?)${suf}/$1/;
if ($self->{$_}) {
while ($_ = shift) {
- last if (/\s*<%end /);
+ last if (/\s*${pre}end /);
# store line in $par
$par .= $_;
} else {
while ($_ = shift) {
- last if (/\s*<%end /);
+ last if (/\s*${pre}end /);
}
next;
}
}
- # check for <%include filename%>
- if (/\s*<%include /) {
+ # check for ${pre}include filename${suf}
+ if (/\s*${pre}include /) {
# get the directory/filename
chomp $var;
- $var =~ s/\s*<%include (.+?)%>/$1/;
+ $var =~ s/\s*${pre}include (.+?)${suf}/$1/;
# mangle filename on basedir
$var =~ s/^(\/|\.\.)//g;
next;
}
- s/<%(.+?)%>/$self->{$1}/g;
+ s/${pre}(.+?)${suf}/$self->{$1}/g;
s/<nobr><\/nobr>/ /g;
print OUT;
}