Annotation of pta/pta.pl, Revision 1.6
1.1 schwarze 1: #!/usr/bin/perl
2: #
3: # Copyright (c) 2020 Ingo Schwarze <schwarze@openbsd.org>
4: #
5: # Permission to use, copy, modify, and distribute this software for any
6: # purpose with or without fee is hereby granted, provided that the above
7: # copyright notice and this permission notice appear in all copies.
8: #
9: # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10: # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11: # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12: # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13: # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14: # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15: # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16:
17: use warnings;
18: use strict;
19:
20: use Getopt::Std qw(getopts);
21:
22: our ($opt_a, $opt_b, $opt_c, $opt_L, $opt_n, $opt_p, $opt_s);
23:
24: my %accounts; # {ano}{type, text}; from pta-accounts(5)
25: my %alist; # {ano}{subname, ''}[]; contains lists of entries
26: my %cclist; # {cc}{ano}[]; contains lists of entries
27: my %entry; # {year, month, day, date, id, contra,
28: # amount, rel, old, days, skip, cc, text, sum}
29: my %prices; # {cc}{year, month, day, date, days, price}
30: my %profit; # {cc}[]; contains lists of profit entries
31: my %ptot; # {cc}{profit, percent, capital, pcpa, days}
32:
33: my %atypes = (
34: A => 'Assets',
35: Q => 'Equity',
36: L => 'Liabilities',
37: R => 'Revenue',
38: S => 'Statistical accounts',
39: X => 'Expenses',
40: );
41:
42: my $translations = {
1.4 schwarze 43: en => {},
1.1 schwarze 44: de => {
45: 'Account list' => 'Kontenblatt',
46: 'Assets' => 'Aktiva',
47: 'Balance sheet' => 'Bilanz',
48: 'change in price' => 'Kursaenderung',
49: 'Cost center' => 'Kostenstelle',
50: 'current period' => 'aktuelle Periode',
51: 'Equity' => 'Eigenkapital',
52: 'Expenses' => 'Aufwand',
53: 'Liabilities' => 'Fremdkapital',
54: 'loss' => 'Verlust',
55: 'mismatch' => 'Diskrepanz',
56: 'Partial balance sheet' => 'Teilbilanz',
57: 'previous years' => 'Vorjahre',
58: 'profit' => 'Gewinn',
59: 'Profits and losses' => 'Gewinne und Verluste',
60: 'Revenue' => 'Ertrag',
61: 'since' => 'seit',
62: 'Statistical accounts' => 'Statistische Konten',
63: 'Subaccount list' => 'Unterkontenblatt',
64: 'total' => 'Summe',
65: 'total assets' => 'Bilanzsumme',
66: 'total loss' => 'Gesamtverlust',
67: 'total profit' => 'Gesamtgewinn',
68: }
69: };
70:
71: # === SUBROUTINES =====================================================
72:
73: sub translate ($) {
74: my $en = shift;
1.4 schwarze 75: return $translations->{$en} || $en;
1.1 schwarze 76: }
77:
78: sub translate_type ($) {
79: my $type = shift;
1.4 schwarze 80: my $en = $atypes{substr $type, 0, 1};
81: return $en ? translate $en : $type;
1.1 schwarze 82: }
83:
84: # Handles account entries (not journal entries) with respect to
85: # subaccounts, running totals, cost centers,
86: # and realized profits and losses in the profit table,
87: # but does not handle unrealized profits and losses.
88: sub make_entry (\%$) {
89: my ($entry, $ano) = @_;
90: my $sub = $accounts{$ano}{type} =~ /[RX]/ &&
91: $entry->{text} =~ s/\((.*?)\) *// ? $1 : '';
92: my $old = $alist{$ano}{$sub} ? $alist{$ano}{$sub}[-1]{sum} : 0;
93: push @{$alist{$ano}{$sub}}, {%$entry, sum => $old + $entry->{amount}};
94: my $cc = $entry->{cc} or return;
95: $old = $cclist{$cc}{$ano} ? $cclist{$cc}{$ano}[-1]{sum} : 0;
96: push @{$cclist{$cc}{$ano}}, {%$entry, sum => $old + $entry->{amount}};
97: push @{$profit{$cc}}, {
98: %$entry,
99: old => $prices{$cc}{price},
100: amount => -$entry->{amount},
101: rel => -$entry->{amount} / $prices{$cc}{price},
102: } if $accounts{$ano}{type} =~ /p/;
103: }
104:
105: # For account lists, not for balance sheets.
106: sub print_amount ($) {
107: my $amount = shift;
108: if ($amount < 0) {
109: printf "%9s %9.2f", '', -$amount;
110: } else {
111: printf "%9.2f %9s", $amount, '';
112: }
113: }
114:
115: sub print_amount_text ($$) {
116: my ($entry, $account) = @_;
117: print_amount $entry->{amount};
118: printf " %10.2f %s\n",
119: $entry->{sum} * ($account->{type} =~ /[ASX]/ ? 1 : -1),
120: $entry->{text};
121: }
122:
123: # For balance sheets, not for account lists.
124: sub print_sum ($$$$$) {
125: my ($list, $ano, $indent, $debit, $credit) = @_;
126: my $type = $accounts{$ano}{type};
127: my $amount = $list->[-1]{sum};
128: printf "%*s%05u ", $indent, '', $ano;
129: if ($type =~ /[AX]/ || ($type eq 'S' && $amount >= 0)) {
130: printf "%9.2f %9s", $amount, '';
131: $$debit += $amount;
132: } else {
133: printf "%9s %9.2f", '', -$amount;
134: $$credit -= $amount;
135: }
136: printf " %s\n", $accounts{$ano}{text};
137: }
138:
139: sub usage () {
140: printf STDERR "usage: %s [-abcnps] [-L de]\n", $0;
141: exit 1;
142: }
143:
144: # === MAIN PROGRAM =====================================================
145:
146: getopts 'abcL:nps' or usage;
147: $opt_a = $opt_b = $opt_c = $opt_p = $opt_s = 1
148: unless $opt_a || $opt_b || $opt_c || $opt_n || $opt_p || $opt_s;
1.4 schwarze 149: unless ($translations = $translations->{$opt_L || 'en'}) {
150: printf STDERR "unsupported language: -L %s\n", $opt_L;
1.1 schwarze 151: usage;
152: }
153:
154: my $fn = 'accounts.txt';
155: open my $in, $fn or die "$fn: $!";
156: while (<$in>) {
157: chomp;
158: next if /^(?:#|$)/;
159: my $line = $_;
160: s/^(\d+) +// or die "$fn account number parse error: $line";
161: my $account = {};
162: $accounts{$1} = $account;
163: s/^([ALQRSX]p?) +// or die "$fn account type parse error: $line";
164: $account->{type} = $1;
165: $account->{text} = $_;
166: }
167: close $in;
168:
169: # === JOURNAL PARSER ===================================================
170:
171: $fn = 'journal.txt';
172: open $in, $fn or die "$fn: $!";
173: while (<$in>) {
174: chomp;
175: next if /^(?:#|$)/;
176: my $line = $_;
177:
178: # --- Subsequent line of a split entry. ------------------------
179:
180: if (%entry) {
181: s/^ *(\d+) +// or die "$fn split account parse error: $line";
182: my $ano = $1;
183: /^(-?\d+\.\d+) +(.*)/
184: or die "$fn split amount parse error: $line";
185: my ($amount, $text) = ($1, $2);
186: my $cc = $1 if $text =~ s/\[(.*?)\] *//;
187: $accounts{$ano} or die "unknown account $ano: $line";
1.5 schwarze 188: ($accounts{$ano}{type} =~ /S/) ==
189: ($accounts{$entry{contra}}{type} =~ /S/)
190: or die "statistical vs. non-statistical account: " .
191: "$entry{contra} split $line";
1.1 schwarze 192: $amount *= $entry{amount} < 0 ? -1 : +1;
193:
194: # Combine the text on the split side.
195: my $newentry = {
196: %entry,
197: amount => $amount,
198: text => "$entry{text} $text",
199: };
200: if ($cc) {
201: $newentry->{cc} = $cc;
202: $newentry->{text} = "[$cc] $newentry->{text}";
203: }
204: make_entry %$newentry, $ano;
205:
206: # Append split account numbers on the combined side.
207: my $contra = $entry{contra};
208: $alist{$contra}{''}[-1]{text} .= " $ano"
209: unless $alist{$contra}{''}[-1]{text} =~ / $ano/;
210:
211: # If the split side specifies a cost center,
212: # manually create the cost center entry on the combined
213: # side because make_entry was only called once there.
214: if ($cc) {
215: my $old = $cclist{$cc}{$contra} ?
216: $cclist{$cc}{$contra}[-1]{sum} : 0;
217: $newentry->{contra} = $ano;
218: $newentry->{amount} *= -1;
219: $newentry->{sum} = $old - $amount;
220: push @{$cclist{$cc}{$contra}}, $newentry;
221: }
222:
223: # Keep track of the remaining amount.
224: $entry{amount} -= $amount;
225: %entry = () if abs($entry{amount}) < 0.005;
226: next;
227: }
228:
229: # --- Parse a normal journal entry or a price line. ------------
230:
231: s/^(\d{4})(\d{2})(\d{2}) +// or die "$fn date parse error: $line";
232: my ($year, $month, $day) = ($1, $2, $3);
1.6 ! schwarze 233: s/^(\S+) +// or die "$fn ID parse error: $line";
1.1 schwarze 234: my $id = $1;
235: s/^(\d+) +// or die "$fn debit account number parse error: $line";
236: my $debit = $1;
237: my ($credit, $oldpc, $newpc);
238: if (s/^(\d+)#(\d+) +//) {
239: $oldpc = $1;
240: $newpc = $2;
241: } elsif (s/^(\d+) +//) {
242: $credit = $1;
243: } else {
244: die "$fn credit account number parse error: $line";
245: }
246: /^(\d+\.\d+) +(.*)/ or die "$fn amount parse error: $line";
247: my ($amount, $text) = ($1, $2);
248: my $cc = $1 if $text =~ /\[(.*?)\]/;
249:
250: # --- Handle a price line. -------------------------------------
251:
252: if ($oldpc || $newpc) {
253: defined $cc or die "$fn price without cost center: $line";
254: my $old = $prices{$cc};
255: my $new = {
256: year => $year,
257: month => $month,
258: day => $day,
259: date => "$year-$month-$day",
260: days => ($month - 1) * 30 + ($day - 1),
261: price => $newpc * $amount,
262: };
263: $prices{$cc} = $new unless $prices{$cc} && $oldpc == $newpc;
264: next unless $oldpc;
265:
266: # --- Some units were already held. --------------------
267:
268: my $oldval = $old ? $old->{price} :
269: $cclist{$cc}{$debit}[-1]{sum};
270: my $diff = $oldpc * $amount - $oldval;
271: my $newprofit = {
272: year => $year,
273: month => $month,
274: day => $day,
275: date => $new->{date},
276: id => $id,
277: amount => $diff,
278: old => $oldval,
279: rel => $diff / $oldval,
280: text => (sprintf "[%s] %s", $cc,
281: (translate 'change in price')),
282: };
283: if ($old) {
284: # Record a gain or loss in this period.
285: $newprofit->{olddate} = $old->{date};
286: $newprofit->{days} = $new->{days} - $old->{days} +
287: ($new->{year} - $old->{year}) * 360;
288: $newprofit->{text} .= sprintf " %s %s (%dd)",
289: (translate 'since'), $old->{date},
290: $newprofit->{days};
291: } else {
292: # Record a gain or loss before this period.
293: $newprofit->{skip} = 1;
294: $newprofit->{text} .= sprintf " (%s)",
295: (translate 'previous years');
296: }
297: push @{$profit{$cc}}, $newprofit;
298:
299: # --- Obsolete one previous line, if needed. -----------
300:
301: for (my $i = $#{$profit{$cc}} - 1; $i >= 0; $i--) {
302: my $oldprofit = $profit{$cc}[$i];
303: next unless $oldprofit->{olddate};
304: $oldprofit->{skip} = 1
305: if $oldprofit->{olddate} eq $old->{date};
306: last;
307: }
308: next;
309: }
310:
311: # --- Handle a normal journal entry. ---------------------------
312:
313: %entry = (
314: year => $year,
315: month => $month,
316: day => $day,
317: date => "$year-$month-$day",
318: id => $id,
319: text => $text,
320: cc => $cc,
321: );
322: if ($debit) {
323: $accounts{$debit} or die "unknown debit account $debit: $line";
1.5 schwarze 324: # The credit side may or may not be split.
1.1 schwarze 325: my %newentry = (%entry, contra => $credit, amount => $amount);
326: make_entry %newentry, $debit;
327: } else {
328: $credit or die "splitting both sides: $line";
1.5 schwarze 329: # The debit side is split, remember the entry.
1.1 schwarze 330: $entry{contra} = $credit;
331: $entry{amount} = $amount;
332: }
333: if ($credit) {
334: $accounts{$credit}
335: or die "unknown credit account $credit: $line";
1.5 schwarze 336: $debit && ($accounts{$debit}{type} =~ /S/) !=
337: ($accounts{$credit}{type} =~ /S/)
338: and die "statistical vs. non-statistical account: $line";
339: # The debit side may or may not be split.
1.1 schwarze 340: my %newentry = (%entry, contra => $debit, amount => -$amount);
341: make_entry %newentry, $credit;
342: # This entry is not split: clear it after processing.
343: %entry = () if $debit;
344: } else {
1.5 schwarze 345: # The credit side is split, remember the entry.
1.1 schwarze 346: $entry{contra} = $debit;
347: $entry{amount} = -$amount;
348: }
349: }
350: # The last journal entry is an incomplete split.
351: die "$fn split parse error: EOF" if %entry;
352: close $in;
353:
354: # === OUTPUT ===========================================================
355:
356: for my $ano (sort keys %accounts) {
357: next unless $alist{$ano};
358:
359: # --- Subaccount lists. ----------------------------------------
360:
361: if ($opt_s) {
362: for my $sub (sort keys %{$alist{$ano}}) {
363: next if $sub eq '';
364: printf "\n%s %s %s (%s) %s\n",
365: (translate 'Subaccount list'),
366: $ano, $accounts{$ano}{text},
367: (translate_type $accounts{$ano}{type}), $sub;
368: for my $entry (@{$alist{$ano}{$sub}}) {
369: printf "%10s %6s %5s ", $entry->{date},
370: $entry->{id}, $entry->{contra};
371: print_amount_text $entry, $accounts{$ano};
372: }
373: }
374: }
375:
376: # --- Account lists. -------------------------------------------
377:
378: my ($sum, $hassub);
379: if ($alist{$ano}{''}) {
380: $sum = $alist{$ano}{''}[-1]{sum};
381: } else {
382: $alist{$ano}{''} = [];
383: $sum = 0;
384: }
385:
386: # Entries outside any subaccount.
387: if ($opt_a) {
388: printf "\n%s %s %s (%s)\n", (translate 'Account list'),
389: $ano, $accounts{$ano}{text},
390: (translate_type $accounts{$ano}{type});
391: for my $entry (@{$alist{$ano}{''}}) {
392: printf "%10s %6s %5s ",
393: $entry->{date}, $entry->{id}, $entry->{contra};
394: print_amount_text $entry, $accounts{$ano};
395: }
396: }
397:
398: # Subaccount balances.
399: for my $sub (sort {
400: $alist{$ano}{$b}[-1]{sum} <=> $alist{$ano}{$a}[-1]{sum}
401: } grep { $_ ne '' } keys %{$alist{$ano}}) {
402: $hassub = 1;
403: $sum += $alist{$ano}{$sub}[-1]{sum};
404: if ($opt_a) {
405: printf "%24s", '';
406: print_amount $alist{$ano}{$sub}[-1]{sum};
407: printf " %10.2f %s\n",
408: $sum * ($accounts{$ano}{type} =~ /[ASX]/ ? 1 : -1),
409: $sub;
410: }
411: }
412: push @{$alist{$ano}{''}}, {sum => $sum} if $hassub;
413: }
414:
415: # --- Balance sheet. ---------------------------------------------------
416:
417: if ($opt_b) {
418: my $debit = 0;
419: my $credit = 0;
420: my $stat;
421: printf "\n%s\n", (translate 'Balance sheet');;
422: for my $ano (sort keys %accounts) {
423: $alist{$ano} or next;
424: if ($accounts{$ano}{type} =~ /S/) {
425: $stat = 1;
426: } else {
427: print_sum $alist{$ano}{''},
428: $ano, 18, \$debit, \$credit;
429: }
430: }
431: printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
432: (translate 'total assets');
433: printf "%33s %9.2f %s\n", '', $credit - $debit, (translate 'mismatch')
434: if abs($credit - $debit) > 0.005;
435:
436: # --- Statistical accounts. ------------------------------------
437:
438: if ($stat) {
439: $debit = $credit = 0;
440: printf "\n%s\n", (translate 'Statistical accounts');;
441: for my $ano (sort keys %accounts) {
442: $alist{$ano} && $accounts{$ano}{type} =~ /S/ or next;
443: print_sum $alist{$ano}{''},
444: $ano, 18, \$debit, \$credit;
445: }
446: printf "%23s %9.2f %9.2f %s\n", '', $debit, $credit,
447: (translate 'total');
448: printf "%33s %9.2f %s\n", '',
449: $credit - $debit, (translate 'mismatch')
450: if abs($credit - $debit) > 0.005;
451: }
452: }
453:
454: # --- Cost centers. ----------------------------------------------------
455:
456: for my $cc (sort keys %cclist) {
457: if ($opt_c) {
458:
459: # --- Cost center account lists. -----------------------
460:
461: printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
462: (translate 'Account list');
463: for my $ano (sort keys %accounts) {
464: next unless $cclist{$cc}{$ano};
465: printf "%19s %5s %30s *** %s (%s)\n",
466: '', $ano, '', $accounts{$ano}{text},
467: (translate_type $accounts{$ano}{type});
468: for my $entry (@{$cclist{$cc}{$ano}}) {
469: printf " %10s %6s %5s ", $entry->{date},
470: $entry->{id}, $entry->{contra};
471: print_amount_text $entry, $accounts{$ano};
472: }
473: }
474:
475: # --- Partial balance sheet. ---------------------------
476:
477: my $debit = 0;
478: my $credit = 0;
479: my $stat;
480: printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
481: (translate 'Partial balance sheet');
482: for my $ano (sort keys %accounts) {
483: $cclist{$cc}{$ano} or next;
484: if ($accounts{$ano}{type} =~ /S/) {
485: $stat = 1;
486: } else {
487: print_sum $cclist{$cc}{$ano},
488: $ano, 20, \$debit, \$credit;
489: }
490: }
491: printf "%25s %9.2f %9.2f %s\n", '', $debit, $credit,
492: (translate 'total assets');
493:
494: # --- Cost center statistical accounts. ----------------
495:
496: if ($stat) {
497: $debit = $credit = 0;
498: printf "\n%s [%s] %s\n",
499: (translate 'Cost center'), $cc,
500: (translate 'Statistical accounts');
501: for my $ano (sort keys %accounts) {
502: $cclist{$cc}{$ano} &&
503: $accounts{$ano}{type} =~ /S/ or next;
504: print_sum $cclist{$cc}{$ano},
505: $ano, 20, \$debit, \$credit;
506: }
507: printf "%25s %9.2f %9.2f %s\n", '',
508: $debit, $credit, (translate 'total');
509: }
510: }
511:
512: # --- Cost center profits and losses. --------------------------
513:
1.3 schwarze 514: if ($opt_p && $profit{$cc}) {
1.1 schwarze 515: printf "\n%s [%s] %s\n", (translate 'Cost center'), $cc,
516: (translate 'Profits and losses');
517: my $pr = 0;
518: my $days = 0;
519: my $capital = 0;
520: for my $i (0 .. $#{$profit{$cc}}) {
521: my $entry = $profit{$cc}[$i];
522: printf " %s %6s %8.2f %5.1f%% of %8.2f ",
523: $entry->{date}, $entry->{id}, $entry->{amount},
524: 100.0 * $entry->{rel}, $entry->{old};
525: if ($entry->{days}) {
526: printf "%5.1f%% p.a.",
527: 36000.0 * $entry->{rel} / $entry->{days};
528: } else {
529: printf "%11s", '';
530: }
531: printf " %s", $entry->{text};
532: if ($entry->{skip}) {
533: print " --\n";
534: next;
535: } else {
536: print "\n";
537: }
538: $pr += $entry->{amount};
539: next unless $entry->{days};
540: $days += $entry->{days};
541: $capital += $entry->{old} * $entry->{days};
542: }
543: my $entry = {
544: profit => $pr,
545: percent => 100.0 * $pr / $capital * $days,
546: capital => $capital / $days,
547: pcpa => 36000.0 * $pr / $capital,
548: days => $days,
549: };
550: printf "%19s %8.2f %5.1f%% of %8.2f %5.1f%% p.a. " .
551: "[%s] %s (%s, %dd)\n", '', $pr, $entry->{percent},
552: $entry->{capital}, $entry->{pcpa}, $cc,
553: translate($pr < 0 ? 'total loss' : 'total profit'),
554: (translate 'current period'), $days;
555: $ptot{$cc} = $entry;
556: }
557: }
558:
559: # --- Global list of profits and losses. -------------------------------
560:
1.2 schwarze 561: if ($opt_p && %ptot) {
1.1 schwarze 562: my $pr = 0;
563: my $capital = 0;
564: my $maxd = 0;
565: printf "\n%s\n", (translate 'Profits and losses');
566: for my $cc (sort keys %ptot) {
567: printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd [%s]\n",
568: $ptot{$cc}{profit}, $ptot{$cc}{percent},
569: $ptot{$cc}{capital}, $ptot{$cc}{pcpa},
570: $ptot{$cc}{days}, $cc;
571: $pr += $ptot{$cc}{profit};
572: $capital += $ptot{$cc}{capital} * $ptot{$cc}{days} / 360.0;
573: $maxd = $ptot{$cc}{days} if $maxd < $ptot{$cc}{days};
574: }
575: printf "%9.2f %5.1f%% of %9.2f %5.1f%% p.a. %3dd %s\n",
576: $pr, 100.0 * $pr / $capital * $maxd / 360.0,
577: 360.0 * $capital / $maxd, 100.0 * $pr / $capital, $maxd,
578: translate($pr < 0 ? 'total loss' : 'total profit');
579: }
580: exit 0;
CVSweb