The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! perl

package main;

our $cfg;
our $dbh;

package EB::Report::Proof;

# Author          : Johan Vromans
# Created On      : Sat Jun 11 13:44:43 2005
# Last Modified By: Johan Vromans
# Last Modified On: Sat Jun 19 00:39:09 2010
# Update Count    : 306
# Status          : Unknown, Use with caution!

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

use strict;
use warnings;

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

use EB;
use EB::Format;
use EB::Report;

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

sub new {
    my ($class, $opts) = @_;
    $class = ref($class) || $class;
    $opts = {} unless $opts;
    bless { %$opts }, $class;
}

sub proefensaldibalans {
    my ($self, $opts) = @_;
    $self->perform($opts);
}

sub perform {
    my ($self, $opts) = @_;

    my $detail = $opts->{detail};
    $detail = $opts->{verdicht} ? 2 : -1 unless defined $detail;
    $opts->{proef} = 1;
    $opts->{detail} = $detail;

    my @grand = (0) x 4;	# grand total

    $opts->{STYLE} = "proef";
    $opts->{LAYOUT} =
      [ { name => "acct", title => _T("RekNr"),    width => 6, },
	{ name => "desc",
	  title => $detail >= 0 ? _T("Verdichting/Grootboekrekening")
				: _T("Grootboekrekening"),
	  width => 40, },
	{ name => "deb",  title => _T("Debet"),    width => $amount_width, align => ">", },
	{ name => "crd",  title => _T("Credit"),   width => $amount_width, align => ">", },
	{ name => "sdeb", title => _T("Saldo Db"), width => $amount_width, align => ">" },
	{ name => "scrd", title => _T("Saldo Cr"), width => $amount_width, align => ">" },
      ];

    my $rep = EB::Report::GenBase->backend($self, $opts);

    my $rr;
    $rep->{periodex} = 1;
    my ($begin, $end) = @{$rep->{periode}};
    $dbh->begin_work;
    my $table = EB::Report->GetTAccountsAll($begin, $end);

    $rep->start(_T("Proef- en Saldibalans"));

    my $sth;

    my $hvd_hdr;
    my $vd_hdr;

    my $journaal = sub {
	my ($acc_id, $acc_desc, $acc_ibalance) = @_;
	my @tot = (0) x 4;
	my $did = 0;
	if ( $acc_ibalance ) {
	    $did++;
	    if ( $acc_ibalance < 0 ) {
		$tot[1] = -$acc_ibalance;
	    }
	    else {
		$tot[0] = $acc_ibalance;
	    }
	    # $rep->addline('D2', '', _T("Beginsaldo"), @tot);
	}
	my $sth = $dbh->sql_exec
	  ("SELECT jnl_amount,jnl_desc".
	   " FROM Journal".
	   " WHERE jnl_acc_id = ?".
	   " AND jnl_date >= ? AND jnl_date <= ?".
	   " ORDER BY jnl_bsr_date",
	   $acc_id, $begin, $end,
	  );
	while ( my $rr = $sth->fetchrow_arrayref ) {
	    my ($amount, $desc) = @$rr;
	    $did++;
	    my @t = (0) x 4;
	    $t[$amount<0] += abs($amount);
	    # $rep->addline('D2', '', $desc, @t);
	    $tot[$_] += $t[$_] foreach 0..$#tot;
	}
	if ( $tot[0] >= $tot[1] ) {
	    $tot[2] = $tot[0] - $tot[1]; $tot[3] = 0;
	}
	else {
	    $tot[3] = $tot[1] - $tot[0]; $tot[2] = 0;
	}
	$tot[0] ||= "00" if $did;
	$tot[1] ||= "00" if $did;
	@tot;
    };
    my $grootboeken = sub {
	my ($vd, $hvd) = shift;
	my @tot = (0) x 4;
	my $sth = $dbh->sql_exec
	  ("SELECT acc_id, acc_desc, acc_balance, acc_ibalance".
	   " FROM ${table}".
	   " WHERE acc_struct = ?".
	   " AND ( acc_ibalance <> 0".
	   "       OR acc_id IN ( SELECT DISTINCT jnl_acc_id FROM Journal".
	   "                      WHERE jnl_date >= ? AND jnl_date <= ? ))".
	   " ORDER BY acc_id",
	   $vd->[0], $begin, $end);
	while ( my $rr = $sth->fetchrow_arrayref ) {
	    my ($acc_id, $acc_desc, $acc_balance, $acc_ibalance) = @$rr;
	    my @t = $journaal->($acc_id, $acc_desc, $acc_ibalance);
	    next if "@t" eq "0 0 0 0";
	    $tot[$_] += $t[$_] foreach 0..$#tot;
	    next unless $detail > 1;

	    if ( $hvd_hdr ) {
		$rep->add({ acct => $hvd_hdr->[0],
			    desc => $hvd_hdr->[1],
			    _style => 'h1',
			  });
		undef $hvd_hdr;
	    }
	    if ( $vd_hdr ) {
		$rep->add({ acct => $vd_hdr->[0],
			    desc => $vd_hdr->[1],
			    _style => 'h2',
			  });
		undef $vd_hdr;
	    }
	    $rep->add({ _style => 'd2',
			acct => $acc_id,
			desc => $acc_desc,
			deb  => numfmt($t[0]),
			crd  => numfmt($t[1]),
			$t[2] ? ( sdeb => numfmt($t[2]) ) : (),
			$t[3] ? ( scrd => numfmt($t[3]) ) : (),
		      });
	}
	if ( $tot[0] >= $tot[1] ) {
	    $tot[2] = $tot[0] - $tot[1]; $tot[3] = 0;
	}
	else {
	    $tot[3] = $tot[1] - $tot[0]; $tot[2] = 0;
	}
	@tot;
    };
    my $verdichtingen = sub {
	my ($hvd) = shift;
	my @tot = (0) x 4;
	my $did = 0;
	foreach my $vd ( @{$hvd->[2]} ) {
	    next unless defined $vd;
	    $vd_hdr = [ $vd->[0], $vd->[1] ];
	    my @t = $grootboeken->($vd, $hvd);
	    next if "@t" eq "0 0 0 0";
	    $tot[$_] += $t[$_] foreach 0..$#tot;
	    next unless $detail > 0;
	    if ( $hvd_hdr ) {
		$rep->add({ acct => $hvd_hdr->[0],
			    desc => $hvd_hdr->[1],
			    _style => 'h1',
			  });
		undef $hvd_hdr;
	    }
	    $rep->add({ _style => 't2',
			acct => $vd->[0],
			desc => __x("Totaal {vrd}", vrd => $vd->[1]),
			$t[0] ? ( deb  => numfmt($t[0]) ) : (),
			$t[1] ? ( crd  => numfmt($t[1]) ) : (),
			$t[2] ? ( sdeb => numfmt($t[2]) ) : (),
			$t[3] ? ( scrd => numfmt($t[3]) ) : (),
		      });
	}
	if ( $tot[0] >= $tot[1] ) {
	    $tot[2] = $tot[0] - $tot[1]; $tot[3] = 0;
	}
	else {
	    $tot[3] = $tot[1] - $tot[0]; $tot[2] = 0;
	}
	@tot;
    };
    my $hoofdverdichtingen = sub {
	my (@hvd) = @_;
	my @tot = (0) x 4;
	foreach my $hvd ( @hvd ) {
	    next unless defined $hvd;
	    $hvd_hdr = [ $hvd->[0], $hvd->[1] ];
	    my @t = $verdichtingen->($hvd);
	    next if "@t" eq "0 0 0 0";
	    if ( $detail && $hvd_hdr ) {
		$rep->add({ acct => $hvd_hdr->[0],
			    desc => $hvd_hdr->[1],
			    _style => 'h1',
			  });
		undef $hvd_hdr;
	    }
	    $rep->add({ _style => 't1',
			acct => $hvd->[0],
			desc => __x("Totaal {vrd}", vrd => $hvd->[1]),
			$t[0] ? ( deb  => numfmt($t[0]) ) : (),
			$t[1] ? ( crd  => numfmt($t[1]) ) : (),
			$t[2] ? ( sdeb => numfmt($t[2]) ) : (),
			$t[3] ? ( scrd => numfmt($t[3]) ) : (),
		      });
	    $tot[$_] += $t[$_] foreach 0..$#tot;
	}
	@tot;
    };

    if ( $detail >= 0 ) {	# Verdicht
	my @vd;
	my @hvd;
	$sth = $dbh->sql_exec("SELECT vdi_id, vdi_desc".
			      " FROM Verdichtingen".
			      " WHERE vdi_struct IS NULL".
			      " ORDER BY vdi_id");
	while ( $rr = $sth->fetchrow_arrayref ) {
	    $hvd[$rr->[0]] = [ @$rr, []];
	}

	@vd = @hvd;
	$sth = $dbh->sql_exec("SELECT vdi_id, vdi_desc, vdi_struct".
			      " FROM Verdichtingen".
			      " WHERE vdi_struct IS NOT NULL".
			      " ORDER BY vdi_id");
	while ( $rr = $sth->fetchrow_arrayref ) {
	    push(@{$hvd[$rr->[2]]->[2]}, [@$rr]);
	    @vd[$rr->[0]] = [@$rr];
	}

	my @tot = $hoofdverdichtingen->(@hvd);
	$rep->add({ _style => 't',
		    desc => _T("TOTAAL"),
		    $tot[0] ? ( deb  => numfmt($tot[0]) ) : (),
		    $tot[1] ? ( crd  => numfmt($tot[1]) ) : (),
		    $tot[2] ? ( sdeb => numfmt($tot[2]) ) : (),
		    $tot[3] ? ( scrd => numfmt($tot[3]) ) : (),
		  });
    }

    else {			# Op Grootboek

	my @tot = (0) x 4;
	my $sth = $dbh->sql_exec
	  ("SELECT acc_id, acc_desc, acc_balance, acc_ibalance".
	   " FROM ${table}".
	   " WHERE ( acc_ibalance <> 0".
	   "         OR acc_id IN ( SELECT DISTINCT jnl_acc_id FROM Journal".
	  "                         WHERE jnl_date >= ? AND jnl_date <= ? ))".
	   " ORDER BY acc_id", $begin, $end);
	while ( my $rr = $sth->fetchrow_arrayref ) {
	    my ($acc_id, $acc_desc, $acc_balance, $acc_ibalance) = @$rr;
	    my @t = $journaal->($acc_id, $acc_desc, $acc_ibalance);
	    next if "@t" eq "0 0 0 0";
	    $tot[$_] += $t[$_] foreach 0..$#tot;
	    $rep->add({ _style => 'd',
			acct => $acc_id,
			desc => $acc_desc,
			deb  => numfmt($t[0]),
			crd  => numfmt($t[1]),
			$t[2] ? ( sdeb => numfmt($t[2]) ) : (),
			$t[3] ? ( scrd => numfmt($t[3]) ) : (),
		      });
	}
	$rep->add({ _style => 't',
		    desc => _T("TOTAAL"),
		    deb  => numfmt($tot[0]),
		    crd  => numfmt($tot[1]),
		    $tot[2] ? ( sdeb => numfmt($tot[2]) ) : (),
		    $tot[3] ? ( scrd => numfmt($tot[3]) ) : (),
		  });
    }
    $rep->finish;
    $dbh->rollback;
}

package EB::Report::Proof::Text;

use EB;
use base qw(EB::Report::Reporter::Text);

sub new {
    my ($class, $opts) = @_;
    my $self = $class->SUPER::new($opts->{STYLE}, $opts->{LAYOUT});
    $self->{detail} = $opts->{detail};
    $self;
}

# Style mods.

sub style {
    my ($self, $row, $cell) = @_;

    my $stylesheet = {
	d2  => {
	    desc   => { indent      => 2 },
	},
	t2  => {
	    _style => { skip_after  => $self->{detail} > 1, },
	    desc   => { indent      => 1 },
	},
	h2  => {
	    desc   => { indent      => 1 },
	},
	t1 => {
	    _style => { skip_after  => $self->{detail} > 0,
			skip_before => $self->{detail} > 1,
		      },
	},
	t => {
	    _style => { line_before => 1 }
	},
    };

    $cell = "_style" unless defined($cell);
    return $stylesheet->{$row}->{$cell};
}

package EB::Report::Proof::Csv;

use EB;
use base qw(EB::Report::Reporter::Csv);

sub new {
    my ($class, $opts) = @_;
    $class->SUPER::new($opts->{STYLE}, $opts->{LAYOUT});
}

package EB::Report::Proof::Html;

use EB;
use base qw(EB::Report::Reporter::Html);
use strict;

sub new {
    my ($class, $opts) = @_;
    $class->SUPER::new($opts->{STYLE}, $opts->{LAYOUT});
}

1;