#!/usr/bin/perl -w

use strict;
use POSIX qw( strftime);
use Pg;

#=============================
#
#      SUB's

sub usage {
    print "usage:\n
rewriteRglt.pl --help : this
rewriteRglt.pl [-o <output file>] -h DBHOST -u USER -p PWD
génère la liste des reglements en re-répartissant ceux-ci chronologiquement dans les factures.

";
} 

sub getArgs {
    my @args=@_;
    my $oldKey="";
    my %opts=();
	my $el;
    for $el (@args) {
	if ($el=~/^-/) {
	    $el=~s/-+//g;
	    $opts{$el}="";
	    $oldKey=$el;
	}
	else {
	    $opts{$oldKey}=$el;
	}
    }
    return %opts;
}

sub connectPg {
    my ($DBHOST,$DBNAME,$DBUSER,$DBPWD)=@_;
	my $debug=0;
    # Ouverture connexion postgres
    my $req={};
    my $conn = Pg::connectdb("dbname=$DBNAME user=$DBUSER host=$DBHOST password=$DBPWD");
    print "dbname=$DBNAME user=$DBUSER password=$DBPWD host=$DBHOST\n" if $debug;
    if (PGRES_CONNECTION_OK ne $conn->status) {
		print STDERR "dbname=$DBNAME user=$DBUSER password=$DBPWD host=$DBHOST";
    }
	return $conn;
}

sub round{
	my($l_arg1,$l_scale)=@_;
	return 0 if ($l_arg1 == 0);
	my($l_num1,$l_num2) = 0;
	$l_num1 = 10**$l_scale * $l_arg1;
	$l_num2 = int($l_num1);
	$l_num2 = $l_num2 +1 if ($l_num1 - $l_num2 >= 0.5);
	$l_num1 =  $l_num2/10**$l_scale;
	return $l_num1; 
}
#=============================


my $sql;
my $output;
my $conn;
my %opts=();
my $sep;
my @lrglt;
my @lmvt;
my %lclient;
my %client=();
my @merge=();

%opts=getArgs(@ARGV);


if (exists $opts{help}) {
	&usage();
	exit;
}
if (!exists $opts{p}) {
	&usage();
	exit;
}
if (!exists $opts{u}) {
	&usage();
	exit;
}
if (!exists $opts{h}) {
	&usage();
	exit;
}

if (exists $opts{o}) {
    $output=$opts{o};
    open(OUT,">$output");
    *STDOUT=*OUT;
}

my ($USER,$DBNAME,$DBPWD,$DBHOST);
$USER=$opts{u};
$DBNAME=$opts{n};
$DBPWD=$opts{p};
$DBHOST=$opts{h};

$conn=connectPg("$DBHOST","$DBNAME","$USER","$DBPWD");


# Recup des pimengest (map pour affichage) #
#========================================#
$sql=" 
set datestyle to 'SQL,EURO';
SELECT uid,nom from client;";

my $result=$conn->exec($sql); 
if (PGRES_TUPLES_OK ne $result->resultStatus) {
	print STDERR "ERREUR  : $sql failed : ".$conn->errorMessage;
	exit 0;
}

while (my @row = $result->fetchrow) {
	#print join($sep,@row)."\n";
	$lclient{$row[0]}=$row[1];
}

# Recup des reglements #
#======================#
$sql=" 
set datestyle to 'SQL,EURO';
SELECT 1000000000+date_part('epoch',ecriture.date),valeur as montant,client.uid,'RGLT',0,0 from ecriture,client where client.compte=ecriture.compte and ecriture.action='credite' order by date ASC ";

$result=$conn->exec($sql); 
if (PGRES_TUPLES_OK ne $result->resultStatus) {
	print STDERR "ERREUR  : $sql failed : ".$conn->errorMessage;
	exit 0;
}

while (my @row = $result->fetchrow) {
	#print join($sep,@row)."\n";
	push (@lrglt,\@row);
	push (@merge,\@row);
}


#  Recup des factures #
#======================#
$sql="select distinct client,c.nom from factures,client c where c.uid=client;";
$result=$conn->exec($sql); 
if (PGRES_TUPLES_OK ne $result->resultStatus) {
	print STDERR "ERREUR  : $sql failed : ".$conn->errorMessage;
	exit 0;
}
while (my @row = $result->fetchrow) {
	$client{$row[0]}{du}=0;
	$client{$row[0]}{paye}=0;
	$client{$row[0]}{nom}=$row[1];
	$client{$row[0]}{factures}=();
	my $ssql="select factures.uid,montanttc*devise.nbeuros,0,id,1000000000 + date_part('epoch',dateemission),montanttc from factures,devise where devise.uid=devise and client=".$row[0]." order by id ASC";
	my $sresult=$conn->exec($ssql);
	if (PGRES_TUPLES_OK ne $sresult->resultStatus) {
		print STDERR "ERREUR  : $ssql failed : ".$conn->errorMessage;
		exit 0;
	}
	while (my @srow = $sresult->fetchrow) {
		push(@{$client{$row[0]}{factures}},\@srow); # uid - montant ttc euro (du) - paye - id - date emission - montanttc
		$client{$row[0]}{du}+=$srow[1];
	}
}

@lrglt= sort {$::a->[0] <=> $::b->[0]} @lrglt;


# Chargement des reglements dans les comptes pimengest #
#====================================================#
for my $r_rglt (@lrglt) {
	$client{$r_rglt->[2]}{paye}+=$r_rglt->[1];
	$client{$r_rglt->[2]}{du}-=$r_rglt->[1];
	my $key=$r_rglt->[2];

	my ($jour,$mois,$annee)=split(' ',strftime("%d %m %Y",localtime($r_rglt->[0]-1000000000)));
	print STDERR "\nReglement du $jour/$mois/$annee de $r_rglt->[1] ¤ ($r_rglt->[5])\n------------\n";

	my @listFactures=@{$client{$key}{factures}};
	@listFactures= sort {$::a->[4] <=> $::b->[4] } @listFactures; # tri par date emission
	my $regle=$r_rglt->[1];

	for my $fact (@listFactures) { # uid - montant ttc euro (du) - paye - id - date emission - montanttc
		next if $fact->[1]==0;
		my $montantL;
		if ($fact->[1]<=$regle) {
			$regle=$regle-$fact->[1];
			$montantL=$fact->[1];
			$fact->[2]=$fact->[1];
			$fact->[1]=0;
		}
		else {
			$montantL=$regle;
			$fact->[1]=$fact->[1]-$regle;
			$fact->[2]=$regle;
			$fact->[1]=$fact->[1];
			$regle=0;
		}
		if ($montantL>0.01) {
			print STDERR "\tFacture ".$fact->[3]." client ".$lclient{$key}." : payé : ".round($fact->[2],2)." ¤, restant dû : ".round($fact->[1],2)." ¤, \n";
			print "insert into reglement (uid,client,montant,datepaye,factures,devise) values (nextId(),$key,".($montantL).",date(timestamp(".($r_rglt->[0]-1000000000).")),".$fact->[0].",352083);\n";
		}
		last if (round($regle,2)==0);
	}
	print STDERR "Reste au client : ".$client{$r_rglt->[2]}{du}."\n";
}


#Tests=================
my $test=0;
if ($test) {
	for my $key (keys(%client)) {
		print STDERR "\n =============================== \n";
		print STDERR $lclient{$key}." : \n";
		my @listFactures=@{$client{$key}{factures}};
		@listFactures= sort {$::a->[4] <=> $::b->[4] } @listFactures;
		for my $fact (@listFactures) {
			print STDERR <<EOF;
			$fact->[3]  du : $fact->[1]  payé : $fact->[2]
EOF
}
	}
	exit;
}
#======================