[BACK]Return to pta.pl CVS log [TXT][DIR] Up to [cvsweb.bsd.lv] / pta

File: [cvsweb.bsd.lv] / pta / pta.pl (download)

Revision 1.8, Wed Nov 18 16:35:40 2020 UTC (3 years, 4 months ago) by schwarze
Branch: MAIN
Changes since 1.7: +55 -38 lines

Add the -D date range option.
The startday part is already parsed but not yet used.
Omit entries later then the endday
from account lists, balance sheets, and profit lists.

Feature originally suggested by Oliver Marugg <quandolf at gmail dot com>,
reminded by Stephen Taylor <staylor at encom dot us>.

#!/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);
use Time::Local qw(timegm);

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 %alist;	# {ano}{subname, ''}[]; contains lists of entries
my %cclist;	# {cc}{ano}[]; contains lists of entries
my %entry;	# {year, month, day, date, daynum, id, contra,
		#  amount, rel, old, days, skip, cc, text, sum}
my %prices;	# {cc}{year, month, day, date, daynum, price}
my %profit;	# {cc}[]; contains lists of profit entries
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 = (
    A => 'Assets',
    Q => 'Equity',
    L => 'Liabilities',
    R => 'Revenue',
    S => 'Statistical accounts',
    X => 'Expenses',
);

my $translations = {
    en => {},
    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->{$en} || $en;
}

sub translate_type ($) {
	my $type = shift;
	my $en = $atypes{substr $type, 0, 1};
	return $en ? 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) = @_;
	return if $entry->{daynum} > $endday;
	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 'abcD:L: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;
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'}) {
	printf STDERR "unsupported language: -L %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";
		($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;

		if ($entry{daynum} <= $endday) {
			# 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);
	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;
	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",
		    daynum  => $daynum,
		    price   => $newpc * $amount,
		};
		next if $new->{daynum} > $endday;
		$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->{daynum} - $old->{daynum};
			$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",
	    daynum => (timegm 0, 0, 0, $day, $month - 1, $year) / 86400,
	    id     => $id,
	    text   => $text,
	    cc     => $cc,
	);
	if ($debit) {
		$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);
		make_entry %newentry, $debit;
	} else {
		$credit or die "splitting both sides: $line";
		# The debit side is split, remember the entry.
		$entry{contra} = $credit;
		$entry{amount} = $amount;
	}
	if ($credit) {
		$accounts{$credit}
		    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);
		make_entry %newentry, $credit;
		# This entry is not split: clear it after processing.
		%entry = () if $debit;
	} else {
		# The credit side is split, remember the entry.
		$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 && $profit{$cc}) {
		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.",
				    36524.5 * $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};
		}
		next unless $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 && %ptot) {
	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} / 365.245;
		$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;