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::Grootboek;

# Author          : Johan Vromans
# Created On      : Wed Jul 27 11:58:52 2005
# Last Modified By: Johan Vromans
# Last Modified On: Thu Jun  7 13:59:31 2012
# Update Count    : 287
# Status          : Unknown, Use with caution!

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

use strict;
use warnings;

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

use EB;
use EB::Booking;		# for dcfromtd()
use EB::Format;
use EB::Report::GenBase;
use EB::Report;

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

sub new {
    return bless {};
}

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

    my $detail = $opts->{detail};
    my $sel = $opts->{select};

    $opts->{STYLE} = "grootboek";
    $opts->{LAYOUT} =
      [ { name => "acct", title => _T("GrBk"),               width =>  5, align => ">" },
	{ name => "desc", title => _T("Grootboek/Boekstuk"), width => 30,              },
	{ name => "date", title => _T("Datum"),              width => $date_width      },
	{ name => "deb",  title => _T("Debet"),              width => $amount_width, align => ">" },
	{ name => "crd",  title => _T("Credit"),             width => $amount_width, align => ">" },
	{ name => "bsk",  title => _T("BoekstukNr"),         width => 14,              },
	{ name => "rel",  title => _T("Relatie"),            width => 10,              },
      ];

    my $rep = EB::Report::GenBase->backend($self, $opts);
    my $per = $rep->{periode};
    my ($begin, $end) = @$per;

    if ( my $t = $cfg->val(qw(internal now), 0) ) {
	$end = $t if $t lt $end;
    }

    $rep->start(_T("Grootboek"));

    $dbh->begin_work;

    my $table = EB::Report->GetTAccountsAll($begin, $end);

    my $ah = $dbh->sql_exec("SELECT acc_id,acc_desc,acc_ibalance,acc_balres".
			    " FROM ${table}".
			    ($sel ?
			     (" WHERE acc_id IN ($sel)") :
			     (" WHERE acc_ibalance <> 0".
			      " OR acc_id in".
			      "  ( SELECT DISTINCT jnl_acc_id FROM Journal )")).
			      " ORDER BY acc_id");

    my $dgrand = 0;
    my $cgrand = 0;
    my $mdgrand = 0;
    my $mcgrand = 0;
    my $n0 = numfmt(0);

    my $t;
    my $did = 0;

    while ( my $ar = $ah->fetchrow_arrayref ) {
	my ($acc_id, $acc_desc, $acc_ibalance, $acc_balres) = @$ar;

	my $sth = $dbh->sql_exec("SELECT jnl_amount,jnl_damount,jnl_bsk_id,bsk_desc,".
				 "bsk_nr,dbk_desc,dbk_dcsplit,jnl_bsr_date,jnl_desc,jnl_rel".
				 " FROM Journal, Boekstukken, Dagboeken".
				 " WHERE jnl_dbk_id = dbk_id".
				 " AND jnl_bsk_id = bsk_id".
				 " AND jnl_acc_id = ?".
				 " AND jnl_date >= ? AND jnl_date <= ?".
				 " ORDER BY jnl_bsr_date, jnl_bsk_id, jnl_seq",
				 $acc_id, $begin, $end);

	my $rr = $sth->fetchrow_arrayref;
	if ( !$acc_ibalance && !$rr ) {
	    $sth->finish;
	    next;
	}

	$rep->add({ _style => 'h1',
		    acct   => $acc_id,
		    desc   => $acc_desc,
		  }) if $detail;

	my $a = { _style => 'h2', desc   => _T("Beginsaldo") };
	if ( $acc_ibalance ) {
	    if ( $acc_ibalance < 0 ) {
		$a->{crd} = numfmt(-$acc_ibalance);
		$a->{deb} = $n0;
	    }
	    else {
		$a->{crd} = $n0;
		$a->{deb} = numfmt($acc_ibalance);
	    }
	}
	else {
	    $a->{deb} = $a->{crd} = $n0;
	}

	$rep->add($a) if $detail > 0;

	my $dtot = 0;
	my $ctot = 0;
	my $dcsplit;		# any acct was DC split
	while ( $rr ) {
	    my ($amount, $damount, $bsk_id, $bsk_desc, $bsk_nr,
		$dbk_desc, $dbk_dcsplit, $date, $desc, $rel) = @$rr;

	    warn("?Internal error: delta amount while no DC split, acct = $acc_id ($acc_desc)\n")
	      if defined($damount) && !$dbk_dcsplit;
	    $dcsplit ||= $dbk_dcsplit;

	    my ($deb, $crd) = EB::Booking::dcfromtd($amount, $damount);
	    $ctot += $crd if $crd;
	    $dtot += $deb if $deb;
	    $rep->add({ _style => 'd',
			desc   => $desc,
			date   => datefmt($date),
			deb    => numfmt($deb),
			crd    => numfmt($crd),
			bsk    => join(":", $dbk_desc, $bsk_nr),
			$rel ? ( rel => $rel) : (),
		      }) if $detail > 1;
	    $rr = $sth->fetchrow_arrayref;
	}

	$a = { _style => 't2', desc   => _T("Totaal mutaties") };
	if ( $dcsplit ) {
	    $a->{crd} = numfmt($ctot);
	    $a->{deb} = numfmt($dtot);
	    $mdgrand += $dtot if $dtot;
	    $mcgrand += $ctot if $ctot;
	}
	elsif ( $ctot > $dtot ) {
	    $a->{crd} = numfmt($ctot-$dtot);
	    $mcgrand += $ctot - $dtot;
	}
	else {
	    $a->{deb} = numfmt($dtot-$ctot);
	    $mdgrand += $dtot - $ctot;
	}

	$rep->add($a)
	  if $detail && ($dtot || $ctot || $acc_ibalance);

	$rep->add({ _style => 't1',
		    acct   => $acc_id,
		    desc   => __x("Totaal {adesc}", adesc => $acc_desc),
		    $ctot > $dtot + $acc_ibalance ? ( crd => numfmt($ctot-$dtot-$acc_ibalance) )
						  : ( deb => numfmt($dtot+$acc_ibalance-$ctot) ),
		  });
	if ( $ctot > $dtot + $acc_ibalance ) {
	    $cgrand += $ctot - $dtot-$acc_ibalance;
	}
	else {
	    $dgrand += $dtot+$acc_ibalance - $ctot;
	}
	$did++;
    }

    if ( $did ) {
	$rep->add({ _style => 'tm',
		    desc => _T("Totaal mutaties"),
		    deb => numfmt($mdgrand),
		    crd => numfmt($mcgrand),
		  });
	$rep->add({ _style => 'tg',
		    desc   => _T("Totaal"),
		    $cgrand || 1        ? ( crd => numfmt($cgrand) ) : (),
		    $dgrand || !$cgrand ? ( deb => numfmt($dgrand) ) : (),
		   });
    }
    else {
	print("?"._T("Geen informatie gevonden")."\n");
    }

    $rep->finish;
    # Rollback temp table.
    $dbh->rollback;
}

package EB::Report::Grootboek::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};
    return $self;
}

# Style mods.

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

    my $stylesheet = {
	_any => {
	#    desc   => { truncate    => 1 },
	},
	h2  => {
	    desc   => { indent      => 1 },
	},
	d  => {
	    desc   => { indent      => 2 },
	},
	t1  => {
	    _style => { skip_after  => ($self->{detail} > 0) },
	},
	t2  => {
	    desc   => { indent      => 1 },
	},
	tm => {
	    _style => { skip_before => 1 },
	},
	tg => {
	    _style => { line_before => 1 }
	},
    };

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

package EB::Report::Grootboek::Html;

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

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

package EB::Report::Grootboek::Csv;

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

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


1;