version 1.4, 2020/10/20 09:23:24 |
version 1.9, 2020/11/19 23:55:50 |
|
|
use strict; |
use strict; |
|
|
use Getopt::Std qw(getopts); |
use Getopt::Std qw(getopts); |
|
use Time::Local qw(timegm); |
|
|
our ($opt_a, $opt_b, $opt_c, $opt_L, $opt_n, $opt_p, $opt_s); |
our ($opt_a, $opt_b, $opt_c, $opt_D, $opt_L, $opt_n, $opt_p, $opt_s); |
|
|
my %accounts; # {ano}{type, text}; from pta-accounts(5) |
my %accounts; # {ano}{type, text}; from pta-accounts(5) |
my %alist; # {ano}{subname, ''}[]; contains lists of entries |
my %alist; # {ano}{subname, ''}[]; contains lists of entries |
my %cclist; # {cc}{ano}[]; contains lists of entries |
my %cclist; # {cc}{ano}[]; contains lists of entries |
my %entry; # {year, month, day, date, id, contra, |
my %entry; # {year, month, day, date, daynum, id, contra, |
# amount, rel, old, days, skip, cc, text, sum} |
# amount, rel, old, days, skip, cc, text, sum} |
my %prices; # {cc}{year, month, day, date, days, price} |
my %prices; # {cc}{year, month, day, date, daynum, price} |
my %profit; # {cc}[]; contains lists of profit entries |
my %profit; # {cc}[]; contains lists of profit entries |
my %ptot; # {cc}{profit, percent, capital, pcpa, days} |
my %ptot; # {cc}{profit, percent, capital, pcpa, days} |
|
my $startday; # Initialized by the first journal line. |
|
my $endday = (timegm 0, 0, 0, 31, 11, 99999) / 86400; |
|
|
my %atypes = ( |
my %atypes = ( |
A => 'Assets', |
A => 'Assets', |
Line 87 sub translate_type ($) { |
|
Line 90 sub translate_type ($) { |
|
# but does not handle unrealized profits and losses. |
# but does not handle unrealized profits and losses. |
sub make_entry (\%$) { |
sub make_entry (\%$) { |
my ($entry, $ano) = @_; |
my ($entry, $ano) = @_; |
|
return if $entry->{daynum} > $endday; |
my $sub = $accounts{$ano}{type} =~ /[RX]/ && |
my $sub = $accounts{$ano}{type} =~ /[RX]/ && |
$entry->{text} =~ s/\((.*?)\) *// ? $1 : ''; |
$entry->{text} =~ s/\((.*?)\) *// ? $1 : ''; |
my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0; |
my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0; |
|
|
|
|
# === MAIN PROGRAM ===================================================== |
# === MAIN PROGRAM ===================================================== |
|
|
getopts 'abcL:nps' or usage; |
getopts 'abcD:L:nps' or usage; |
$opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1 |
$opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1 |
unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s; |
unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s; |
|
if ($opt_D) { |
|
$opt_D =~ /^(?:(\d{4})(\d{2})(\d{2}):)?(?:(\d{4})(\d{2})(\d{2}))?$/ |
|
or die "-D parse error: $opt_D"; |
|
$startday = (timegm 0, 0, 0, $3, $2 - 1, $1) / 86400 if $1; |
|
$endday = (timegm 0, 0, 0, $6, $5 - 1, $4) / 86400 if $4; |
|
} |
unless ($translations = $translations->{$opt_L || 'en'}) { |
unless ($translations = $translations->{$opt_L || 'en'}) { |
printf STDERR "unsupported language: -L %s\n", $opt_L; |
printf STDERR "unsupported language: -L %s\n", $opt_L; |
usage; |
usage; |
|
|
my ($amount, $text) = ($1, $2); |
my ($amount, $text) = ($1, $2); |
my $cc = $1 if $text =~ s/\[(.*?)\] *//; |
my $cc = $1 if $text =~ s/\[(.*?)\] *//; |
$accounts{$ano} or die "unknown account $ano: $line"; |
$accounts{$ano} or die "unknown account $ano: $line"; |
|
($accounts{$ano}{type} =~ /S/) == |
|
($accounts{$entry{contra}}{type} =~ /S/) |
|
or die "statistical vs. non-statistical account: " . |
|
"$entry{contra} split $line"; |
$amount *= $entry{amount} < 0 ? -1 : +1; |
$amount *= $entry{amount} < 0 ? -1 : +1; |
|
|
# Combine the text on the split side. |
if ($entry{daynum} <= $endday) { |
my $newentry = { |
# Combine the text on the split side. |
%entry, |
my $newentry = { |
amount => $amount, |
%entry, |
text => "$entry{text} $text", |
amount => $amount, |
}; |
text => "$entry{text} $text", |
if ($cc) { |
}; |
$newentry->{cc} = $cc; |
if ($cc) { |
$newentry->{text} = "[$cc] $newentry->{text}"; |
$newentry->{cc} = $cc; |
} |
$newentry->{text} = "[$cc] $newentry->{text}"; |
make_entry %$newentry, $ano; |
} |
|
make_entry %$newentry, $ano; |
|
|
# Append split account numbers on the combined side. |
# Append split account numbers on the combined side. |
my $contra = $entry{contra}; |
my $contra = $entry{contra}; |
$alist{$contra}{''}[-1]{text} .= " $ano" |
$alist{$contra}{''}[-1]{text} .= " $ano" |
unless $alist{$contra}{''}[-1]{text} =~ / $ano/; |
unless $alist{$contra}{''}[-1]{text} =~ / $ano/; |
|
|
# If the split side specifies a cost center, |
# If the split side specifies a cost center, |
# manually create the cost center entry on the combined |
# manually create the cost center entry |
# side because make_entry was only called once there. |
# on the combined side because make_entry() |
if ($cc) { |
# was only called once there. |
my $old = $cclist{$cc}{$contra} ? |
if ($cc) { |
$cclist{$cc}{$contra}[-1]{sum} : 0; |
my $old = $cclist{$cc}{$contra} ? |
$newentry->{contra} = $ano; |
$cclist{$cc}{$contra}[-1]{sum} : 0; |
$newentry->{amount} *= -1; |
$newentry->{contra} = $ano; |
$newentry->{sum} = $old - $amount; |
$newentry->{amount} *= -1; |
push @{$cclist{$cc}{$contra}}, $newentry; |
$newentry->{sum} = $old - $amount; |
|
push @{$cclist{$cc}{$contra}}, $newentry; |
|
} |
} |
} |
|
|
# Keep track of the remaining amount. |
# Keep track of the remaining amount. |
|
|
|
|
s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line"; |
s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line"; |
my ($year, $month, $day) = ($1, $2, $3); |
my ($year, $month, $day) = ($1, $2, $3); |
s/^([A-Z]+(?:\d+\/\d+)?) +// or die "$fn ID parse error: $line"; |
my $daynum = (timegm 0, 0, 0, $day, $month-1, $year) / 86400; |
|
$startday //= $daynum; |
|
s/^(\S+) +// or die "$fn ID parse error: $line"; |
my $id = $1; |
my $id = $1; |
s/^(\d+) +// or die "$fn debit account number parse error: $line"; |
s/^(\d+) +// or die "$fn debit account number parse error: $line"; |
my $debit = $1; |
my $debit = $1; |
|
|
month => $month, |
month => $month, |
day => $day, |
day => $day, |
date => "$year-$month-$day", |
date => "$year-$month-$day", |
days => ($month - 1) * 30 + ($day - 1), |
daynum => $daynum, |
price => $newpc * $amount, |
price => $newpc * $amount, |
}; |
}; |
|
next if $new->{daynum} > $endday; |
$prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc; |
$prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc; |
next unless $oldpc; |
next unless $oldpc; |
|
|
|
|
if ($old) { |
if ($old) { |
# Record a gain or loss in this period. |
# Record a gain or loss in this period. |
$newprofit->{olddate} = $old->{date}; |
$newprofit->{olddate} = $old->{date}; |
$newprofit->{days} = $new->{days} - $old->{days} + |
$newprofit->{days} = $new->{daynum} - $old->{daynum}; |
($new->{year} - $old->{year}) * 360; |
|
$newprofit->{text} .= sprintf " %s %s (%dd)", |
$newprofit->{text} .= sprintf " %s %s (%dd)", |
(translate 'since'), $old->{date}, |
(translate 'since'), $old->{date}, |
$newprofit->{days}; |
$newprofit->{days}; |
|
|
year => $year, |
year => $year, |
month => $month, |
month => $month, |
day => $day, |
day => $day, |
date => "$year-$month-$day", |
date => "$year-$month-$day", |
|
daynum => (timegm 0, 0, 0, $day, $month - 1, $year) / 86400, |
id => $id, |
id => $id, |
text => $text, |
text => $text, |
cc => $cc, |
cc => $cc, |
); |
); |
if ($debit) { |
if ($debit) { |
$accounts{$debit} or die "unknown debit account $debit: $line"; |
$accounts{$debit} or die "unknown debit account $debit: $line"; |
|
# The credit side may or may not be split. |
my %newentry = (%entry, contra => $credit, amount => $amount); |
my %newentry = (%entry, contra => $credit, amount => $amount); |
make_entry %newentry, $debit; |
make_entry %newentry, $debit; |
} else { |
} else { |
$credit or die "splitting both sides: $line"; |
$credit or die "splitting both sides: $line"; |
# Remember a credit side split. |
# The debit side is split, remember the entry. |
$entry{contra} = $credit; |
$entry{contra} = $credit; |
$entry{amount} = $amount; |
$entry{amount} = $amount; |
} |
} |
if ($credit) { |
if ($credit) { |
$accounts{$credit} |
$accounts{$credit} |
or die "unknown credit account $credit: $line"; |
or die "unknown credit account $credit: $line"; |
|
$debit && ($accounts{$debit}{type} =~ /S/) != |
|
($accounts{$credit}{type} =~ /S/) |
|
and die "statistical vs. non-statistical account: $line"; |
|
# The debit side may or may not be split. |
my %newentry = (%entry, contra => $debit, amount => -$amount); |
my %newentry = (%entry, contra => $debit, amount => -$amount); |
make_entry %newentry, $credit; |
make_entry %newentry, $credit; |
# This entry is not split: clear it after processing. |
# This entry is not split: clear it after processing. |
%entry = () if $debit; |
%entry = () if $debit; |
} else { |
} else { |
# Remember a debit side split. |
# The credit side is split, remember the entry. |
$entry{contra} = $debit; |
$entry{contra} = $debit; |
$entry{amount} = -$amount; |
$entry{amount} = -$amount; |
} |
} |
Line 448 for my $cc (sort keys %cclist) { |
|
Line 473 for my $cc (sort keys %cclist) { |
|
if ($opt_c) { |
if ($opt_c) { |
|
|
# --- Cost center account lists. ----------------------- |
# --- Cost center account lists. ----------------------- |
|
|
printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc, |
printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc, |
(translate 'Account list'); |
(translate 'Account list'); |
for my $ano (sort keys %accounts) { |
for my $ano (sort keys %accounts) { |
Line 515 for my $cc (sort keys %cclist) { |
|
Line 540 for my $cc (sort keys %cclist) { |
|
100.0 * $entry->{rel}, $entry->{old}; |
100.0 * $entry->{rel}, $entry->{old}; |
if ($entry->{days}) { |
if ($entry->{days}) { |
printf "%5.1f%% p.a.", |
printf "%5.1f%% p.a.", |
36000.0 * $entry->{rel} / $entry->{days}; |
36524.5 * $entry->{rel} / $entry->{days}; |
} else { |
} else { |
printf "%11s", ''; |
printf "%11s", ''; |
} |
} |
Line 531 for my $cc (sort keys %cclist) { |
|
Line 556 for my $cc (sort keys %cclist) { |
|
$days += $entry->{days}; |
$days += $entry->{days}; |
$capital += $entry->{old} * $entry->{days}; |
$capital += $entry->{old} * $entry->{days}; |
} |
} |
|
next unless $days; |
my $entry = { |
my $entry = { |
profit => $pr, |
profit => $pr, |
percent => 100.0 * $pr / $capital * $days, |
percent => 100.0 * $pr / $capital * $days, |
Line 560 if ($opt_p && %ptot) { |
|
Line 586 if ($opt_p && %ptot) { |
|
$ptot{$cc}{capital}, $ptot{$cc}{pcpa}, |
$ptot{$cc}{capital}, $ptot{$cc}{pcpa}, |
$ptot{$cc}{days}, $cc; |
$ptot{$cc}{days}, $cc; |
$pr += $ptot{$cc}{profit}; |
$pr += $ptot{$cc}{profit}; |
$capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 360.0; |
$capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 365.245; |
$maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days}; |
$maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days}; |
} |
} |
printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n", |
printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n", |