#!/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;