#!/usr/bin/perl -w
my $RCS_Id = '$Id$ ';

# Author          : Johan Vromans
# Created On      : June 2005
# Last Modified By: Johan Vromans
# Last Modified On: Wed Nov  1 15:03:39 2006
# Update Count    : 321
# Status          : Unknown, Use with caution!

################ Common stuff ################

use strict;

# Package name.
my $my_package = 'EekBoek';
# Program name and version.
my ($my_name, $my_version) = $RCS_Id =~ /: (.+).pl,v ([\d.]+)/;
# Tack '*' if it is not checked in into RCS.
$my_version .= '*' if length('$Locker$ ') > 12;

################ Command line parameters ################

use Getopt::Long 2.13;

# Command line options.
my $verbose = 0;		# verbose processing
my $ac5 = 0;			# DaviDOS compatible

# Development options (not shown with -help).
my $debug = 0;			# debugging
my $trace = 0;			# trace (show process)
my $test = 0;			# test mode.

# Process command line options.
app_options();

# Post-processing.
$trace |= ($debug || $test);

################ Presets ################

my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';

use POSIX qw(tzset strftime);
tzset();
my @tm = localtime(time);
my $tsdate = strftime("%Y-%m-%d %k:%M:%S +0100", @tm[0..5], -1, -1, -1);

################ The Process ################

use EB::Config qw(EekBoek);
use EB::Globals;
use EB::Format;

read_exact_data();

write_rekeningschema();

exit 0;

################ Subroutines ################

use Data::Dumper;
use Encode;

my $db;

sub read_exact_data {

    open ($db, "<EXACT61.TXT") ||
      open ($db, "<exact61.txt") || die("Missing: EXACT61.TXT\n");
    my $next;
    while ( <$db> ) {
	if ( /^ ?HOOFDVERDICHTINGEN/ ) {
	    $next = \&read_hoofdverdichtingen;
	}
	elsif ( /^ ?VERDICHTINGEN/ ) {
	    $next = \&read_verdichtingen;
	}
	elsif ( /^ ?BTW-TARIEVEN/ ) {
	    $next = \&read_btw;
	}
	elsif ( /^ ?DAGBOEKEN/ ) {
	    $next = \&read_dagboeken;
	}
	elsif ( /^-{40}/ ) {
	    next unless $next;
	    $next->(0);
	}
	elsif ( /^ Í{40}/ ) {
	    next unless $next;
	    $next->(1);
	}
	elsif ( /^ \201{40}/ ) {
	    next unless $next;
	    $next->(1);
	}
    }
    close($db);
    read_grootboek();
    sql_constants();
}

sub sql_constants {
    my $out = "-- Constants. DO NOT MODIFY.\n".
      "COPY Constants (name, value) FROM stdin;\n";

    foreach my $key ( sort(@EB::Globals::EXPORT) ) {
	no strict;
	next if prototype($key);
	next if ref($key->());
	#next unless $key->() =~ /^\d+$/ || $key->() =~ /^\[.*\]$/;
	$out .= "$key\t" . $key->() . "\n";
    }
    $out .= "KO_OK\t0\n";
    $out .= "\\.\n";
    open(my $f, ">constants.sql") or die("Cannot create constants.sql: $!\n");
    print $f $out;
    close($f);
}

sub _trim {
    my ($t) = @_;
    for ( $t ) {
	s/\s+/ /g;
	s/^\s+//;
	s/\s+$//;
	return $_;
    }
}

sub _tsv {
    join("\t", map { _trim($_) } @_) . "\n";
}

sub read_dagboeken {
    my ($off) = @_;
    my @dagboeken;
    while ( <$db> ) {
	last unless $_ =~ /\S/;
	substr($_, 0, $off) = "" if $off;

	my @a = split(' ', $_);
	my ($id, $desc, $type, $aux);
	$id = shift(@a);
	$aux = pop(@a);
	$type = pop(@a);
	$desc = "@a";
	$desc =~ s/\s+/_/g;

	$dagboeken[0+$id] = [ $desc, $type, lc($aux) eq "n.v.t." ? "\\N" : 0+$aux ];

#	# 1     Kas                                      Kas                 1000
#	#my @a = unpack("a6a41a20a6", $_);
#	my @a = /^(\d+)\s+(\S+)\s+(\S+)\s+(\d+|n\.v\.t\.)\s*$/i;
#	for ( @a[1,2] ) {
#	    s/\s+$//;
#	}
#	$dagboeken[0+$a[0]] = [ @a[1,2], lc($a[3]) eq "n.v.t." ? "\\N" : 0+$a[3] ];
    }

    open(my $f, ">dbk.sql") or die("Cannot create dbk.sql: $!\n");

    print $f ("-- Dagboeken\n\n",
	      "COPY Dagboeken (dbk_id, dbk_desc, dbk_type, dbk_acc_id) FROM stdin;\n");
    my %dbmap = ("Kas"	      => DBKTYPE_KAS,
		 "Bank/Giro"  => DBKTYPE_BANK,
		 "Bank"       => DBKTYPE_BANK,
		 "Giro"       => DBKTYPE_BANK,
		 "Inkoop"     => DBKTYPE_INKOOP,
		 "Verkoop"    => DBKTYPE_VERKOOP,
		 "Memoriaal"  => DBKTYPE_MEMORIAAL );

    for ( my $i = 0; $i < @dagboeken; $i++ ) {
	next unless exists $dagboeken[$i];
	my $db = $dagboeken[$i];
	print $f (_tsv($i, $db->[0], $dbmap{$db->[1]}, $db->[2]));
    }
    print $f ("\\.\n\n");

    print $f("-- Sequences for Boekstuknummers, one for each Dagboek\n\n");

    for ( my $i = 0; $i < @dagboeken; $i++ ) {
	next unless exists $dagboeken[$i];
	print $f ("CREATE SEQUENCE bsk_nr_${i}_seq;\n");
    }
    print $f ("\n");
    close($f);
}

my @hoofdverdichtingen;

sub read_hoofdverdichtingen {
    my ($off) = @_;
    while ( <$db> ) {
	last unless $_ =~ /\S/;
	substr($_,0,$off) = "" if $off;
	# 2        Vlottende activa
	my @a = m/(\d+)\s+(.*)/;
	for ( $a[1] ) {
	    s/\s+$//;
	}
	$hoofdverdichtingen[$a[0]] = [ $a[1], undef ]; # desc balres
    }
}

my @verdichtingen;

sub read_verdichtingen {
    my ($off) = @_;
    while ( <$db> ) {
	last unless $_ =~ /\S/;
	substr($_,0,$off) = "" if $off;
	# 21       Handelsvoorraden                             2
	my @a = m/^(\d+)\s+(.*?)\s+(\d+)\s*$/;
	for ( $a[1] ) {
	    s/\s+$//;
	}
	$verdichtingen[$a[0]] = [ $a[1], undef, undef, 0+$a[2] ]; # desc balres kstomz hoofdverdichting
    }
}

my %grootboek;
my @transactions;
my $op_deb;
my $op_crd;
INIT {
    $op_deb = $op_crd = 0;
}

sub read_grootboek {
    use Text::CSV_XS;
    my $csv = new Text::CSV_XS ({binary => 1});
    my $db;
    open ($db, "<GRTBK.CSV") ||
      open ($db, "<grtbk.csv")
	|| die("Missing: GRTBK.CSV\n");
    while ( <$db> ) {
	if ( $csv->parse($_) ) {
	    my @a = $csv->fields();
	    $grootboek{0+$a[0]} =
	      [ @a[1,3,4,5,6,7,12] ]; # desc B/W D/C N/.. struct btw N/J(omzet)?
	    my $balance = $a[17] - $a[16];
	    if ( $balance ) {
		$balance = -$balance if $a[4] eq 'D';
		push(@transactions, [0+$a[0], $balance]);
		if ( $balance < 0 ) {
		    $a[4] = ($a[4] eq 'D') ? 'C' : 'D';
		    $balance = -$balance;
		}
		if ( $a[4] eq 'C' ) {
		    $op_crd += $balance;
		}
		else {
		    $op_deb += $balance;
		}
	    }
	    $balance = $a[19] - $a[18];
	    if ( $balance ) {
		warn(sprintf("GrbRk $a[0]: saldo = %.2f\n", $balance));
	    }
	    $verdichtingen[$a[6]][1] = $a[3];  # balres
	    $verdichtingen[$a[6]][2] = $a[12]; # kstomz
	}
	else {
	    warn("Parse error at line $.\n");
	}
    }
    # print Dumper(\%grootboek);
    foreach ( @verdichtingen ) {
	next unless $_;
	$hoofdverdichtingen[$_->[3]][1] = $_->[1];
	$hoofdverdichtingen[$_->[3]][2] = $_->[2];
    }
}

sub read_btw {
    my ($off) = @_;
    my $hi;
    my $lo;
    my $btw_acc_hi_i;
    my $btw_acc_hi_v;
    my $btw_acc_lo_i;
    my $btw_acc_lo_v;
    my @btwtable;

    while ( <$db> ) {
	last unless $_ =~ /\S/;
	substr($_, 0, $off) = "" if $off;

	# Nr.   Omschrijving                             Perc.  Type  Ink.reknr. Verk.reknr.
	# ----------------------------------------------------------------------------------
	# 1     BTW 17,5% incl.                          17,50  Incl. 1520       1500       
	# 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
	#          1         2         3         4         5         6         7         8         9
	#my @a = unpack("a6a41a7a6a11a*", $_);
	my @a = m/^(\d+)\s+(.+?)\s+(\d\d?[.,]\d\d)\s+((?:In|Ex)cl(?:\.|usief))\s+(?:$|(\d+)\s+(\d+))\s*$/;
	warn("? $_"), next unless $a[1];

	# 3 - BTW 6% -> code 3 -- NOT!
	if ( $a[1] =~ /^(\d+) - (.*)/ ) {
	    #$a[0] = $1;
	    $a[1] = $2;
	}
	for ( @a[1,2,3] ) {
	    s/\s+$//;
	}

	my $btw = amount($a[2]);
	if ( AMTPRECISION > BTWPRECISION-2 ) {
	    $btw = substr($btw, 0, length($btw) - (AMTPRECISION - BTWPRECISION-2))
	}
	elsif ( AMTPRECISION < BTWPRECISION-2 ) {
	    $btw .= "0" x (BTWPRECISION-2 - AMTPRECISION);
	}
	$btwtable[$a[0]] = [ $a[1], $btw,
			     $a[3] =~ /^I/ ? 't' : 'f' ];

	if ( $btw ) {
	    if ( !$lo || $btw < $lo ) {
		$lo = $btw;
		undef $btw_acc_lo_i;
		undef $btw_acc_lo_v;
	    }
	    if ( !$hi || $btw > $hi ) {
		$hi = $btw;
		undef $btw_acc_hi_i;
		undef $btw_acc_hi_v;
	    }
	}
	next unless $btw;

	if ( $btw == $hi ) {
	    if ( $btw_acc_hi_i && ($btw_acc_hi_i != $a[4] || $btw_acc_hi_v != $a[5]) ) {
		warn("BTW probleem 1\n");
	    }
	    else {
		$btw_acc_hi_i = 0+$a[4];
		$btw_acc_hi_v = 0+$a[5];
	    }
	}
	elsif ( $btw == $lo ) {
	    if ( $btw_acc_lo_i && ($btw_acc_lo_i != $a[4] || $btw_acc_lo_v != $a[5]) ) {
		warn("BTW probleem 2\n");
	    }
	    else {
		$btw_acc_lo_i = 0+$a[4];
		$btw_acc_lo_v = 0+$a[5];
	    }
	}
    }
    foreach ( @btwtable ) {
	push(@$_, $_->[1] == 0 ? BTWTARIEF_NUL :
	     $_->[1] == $hi ? BTWTARIEF_HOOG :
	     $_->[1] == $lo ? BTWTARIEF_LAAG : warn("Onbekende BTW group: $_->[1]\n"));
    }

    open(my $f, ">btw.sql") or die("Cannot create btw.sql: $!\n");

    print $f ("-- BTW Tabel\n\n",
	      "COPY BTWTabel (btw_id, btw_desc, btw_perc, btw_incl, btw_tariefgroep) FROM stdin;\n");

    for ( my $i = 0; $i < @btwtable; $i++ ) {
	next unless exists $btwtable[$i];
	my $b = $btwtable[$i];
	print $f (_tsv($i, @$b));
    }

    print $f ("\\.\n\n");
    close($f);

}

sub write_rekeningschema {

    open(my $f, ">vrd.sql") or die("Cannot create vrd.sql: $!\n");

    print $f ("-- Hoofdverdichtingen\n\n",
	      "COPY Verdichtingen (vdi_id, vdi_desc, vdi_balres, vdi_kstomz, vdi_struct)".
	      " FROM stdin;\n");
    for ( my $i = 0; $i < @hoofdverdichtingen; $i++ ) {
	next unless exists $hoofdverdichtingen[$i];
	my $v = $hoofdverdichtingen[$i];
	# Skip unused verdichtingen.
	next unless defined($v->[1]) && defined($v->[2]);
	$v->[0] = decode("cp-850", $v->[0]) if $ac5;
	print $f (_tsv($i,
		       $v->[0],
		       $v->[1] eq 'B' ? 't' : 'f',
		       $v->[2] eq 'N' ? 't' : 'f',
		       "\\N"));
    }
    print $f ("\\.\n\n");

    print $f ("-- Verdichtingen\n\n",
	      "COPY Verdichtingen (vdi_id, vdi_desc, vdi_balres, vdi_kstomz, vdi_struct) FROM stdin;\n");
    for ( my $i = 0; $i < @verdichtingen; $i++ ) {
	next unless exists $verdichtingen[$i];
	my $v = $verdichtingen[$i];
	# Skip unused verdichtingen.
	next unless defined($v->[1]) && defined($v->[2]);
	$v->[0] = decode("cp-850", $v->[0]) if $ac5;
	print $f (_tsv($i,
		       $v->[0],
		       $v->[1] eq 'B' ? 't' : $v->[1] eq 'W' ? 'f' : '?',
		       $v->[2] eq 'N' ? 't' : $v->[2] eq 'J' ? 'f' : '?',
		       $v->[3]));
    }
    print $f ("\\.\n\n");
    close($f);

    open($f, ">acc.sql") or die("Cannot create acc.sql: $!\n");

    print $f ("-- Grootboekrekeningen\n\n",
	      "COPY Accounts (acc_id, acc_desc, acc_struct, acc_balres, acc_debcrd,".
	      " acc_kstomz, acc_btw, acc_ibalance, acc_balance) FROM stdin;\n");

    for my $i ( sort { $a <=> $b } keys(%grootboek) ) {
	my $g = $grootboek{$i};
	# desc B/W D/C N/.. struct btw N/J(omzet)?
	$g->[0] = decode("cp-850", $g->[0]) if $ac5;
	print $f (_tsv($i,
		       $g->[0],
		       $g->[4],
		       $g->[1] eq 'B' ? 't' : 'f',
		       $g->[2] eq 'D' ? 't' : 'f',
		       $g->[6] eq 'N' ? 't' : 'f',
		       $g->[5],
		       0,
		       0));
    }
    print $f ("\\.\n\n");
    close($f);

    open($f, ">std.sql") or die("Cannot create std.sql: $!\n");

    print $f ("-- Standaardrekeningen\n",
	      "INSERT INTO Standaardrekeningen\n",
	      " (std_acc_crd, std_acc_winst, std_acc_btw_il, std_acc_deb,".
	      " std_acc_btw_vh, std_acc_btw_ok, std_acc_btw_vl, std_acc_btw_ih)\n",
	      "VALUES (1600, 500, 1530, 1200, 1500, 1560, 1510, 1520);\n");
    close($f);

    die("Openingsbalans is niet in balans: $op_deb <> $op_crd\n")
      unless sprintf("%.2f", $op_deb) == sprintf("%.2f", $op_crd);

    open($f, ">opening.eb") or die("Cannot create opening.eb: $!\n");

    print $f ("# Data voor openingsbalans:\n\n");
    printf $f ("adm_balanstotaal %10.2f\n", $op_deb);
    foreach ( @transactions ) {
	printf $f ("adm_balans %5d %10.2f\n", @$_);
    }
    print $f ("\n");

    close($f);

}

################ Subroutines ################

sub app_options {
    my $help = 0;		# handled locally
    my $ident = 0;		# handled locally
    my $man = 0;		# handled locally

    # Process options.
    if ( @ARGV > 0 ) {
	GetOptions('ident'	=> \$ident,
		   'verbose'	=> \$verbose,
		   'ac5'	=> \$ac5,
		   'trace'	=> \$trace,
		   'help|?'	=> \$help,
		   'man'	=> \$man,
		   'debug'	=> \$debug)
	  or pod2usage(2);
    }
    if ( $ident or $help or $man ) {
	print STDERR ("This is $my_package [$my_name $my_version]\n");
    }
    if ( $man or $help ) {
	# Load Pod::Usage only if needed.
	require "Pod/Usage.pm";
	import Pod::Usage;
	pod2usage(1) if $help;
	pod2usage(VERBOSE => 2) if $man;
    }
}