File: [cvsweb.bsd.lv] / pta / pta.pl (download)
Revision 1.1, Sun Sep 27 14:35:34 2020 UTC (3 years, 8 months ago) by schwarze
Branch: MAIN
CVS Tags: VERSION_0_1
initial version
|
#!/usr/bin/perl
#
# Copyright (c) 2020 Ingo Schwarze <schwarze@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
use warnings;
use strict;
use Getopt::Std qw(getopts);
our ($opt_a, $opt_b, $opt_c, $opt_L, $opt_n, $opt_p, $opt_s);
my %accounts; # {ano}{type, text}; from pta-accounts(5)
my %alist; # {ano}{subname, ''}[]; contains lists of entries
my %cclist; # {cc}{ano}[]; contains lists of entries
my %entry; # {year, month, day, date, id, contra,
# amount, rel, old, days, skip, cc, text, sum}
my %prices; # {cc}{year, month, day, date, days, price}
my %profit; # {cc}[]; contains lists of profit entries
my %ptot; # {cc}{profit, percent, capital, pcpa, days}
my %atypes = (
A => 'Assets',
Q => 'Equity',
L => 'Liabilities',
R => 'Revenue',
S => 'Statistical accounts',
X => 'Expenses',
);
my $translations = {
de => {
'Account list' => 'Kontenblatt',
'Assets' => 'Aktiva',
'Balance sheet' => 'Bilanz',
'change in price' => 'Kursaenderung',
'Cost center' => 'Kostenstelle',
'current period' => 'aktuelle Periode',
'Equity' => 'Eigenkapital',
'Expenses' => 'Aufwand',
'Liabilities' => 'Fremdkapital',
'loss' => 'Verlust',
'mismatch' => 'Diskrepanz',
'Partial balance sheet' => 'Teilbilanz',
'previous years' => 'Vorjahre',
'profit' => 'Gewinn',
'Profits and losses' => 'Gewinne und Verluste',
'Revenue' => 'Ertrag',
'since' => 'seit',
'Statistical accounts' => 'Statistische Konten',
'Subaccount list' => 'Unterkontenblatt',
'total' => 'Summe',
'total assets' => 'Bilanzsumme',
'total loss' => 'Gesamtverlust',
'total profit' => 'Gesamtgewinn',
}
};
# === SUBROUTINES =====================================================
sub translate ($) {
my $en = shift;
return $translations ? $translations->{$en} : $en;
}
sub translate_type ($) {
my $type = shift;
my $en = $atypes{substr $type, 0, 1} || '?';
return translate $en || $type;
}
# Handles account entries (not journal entries) with respect to
# subaccounts, running totals, cost centers,
# and realized profits and losses in the profit table,
# but does not handle unrealized profits and losses.
sub make_entry (\%$) {
my ($entry, $ano) = @_;
my $sub = $accounts{$ano}{type} =~ /[RX]/ &&
$entry->{text} =~ s/\((.*?)\) *// ? $1 : '';
my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0;
push @{$alist{$ano}{$sub}}, {%$entry, sum => $old + $entry->{amount}};
my $cc = $entry->{cc} or return;
$old = $cclist{$cc}{$ano} ? $cclist{$cc}{$ano}[-1]{sum} : 0;
push @{$cclist{$cc}{$ano}}, {%$entry, sum => $old + $entry->{amount}};
push @{$profit{$cc}}, {
%$entry,
old => $prices{$cc}{price},
amount => -$entry->{amount},
rel => -$entry->{amount} / $prices{$cc}{price},
} if $accounts{$ano}{type} =~ /p/;
}
# For account lists, not for balance sheets.
sub print_amount ($) {
my $amount = shift;
if ($amount < 0) {
printf "%9s %9.2f", '', -$amount;
} else {
printf "%9.2f %9s", $amount, '';
}
}
sub print_amount_text ($$) {
my ($entry, $account) = @_;
print_amount $entry->{amount};
printf " %10.2f %s\n",
$entry->{sum} * ($account->{type} =~ /[ASX]/ ? 1 : -1),
$entry->{text};
}
# For balance sheets, not for account lists.
sub print_sum ($$$$$) {
my ($list, $ano, $indent, $debit, $credit) = @_;
my $type = $accounts{$ano}{type};
my $amount = $list->[-1]{sum};
printf "%*s%05u ", $indent, '', $ano;
if ($type =~ /[AX]/ || ($type eq 'S' && $amount >= 0)) {
printf "%9.2f %9s", $amount, '';
$$debit += $amount;
} else {
printf "%9s %9.2f", '', -$amount;
$$credit -= $amount;
}
printf " %s\n", $accounts{$ano}{text};
}
sub usage () {
printf STDERR "usage: %s [-abcnps] [-L de]\n", $0;
exit 1;
}
# === MAIN PROGRAM =====================================================
getopts 'abcL:nps' or usage;
$opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1
unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s;
$opt_L ||= 'en';
if ($opt_L eq 'de') {
$translations = $translations->{$opt_L};
} elsif ($opt_L eq 'en') {
undef $opt_L;
undef $translations;
} else {
printf STDERR "unsupported language %s\n", $opt_L;
usage;
}
my $fn = 'accounts.txt';
open my $in, $fn or die "$fn: $!";
while (<$in>) {
chomp;
next if /^(?:#|$)/;
my $line = $_;
s/^(\d+) +// or die "$fn account number parse error: $line";
my $account = {};
$accounts{$1} = $account;
s/^([ALQRSX]p?) +// or die "$fn account type parse error: $line";
$account->{type} = $1;
$account->{text} = $_;
}
close $in;
# === JOURNAL PARSER ===================================================
$fn = 'journal.txt';
open $in, $fn or die "$fn: $!";
while (<$in>) {
chomp;
next if /^(?:#|$)/;
my $line = $_;
# --- Subsequent line of a split entry. ------------------------
if (%entry) {
s/^ *(\d+) +// or die "$fn split account parse error: $line";
my $ano = $1;
/^(-?\d+\.\d+) +(.*)/
or die "$fn split amount parse error: $line";
my ($amount, $text) = ($1, $2);
my $cc = $1 if $text =~ s/\[(.*?)\] *//;
$accounts{$ano} or die "unknown account $ano: $line";
$amount *= $entry{amount} < 0 ? -1 : +1;
# Combine the text on the split side.
my $newentry = {
%entry,
amount => $amount,
text => "$entry{text} $text",
};
if ($cc) {
$newentry->{cc} = $cc;
$newentry->{text} = "[$cc] $newentry->{text}";
}
make_entry %$newentry, $ano;
# Append split account numbers on the combined side.
my $contra = $entry{contra};
$alist{$contra}{''}[-1]{text} .= " $ano"
unless $alist{$contra}{''}[-1]{text} =~ / $ano/;
# If the split side specifies a cost center,
# manually create the cost center entry on the combined
# side because make_entry was only called once there.
if ($cc) {
my $old = $cclist{$cc}{$contra} ?
$cclist{$cc}{$contra}[-1]{sum} : 0;
$newentry->{contra} = $ano;
$newentry->{amount} *= -1;
$newentry->{sum} = $old - $amount;
push @{$cclist{$cc}{$contra}}, $newentry;
}
# Keep track of the remaining amount.
$entry{amount} -= $amount;
%entry = () if abs($entry{amount}) < 0.005;
next;
}
# --- Parse a normal journal entry or a price line. ------------
s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line";
my ($year, $month, $day) = ($1, $2, $3);
s/^([A-Z]+(?:\d+\/\d+)?) +// or die "$fn ID parse error: $line";
my $id = $1;
s/^(\d+) +// or die "$fn debit account number parse error: $line";
my $debit = $1;
my ($credit, $oldpc, $newpc);
if (s/^(\d+)#(\d+) +//) {
$oldpc = $1;
$newpc = $2;
} elsif (s/^(\d+) +//) {
$credit = $1;
} else {
die "$fn credit account number parse error: $line";
}
/^(\d+\.\d+) +(.*)/ or die "$fn amount parse error: $line";
my ($amount, $text) = ($1, $2);
my $cc = $1 if $text =~ /\[(.*?)\]/;
# --- Handle a price line. -------------------------------------
if ($oldpc || $newpc) {
defined $cc or die "$fn price without cost center: $line";
my $old = $prices{$cc};
my $new = {
year => $year,
month => $month,
day => $day,
date => "$year-$month-$day",
days => ($month - 1) * 30 + ($day - 1),
price => $newpc * $amount,
};
$prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;
next unless $oldpc;
# --- Some units were already held. --------------------
my $oldval = $old ? $old->{price} :
$cclist{$cc}{$debit}[-1]{sum};
my $diff = $oldpc * $amount - $oldval;
my $newprofit = {
year => $year,
month => $month,
day => $day,
date => $new->{date},
id => $id,
amount => $diff,
old => $oldval,
rel => $diff / $oldval,
text => (sprintf "[%s] %s", $cc,
(translate 'change in price')),
};
if ($old) {
# Record a gain or loss in this period.
$newprofit->{olddate} = $old->{date};
$newprofit->{days} = $new->{days} - $old->{days} +
($new->{year} - $old->{year}) * 360;
$newprofit->{text} .= sprintf " %s %s (%dd)",
(translate 'since'), $old->{date},
$newprofit->{days};
} else {
# Record a gain or loss before this period.
$newprofit->{skip} = 1;
$newprofit->{text} .= sprintf " (%s)",
(translate 'previous years');
}
push @{$profit{$cc}}, $newprofit;
# --- Obsolete one previous line, if needed. -----------
for (my $i = $#{$profit{$cc}} - 1; $i >= 0; $i--) {
my $oldprofit = $profit{$cc}[$i];
next unless $oldprofit->{olddate};
$oldprofit->{skip} = 1
if $oldprofit->{olddate} eq $old->{date};
last;
}
next;
}
# --- Handle a normal journal entry. ---------------------------
%entry = (
year => $year,
month => $month,
day => $day,
date => "$year-$month-$day",
id => $id,
text => $text,
cc => $cc,
);
if ($debit) {
$accounts{$debit} or die "unknown debit account $debit: $line";
my %newentry = (%entry, contra => $credit, amount => $amount);
make_entry %newentry, $debit;
} else {
$credit or die "splitting both sides: $line";
# Remember a credit side split.
$entry{contra} = $credit;
$entry{amount} = $amount;
}
if ($credit) {
$accounts{$credit}
or die "unknown credit account $credit: $line";
my %newentry = (%entry, contra => $debit, amount => -$amount);
make_entry %newentry, $credit;
# This entry is not split: clear it after processing.
%entry = () if $debit;
} else {
# Remember a debit side split.
$entry{contra} = $debit;
$entry{amount} = -$amount;
}
}
# The last journal entry is an incomplete split.
die "$fn split parse error: EOF" if %entry;
close $in;
# === OUTPUT ===========================================================
for my $ano (sort keys %accounts) {
next unless $alist{$ano};
# --- Subaccount lists. ----------------------------------------
if ($opt_s) {
for my $sub (sort keys %{$alist{$ano}}) {
next if $sub eq '';
printf "\n%s %s %s (%s) %s\n",
(translate 'Subaccount list'),
$ano, $accounts{$ano}{text},
(translate_type $accounts{$ano}{type}), $sub;
for my $entry (@{$alist{$ano}{$sub}}) {
printf "%10s %6s %5s ", $entry->{date},
$entry->{id}, $entry->{contra};
print_amount_text $entry, $accounts{$ano};
}
}
}
# --- Account lists. -------------------------------------------
my ($sum, $hassub);
if ($alist{$ano}{''}) {
$sum = $alist{$ano}{''}[-1]{sum};
} else {
$alist{$ano}{''} = [];
$sum = 0;
}
# Entries outside any subaccount.
if ($opt_a) {
printf "\n%s %s %s (%s)\n", (translate 'Account list'),
$ano, $accounts{$ano}{text},
(translate_type $accounts{$ano}{type});
for my $entry (@{$alist{$ano}{''}}) {
printf "%10s %6s %5s ",
$entry->{date}, $entry->{id}, $entry->{contra};
print_amount_text $entry, $accounts{$ano};
}
}
# Subaccount balances.
for my $sub (sort {
$alist{$ano}{$b}[-1]{sum} <=> $alist{$ano}{$a}[-1]{sum}
} grep { $_ ne '' } keys %{$alist{$ano}}) {
$hassub = 1;
$sum += $alist{$ano}{$sub}[-1]{sum};
if ($opt_a) {
printf "%24s", '';
print_amount $alist{$ano}{$sub}[-1]{sum};
printf " %10.2f %s\n",
$sum * ($accounts{$ano}{type} =~ /[ASX]/ ? 1 : -1),
$sub;
}
}
push @{$alist{$ano}{''}}, {sum => $sum} if $hassub;
}
# --- Balance sheet. ---------------------------------------------------
if ($opt_b) {
my $debit = 0;
my $credit = 0;
my $stat;
printf "\n%s\n", (translate 'Balance sheet');;
for my $ano (sort keys %accounts) {
$alist{$ano} or next;
if ($accounts{$ano}{type} =~ /S/) {
$stat = 1;
} else {
print_sum $alist{$ano}{''},
$ano, 18, \$debit, \$credit;
}
}
printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
(translate 'total assets');
printf "%33s %9.2f %s\n", '', $credit - $debit, (translate 'mismatch')
if abs($credit - $debit) > 0.005;
# --- Statistical accounts. ------------------------------------
if ($stat) {
$debit = $credit = 0;
printf "\n%s\n", (translate 'Statistical accounts');;
for my $ano (sort keys %accounts) {
$alist{$ano} && $accounts{$ano}{type} =~ /S/ or next;
print_sum $alist{$ano}{''},
$ano, 18, \$debit, \$credit;
}
printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
(translate 'total');
printf "%33s %9.2f %s\n", '',
$credit - $debit, (translate 'mismatch')
if abs($credit - $debit) > 0.005;
}
}
# --- Cost centers. ----------------------------------------------------
for my $cc (sort keys %cclist) {
if ($opt_c) {
# --- Cost center account lists. -----------------------
printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
(translate 'Account list');
for my $ano (sort keys %accounts) {
next unless $cclist{$cc}{$ano};
printf "%19s %5s %30s *** %s (%s)\n",
'', $ano, '', $accounts{$ano}{text},
(translate_type $accounts{$ano}{type});
for my $entry (@{$cclist{$cc}{$ano}}) {
printf " %10s %6s %5s ", $entry->{date},
$entry->{id}, $entry->{contra};
print_amount_text $entry, $accounts{$ano};
}
}
# --- Partial balance sheet. ---------------------------
my $debit = 0;
my $credit = 0;
my $stat;
printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
(translate 'Partial balance sheet');
for my $ano (sort keys %accounts) {
$cclist{$cc}{$ano} or next;
if ($accounts{$ano}{type} =~ /S/) {
$stat = 1;
} else {
print_sum $cclist{$cc}{$ano},
$ano, 20, \$debit, \$credit;
}
}
printf "%25s %9.2f %9.2f %s\n", '', $debit, $credit,
(translate 'total assets');
# --- Cost center statistical accounts. ----------------
if ($stat) {
$debit = $credit = 0;
printf "\n%s [%s] %s\n",
(translate 'Cost center'), $cc,
(translate 'Statistical accounts');
for my $ano (sort keys %accounts) {
$cclist{$cc}{$ano} &&
$accounts{$ano}{type} =~ /S/ or next;
print_sum $cclist{$cc}{$ano},
$ano, 20, \$debit, \$credit;
}
printf "%25s %9.2f %9.2f %s\n", '',
$debit, $credit, (translate 'total');
}
}
# --- Cost center profits and losses. --------------------------
if ($opt_p) {
printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
(translate 'Profits and losses');
my $pr = 0;
my $days = 0;
my $capital = 0;
for my $i (0 .. $#{$profit{$cc}}) {
my $entry = $profit{$cc}[$i];
printf " %s %6s %8.2f %5.1f%% of %8.2f ",
$entry->{date}, $entry->{id}, $entry->{amount},
100.0 * $entry->{rel}, $entry->{old};
if ($entry->{days}) {
printf "%5.1f%% p.a.",
36000.0 * $entry->{rel} / $entry->{days};
} else {
printf "%11s", '';
}
printf " %s", $entry->{text};
if ($entry->{skip}) {
print " --\n";
next;
} else {
print "\n";
}
$pr += $entry->{amount};
next unless $entry->{days};
$days += $entry->{days};
$capital += $entry->{old} * $entry->{days};
}
my $entry = {
profit => $pr,
percent => 100.0 * $pr / $capital * $days,
capital => $capital / $days,
pcpa => 36000.0 * $pr / $capital,
days => $days,
};
printf "%19s %8.2f %5.1f%% of %8.2f %5.1f%% p.a. " .
"[%s] %s (%s, %dd)\n", '', $pr, $entry->{percent},
$entry->{capital}, $entry->{pcpa}, $cc,
translate($pr < 0 ? 'total loss' : 'total profit'),
(translate 'current period'), $days;
$ptot{$cc} = $entry;
}
}
# --- Global list of profits and losses. -------------------------------
if ($opt_p) {
my $pr = 0;
my $capital = 0;
my $maxd = 0;
printf "\n%s\n", (translate 'Profits and losses');
for my $cc (sort keys %ptot) {
printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd [%s]\n",
$ptot{$cc}{profit}, $ptot{$cc}{percent},
$ptot{$cc}{capital}, $ptot{$cc}{pcpa},
$ptot{$cc}{days}, $cc;
$pr += $ptot{$cc}{profit};
$capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 360.0;
$maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days};
}
printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n",
$pr, 100.0 * $pr / $capital * $maxd / 360.0,
360.0 * $capital / $maxd, 100.0 * $pr / $capital, $maxd,
translate($pr < 0 ? 'total loss' : 'total profit');
}
exit 0;