The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#! perl

# 90_ivp_common.pl -- Common code for IVPs
# Author          : Johan Vromans
# Created On      : Thu Oct 15 16:27:04 2009
# Last Modified By: Johan Vromans
# Last Modified On: Mon Jan 23 22:51:48 2012
# Update Count    : 126

use strict;
use warnings;

# The actual number of database tests, as executed by report_tests.
use constant NUMTESTS => 38;
# There are 9 initial tests.
# report_tests requires 1 more for the setup, and 1 for the export
# (all but the last).

my $remaining;
use Test::More
  $ENV{EB_SKIPDBTESTS} ? (skip_all => "Database tests skipped on request")
  : (tests => ( $remaining = 3*(NUMTESTS+2)-1+10 ));

use warnings;
BEGIN { use_ok('IPC::Run3') }
BEGIN { use_ok('EB::Config') }
BEGIN { use_ok('EB') }
BEGIN { use_ok('File::Copy') }
EB->app_init( { app => "ivp" } );
ok( $::cfg, "Got config");

$remaining -= 5;

our $dbdriver;
my $dbddrv;
$dbdriver = "postgres" unless $dbdriver;
if ( $dbdriver eq "postgres" ) {
    $dbddrv = "DBD::Pg";
}
elsif ( $dbdriver eq "sqlite" ) {
    $dbddrv = "DBD::SQLite";
}
BAIL_OUT("Unsupported database driver: $dbdriver") unless $dbddrv;

my $l = $ENV{LANG};
$l =~ s/_.*//;
for ( "ivp_".$ENV{LANG}, "ivp_$l", "ivp" ) {
    chdir($_), last if -d $_;
}

SKIP: {
    diag("This test is not yet implemented -- SKIPPED") unless -d "ref";
    skip("This test is not yet implemented", $remaining) unless -d "ref";

    my $f;
    for ( qw(opening.eb relaties.eb mutaties.eb schema.dat) ) {
	ok(1, $_), next if -s $_;
	if ( $f = findlib($_, "examples") and -s $f ) {
	    copy($f, $_);
	}
	ok(-s $_, $_);
    }
    $remaining -= 4;
    for ( qw(ivp.conf opening.eb relaties.eb
	     mutaties.eb reports.eb schema.dat ) ) {
	die("=== IVP configuratiefout: $_ ===\n") unless -s $_;
    }

    mkdir("out") unless -d "out";
    ok( -w "out" && -d "out", "writable output dir" );
    $remaining--;

    eval "require $dbddrv";
    skip("DBI $dbdriver driver ($dbddrv) not installed", $remaining) if $@;

    # Cleanup old files.
    unlink( glob("out/*.sql") );
    unlink( glob("out/*.log") );
    unlink( glob("out/*.txt") );
    unlink( glob("out/*.html") );
    unlink( glob("out/*.csv") );
    unlink( glob("ebsqlite_sample*") );

    my @ebcmd = qw(-MEB::Main -e EB::Main->run -- -X -f ivp.conf --echo);
    push(@ebcmd, "-D", "database:driver=$dbdriver") if $dbdriver;

    unshift(@ebcmd, map { ("-I",
			   "../../$_"
			  ) } grep { /^\w\w/ } reverse @INC);
    unshift(@ebcmd, $^X);

    # Check whether we can contact the database.
    eval {
	if ( $dbdriver eq "postgres" ) {
	    my @ds = DBI->data_sources("Pg");
	    diag("Connect error:\n\t" . ($DBI::errstr||""))
	      if $DBI::errstr;
	    skip("No access to database", $remaining)
	      if $DBI::errstr;
	      # && $DBI::errstr =~ /FATAL:\s*(user|role) .* does not exist/;
	}
    };

    #### PASS 1: Construct from distributed files.
    for my $log ( "out/init.log" ) {
	ok(syscmd([@ebcmd, qw(--init)], undef, $log), "init");
	checkerr($log);
    }

    report_tests(@ebcmd);

    for my $log ( "out/export1.log" ) {
	ok(syscmd([@ebcmd, qw(--export --dir=out)], undef, $log), "export1");
	checkerr($log);
    }

    #### PASS 2: Construct from exported files.
    for my $log ( "out/import1.log" ) {
	ok(syscmd([@ebcmd, qw(--import --dir=out)], undef, $log), "import1");
	checkerr($log);
    }

    report_tests(@ebcmd);

    for my $log ( "out/export2.log" ) {
	ok(syscmd([@ebcmd, qw(--export --file=out/export2.ebz)], undef, $log), "export2");
	checkerr($log);
    }

    #### PASS 3: Construct from exported .ebz .
    for my $log ( "out/import2.log" ) {
	ok(syscmd([@ebcmd, qw(--import --file=out/export2.ebz)], undef, $log), "import2");
	checkerr($log);
    }

    report_tests(@ebcmd);


}	# end SKIP

################ subroutines ################

sub report_tests {
    my @ebcmd = @_;

    for my $log ( "out/reports.log" ) {
	ok(syscmd(\@ebcmd, "reports.eb", $log), "reports");
	checkerr($log);
	$remaining--;
    }

    # Verify: balans in varianten.
    vfy([@ebcmd, qw(-c balans)           ], "balans.txt" );
    vfy([@ebcmd, qw(-c balans --detail=0)], "balans0.txt");
    vfy([@ebcmd, qw(-c balans --detail=1)], "balans1.txt");
    vfy([@ebcmd, qw(-c balans --detail=2)], "balans2.txt");
    vfy([@ebcmd, qw(-c balans --verdicht)], "balans2.txt");
    vfy([@ebcmd, qw(-c balans --opening) ], "obalans.txt");

    # Verify: verlies/winst in varianten.
    vfy([@ebcmd, qw(-c result)           ], "result.txt" );
    vfy([@ebcmd, qw(-c result --detail=0)], "result0.txt");
    vfy([@ebcmd, qw(-c result --detail=1)], "result1.txt");
    vfy([@ebcmd, qw(-c result --detail=2)], "result2.txt");
    vfy([@ebcmd, qw(-c result --verdicht)], "result2.txt");

    # Verify: Journaal.
    vfy([@ebcmd, qw(-c journaal)            ], "journaal.txt");
    # Verify: Journaal van dagboek.
    vfy([@ebcmd, qw(-c journaal postbank)   ], "journaal-postbank.txt");
    # Verify: Journaal van boekstuk.
    vfy([@ebcmd, qw(-c journaal postbank:24)], "journaal-postbank24.txt");

    # Verify: Proef- en Saldibalans in varianten.
    vfy([@ebcmd, qw(-c proefensaldibalans)           ], "proef.txt");
    vfy([@ebcmd, qw(-c proefensaldibalans --detail=0)], "proef0.txt");
    vfy([@ebcmd, qw(-c proefensaldibalans --detail=1)], "proef1.txt");
    vfy([@ebcmd, qw(-c proefensaldibalans --detail=2)], "proef2.txt");
    vfy([@ebcmd, qw(-c proefensaldibalans --verdicht)], "proef2.txt");

    # Verify: Grootboek in varianten.
    vfy([@ebcmd, qw(-c grootboek)           ], "grootboek.txt"      );
    vfy([@ebcmd, qw(-c grootboek --detail=0)], "grootboek0.txt"     );
    vfy([@ebcmd, qw(-c grootboek --detail=1)], "grootboek1.txt"     );
    vfy([@ebcmd, qw(-c grootboek --detail=2)], "grootboek2.txt"     );
    vfy([@ebcmd, qw(-c grootboek 2)         ], "grootboek_2.txt"    );
    vfy([@ebcmd, qw(-c grootboek 23)        ], "grootboek_23.txt"   );
    vfy([@ebcmd, qw(-c grootboek 23 22)     ], "grootboek_23_22.txt");
    vfy([@ebcmd, qw(-c grootboek 2320)      ], "grootboek_2320.txt" );

    # Verify: Crediteuren/Debiteuren.
    vfy([@ebcmd, qw(-c crediteuren)         ], "crdrept.txt");
    vfy([@ebcmd, qw(-c debiteuren)          ], "debrept.txt");

    # Verify: BTW aangifte.
    vfy([@ebcmd, qw(-c btwaangifte j)       ], "btw.txt"  );
    vfy([@ebcmd, qw(-c btwaangifte k2)      ], "btwk2.txt");
    vfy([@ebcmd, qw(-c btwaangifte 7)       ], "btw7.txt" );

    # Verify: HTML generatie.
    vfy([@ebcmd, qw(-c balans --detail=2 --gen-html)            ], "balans2.html");
    vfy([@ebcmd, qw(-c balans --detail=2 --gen-html --style=xxx)], "balans2xxx.html");
    vfy([@ebcmd, qw(-c btwaangifte j)], "btw.html");

    # Verify: CSV generatie.
    vfy([@ebcmd, qw(-c balans --detail=2 --gen-csv)], "balans2.csv");

    # Verify: XAF generatie.
    vfy([@ebcmd, qw(-c export --xaf=out/export.xaf)], "export.xaf");
}

sub vfy {
    my ($cmd, $ref) = @_;
    my @c = @$cmd;
    while ( shift(@c) ne "-c" ) { }
    if ( $ref =~ /\.xaf$/ ) {
	push( @c, "--xaf=$ref" );
    }
    else {
	push( @c, "--output=$ref" );
    }
    ok(!diff($ref), $ref);
}

sub vfyxx {
    my ($cmd, $ref) = @_;
    syscmd($cmd, undef, $ref);
    ok(!diff($ref), $ref);
}

sub diff {
    my ($file1, $file2) = @_;
    $file2 = "ref/$file1" unless $file2;
    $file1 = "out/$file1";
    my ($str1, $str2);
    local($/);
    open(my $fd1, "<:encoding(utf-8)", $file1) or die("$file1: $!\n");
    $str1 = <$fd1>;
    close($fd1);
    open(my $fd2, "<:encoding(utf-8)", $file2) or die("$file2: $!\n");
    $str2 = <$fd2>;
    close($fd2);
    $str1 =~ s/^EekBoek \d.*Squirrel Consultancy\n//;
    $str1 =~ s/[\n\r]+/\n/;
    $str2 =~ s/[\n\r]+/\n/;
    return 0 if $str1 eq $str2;
    1;
}

sub syscmd {
    my ($cmd, $in, $out, $err) = @_;
    $in = \undef unless defined($in);
    $err = $out if @_ < 4;
    #warn("+ @$cmd\n");
    run3($cmd, $in, $out, $err);
    printf STDERR ("Exit status 0x%x\n", $?) if $?;
    $? == 0;
}

sub checkerr {
    my $fail;
    unless ( -s $_[0] ) {
	warn("$_[0]: Bestand ontbreekt, of is leeg\n");
	$fail++;
    }
    open(my $fd, "<", $_[0]) or die("$_[0]: $!\n");
    while ( <$fd> ) {
	next unless /(^\?|^ERROR| at .* line \d+)/;
	warn($_);
	$fail++;
    }
    close($fd);
    die("=== IVP afgebroken ===\n") if $fail;
}

1;