use utf8;
use warnings; no warnings "redefine";
use strict;

use Loader qw(
	acct_rechnung
	edit_templates
	line_print_end
	line_printer
	log_update
  );
use Dbase::Help qw(DoTrans DoFn Do unixtime isodate DoT unixdate qquote
	isotime date_add_ymd DoTime DoSelect DoTransExit DoSeq in_test);
use Dbase::Globals qw(find_descr name_kunde bignum content sdaterange
	rund);

use Cf qw($MWST $MWSTKO $KERLOES $RLDUMPHOST);
use Fehler qw(fehler report_fehler ffehler problem report_status);
use File::Temp qw(tmpnam);
use Date::Calc qw(Add_Delta_YM Add_Delta_Days);
use IO::Socket::INET;

sub dump_konten($$$$$) {
	my($vx,$id,$rnr,$rdate,$mwst_satz) = @_;
	$rdate = DoTime if $rdate == 0;
	my $ret;
	my %ts;
	my $ts="";
	my @ba;
# 8413~1997-07--1997-06~scratchy:       5.00 ~noris-ipnr~

	my($ko,$be,$summe,$tag,$dat,$tar);
	$tag = "~";
	$dat = "~";
	$tar = "~";
	while(($ko,$be)=each %$vx) {
		next unless $ko =~ /^\d+\~/;
		my($kto,$datu,$wha) = split(/~/,$ko);
		$tag .= "$wha~"  unless $tag =~ /~$wha~/;
		$dat .= "$datu~" unless $dat =~ /~$datu~/;
		my $tab; foreach $tab(split(/~/,$be->[0])) {
			$tar .= "$tab~"  unless $tar =~ /~$tab~/;
		}
		$summe += $be->[1];
	}
	chop $tag; chop $dat; chop $tar;

	$tag =~ s/~/,/g; $tag =~ s/^,+//;
	$dat =~ s/~/,/g; $dat =~ s/^,+//;
	$tar =~ s/~/,/g; $tar =~ s/^,+//;

	$tag .= ", $dat, $tar";
	$tag =~ s/^x,\s?//;
	$tag =~ s/,x,/,/;
	$tag = "$1..." if $tag =~ /^(.{75}).../;

# Datum Text Betrag KtoVon KtoNach
	my $dai = isodate($rdate);
	$dai =~ s/^(\d+)-(\d+)-(\d+)$/$3.$2.$1/;

	# Vorsicht ist geboten: int(BIGINT) ist immer noch eine BIGINT. :-/
	my $mwst = defined $mwst_satz ? rund("$summe" * $mwst_satz/1000) : 0;
	$summe += $mwst;
	$summe = sprintf("%.02f",$summe/100);
	$mwst = sprintf("%.02f",$mwst/100) if $mwst;
	$ret .= "$dai;A;$rnr;$tag;$summe;".(10000+$id).";\n";
	$ret .= ";;;USt $tag;$mwst;;$MWSTKO\n" if $mwst;
	while(($ko,$be)=each %$vx) {
		next unless $ko =~ /^\d+\~/;
		my($knd,$kto,$datu,$wha) = split(/~/,$ko);
		$knd = $id if $knd == 0;
		my $knm = name_kunde($knd);
		my $tx = $be->[0]; chop $tx;
		$tx =~ s/~/,/g; $tx =~ s/^,//; $tx =~ s/,\s*$//;
		txl: foreach my $t(split(/,\s*/,$tx)) {
			next txl if $ts{$t}++;
			if(length $ts > 95) {
				$ts .= ",..." unless $ts =~ m#,\.\.\.$#;;
				last txl;
			}
			$ts .= "," if length $ts;
			$ts .= $t;
		}
		my $txx = "$knm: $tx";
		$tx .= ", $wha" if defined $wha and $wha ne "";

		my $bet = $be->[1];
		my $beb = sprintf("%.02f",$bet/100);

		$txx .= ", $datu";
		$txx .= ", $wha" if defined $wha and $wha ne "";
		$txx =~ s/, x$//;
		$txx = "$1..." if $txx =~ /^(.{75}).../;

		my $tadd = ";;;$txx;$beb;;$kto\n";
		$ret .= $tadd;

		my $df = $datu;
		my $dt;
		if($df =~ s/-(\d{4}-[-\d]+)//) {
			$dt = $1;
		} else {
			$dt = $df;
		}
		my($y,$m,$d);

		($y,$m,$d)=split(/-/,$df);
		$d=1 unless $d;
		$df = unixdate($y,$m,$d);

		($y,$m,$d)=split(/-/,$dt);
		unless($d) {
			$d=1;
			$m=1,$y++ if $m++ == 12;
		}
		$dt = unixdate($y,$m,$d);

		push(@ba,[$knd,$tx,$kto,$df,$dt,$bet,$ko.$tadd]);
	}
	($ret,$ts,\@ba);
}

## $flag: 1: Originalrechnung; Rechnungsdatensätze updaten
##           sonst: wiederholte Rechnung; Daten aus den alten
##                  Datensätzen verwenden (Tabelle 'nextrech'), *oder*
##                  (in der Zukunft liegende) Testrechnung
##        2: kein Progress
##        4: Blafasel (an stdout) beim Erstellen ausführlich
##        8: Debug-Texte in die Rechnung kritzeln
##       16: vergleiche mit existierender Rechnung (in acct_kunde)
##       32: -frei- war Testrechnung
##       64: keine USt
##      128: -frei-
##      256: hänge Datei an
##      512: schreibe den Diff aus <16> in eine Datei und liefere deren
##           Name zurück

my $eigene_re;

sub acct_kunde($;$$$$$) {
	my($id,$kn,$flg,$ornr,$tmonat,$rid) = @_;
	$flg=0 unless defined $flg;
	my $cutoff; ## TODO: Restore!
	my($quelle,$dienst,$ziel,$jjmm);
	my($j1,$j2);
	my $final=0;
	my $manu = 1<<find_descr("rstatus","manuell");
	my $rdate; # Datum Rechnung
	my $f3;
	$flg |= 16 if $flg&512;
	$f3 = tmpnam() if $flg&16;
	my($template,$erste,$letzte);

	$final=($flg&32)?2:1 if $flg&1;
	$eigene_re = bignum(1)<<find_descr("kunde","eigene_re")
		if not $eigene_re;

# Fälle:
# - neue Rechnung(en), für Kunde oder für alle. Flag&17=1.
# - neue Testrechnung(en), dito. Flag&17=0.
# - Vergleichen, für einen bestimmten Kunden. Flag=16. $ornr kann gesetzt sein.
# - Vergleichen, für alle Kunden. Flag=16. Datum der Altrechnungen abfragen.
	
	return problem "Das geht nicht für alle Kunden" if $ornr and not $id;

	my $rlsock;
	if($final == 1) {
		my $min_ts = DoFn("select id from nextid where name='acct_ts'");
		if(defined $min_ts) {
			my ( $y, $m ) = isodate( DoTime() );
			my $want_ts = unixtime( $y, $m, 1, 0, 0, 0 );
			if($want_ts > $min_ts) {
				my $msg = <<_;
Es gibt unbearbeitete Accountingdaten (älteste: ${\ scalar isotime $min_ts}).
Deshalb kann aktuell kein Rechnungslauf durchgeführt werden.
_
				return problem $msg unless in_test();
				print $msg,"(Dies wird IGNORIERT, weil TESTSYSTEM!)\n";
			}
		} # andernfalls alter Datenbestand o.ä.

		print STDERR "Rechnungen werden generiert.\n";
		if(not $id and not in_test()) {
			$rlsock = IO::Socket::INET->new(PeerAddr => $RLDUMPHOST, Timeout => 20)
			        or warn "Der Rechnungslauf-Dumper antwortet nicht!";
		}
	}

	my $outtext = "";
	my $tt1 = "";
	my $tt2 = "";

	{
		$rid = edit_templates("rech_fuss","!Rechnungs-Fußtext",1+4)
			unless defined $rid;
		return unless defined $rid;
		($template,$outtext) = DoFn("select id,inhalt from template where id=$rid")
			if $rid ne "-";
	}

	my $bbit = find_descr("rstatus","buchen");
	$bbit = bignum(1)<<$bbit if $bbit;
	my $abit = find_descr("rstatus","abbuchen");
	$abit = bignum(1)<<$abit if $abit;
	if($flg&16) {
		$tt1 .= ",rechnungen ";
		$tt2 .= " and kunde.id=rechnungen.kunde and rechnungen.datum >= UNIX_TIMESTAMP(NOW())-24*3600*63";
		$tt2 .= " and ( kunde.ende is null or kunde.ende > UNIX_TIMESTAMP(NOW())-24*3600*95 )";
	}

	my $res = DoT("select distinct kunde.id,kunde.zuletzt,kunde.berechne,kunde.ende,kunde.erloeskonto,kunde.flags from kunde $tt1 where ".(($id == 0) ? "( kunde.kunde is null or (kunde.flags & $eigene_re)) and kunde.berechne != 'x' and kunde.berechne != 'k' $tt2 order by kunde.geaendert desc, kunde.id desc" : "kunde.id = $id"));
	my $narr;
	my $kid;
	# my $nrech = 0;
	my $bla;

	my $r;
	my $errs = "";
	foreach $narr(@$res) {
		$bla="";
		ffehler {
			my($firstm,$berechne,$kende,$kerloes,$kflags);

			($kid,$firstm,$berechne,$kende,$kerloes,$kflags) = @$narr;

			return if $id == 0 and $final == 1 and DoFn("select skip from kunde where id = $kid") eq "y";

			DoTrans {
				my $mx;
				$r = undef;

				if($flg&16) {
					my $rnr = DoFn("select rechnungen.rnr from rechnungen,knextrech where rechnungen.kunde=$kid and knextrech.rnr=rechnungen.rnr and (rechnungen.flags & $manu) = 0 order by rechnungen.rnr desc limit 1");
					unless($rnr) { ## nicht für Neukunden
						print STDERR "Kunde #$kid:${\name_kunde $kid}: Erstrechnung, kein Vergleich möglich.\n"
							unless $flg&2 or not -t STDIN;
							## siehe weiter unten, {'flags'}{'quiet'}
						return;
					}
					$r = acct_rechnung(repro => $rnr);
				}
				$r = acct_rechnung(kunde=>$kid) if not defined $r;
				$r->{'flags'}{'test'} = 1 unless $flg&1;
				$r->{'flags'}{'quiet'} = 1 if $flg&2 or not -t STDIN;
				$r->{'flags'}{'trace'} = 1 if $flg&4;
				$r->{'flags'}{'debug'} = 1 if $flg&8;
				$r->{'repro'} = $ornr if $ornr;
				if($tmonat) {
					$r->{'flags'}{'test'} = 1; $flg &=~1;
					$r->{'acct_beginn'} = $tmonat;
					$r->{'acct_ende'} = date_add_ymd($tmonat,0,1);
					$r->{'rech_beginn'} = $tmonat;
					$r->{'rech_ende'} = date_add_ymd($tmonat,0,1);
					$r->{'rechnungsdatum'} = $tmonat;
					$r->{'tarif_ende'} = date_add_ymd($tmonat,0,1);
				}

				# Überspringe bei "richtiger" Rechnung, wenn schon erledigt
				#  oder schon-ewig-nicht-mehr-Kunde
				return
				  if $id == 0
				  && $final == 1
				  && defined $kende
				  && $kende < DoTime() - 24 * 3600 * 430;    # 1 Jahr + 2 Monate
				# die "Wegen Speicherleck das Ganze jetzt bitte neu starten, sorry...\n" if ++$nrech > 40;

				$r->prep($outtext);
				if($flg&16 or $r->{'repro'}) {
					$r->{'rnr'} = $r->{'repro'};
				} elsif(not $flg&1) {
					$r->{'rnr'} = "TESTRECHNUNG";
				}

				print STDERR "$kid/".name_kunde($kid)."\n" unless $r->{'flags'}{'quiet'};
				$r->run();
				$b = $r->{'betrag'};
				$bla = $r->{'text'};

				# Schreibe nur Rechnung, wenn >= 10 Euro
				# oder wenn Abbuchungsauftrag
				# oder wenn Jahresende oder >1Jahr seit letzter Rechnung
				# oder wenn Erstrechnung
				my($blz,$name,$kontonr,$bank) = DoFn("select blz,name,kontonr,bank from konten where kunde = $kid");

				my $rendm=(isodate($r->{'rech_ende'}))[1];
				if($b and (not defined $firstm or ($kende and $kende < DoTime) or abs($b) >= 1000 or $rendm == 1)) {
					my $rrdate = $rdate;

					$letzte = $r->{'rnr'};
					$erste = $letzte unless defined $erste;
					my($buch,$rtxt,$bda) = dump_konten($r->{'buchungen'},$kid,$r->{'rnr'},$r->{'rechnungsdatum'},$r->{'mwst'});
					if($bla =~ /\s\d{2,3}\:\%/ or $bla =~ /\s[1-9]\:\%/ or $flg & 8) {
						$bla =~ s/\b(\d{1,3})\:\%/$1 %/g;
					} else {
						$bla =~ s/Rabatt/      /g;
						$bla =~ s/0\:\%/   /g;
					}
					my($kid) = $narr->[0];
					if($final == 1) {
						my($kt,$nr);
						while(($kt,$nr) = each %{$r->{'tarifkunden'}}) {
							log_update("tarifkunde","id",$kt,undef,"nextrech",undef,
								DoFn("select nextrech from tarifkunde where id=$kt"));
							Do("update tarifkunde set nextrech=$nr where id=$kt and ( nextrech < $nr or nextrech is null )");
						}
					}
					if($final != 1 and not $flg&16) {
						no warnings 'once';
						line_printer(1);
						print $Db::pr_fh $bla;
						line_print_end();
					}

					my($mwst);
					if(defined $r->{'mwst'}) {
						$mwst = rund($b * $r->{'mwst'}, 3);
					} else {
						$mwst = 0;
					}

					$kerloes ||= $KERLOES;
					if($final == 1) {

						foreach my $ac(@$bda) {
							my($rku,$txt,$act,$df,$dt,$betr,$x) = @$ac;
							fehler "Kein Konto im Tarif!  $rku $txt $x" unless $act;
						}

						log_update("kunde","id",$kid,undef,"zuletzt",undef,
							DoFn("select zuletzt from kunde where id=$kid"));

						if($ornr) {
							Do("delete from buchung where rnr=$ornr");
							Do("update rechnungen set kunde=$kid, datum=$r->{'rechnungsdatum'}, betrag=$b, steuer=$mwst, infotext=${\qquote $rtxt,1}, rtext=${\qquote $bla}, flags=$bbit, konto=$kerloes where  rnr=$r->{'rnr'}");
						} else {
							my($y,$m,$d) = isodate($r->{'acct_ende'});
							$d=100*$y+$m;
							Do("update kunde set zuletzt=$d where id=$kid");
							Do("insert into rechnungen set kunde=$kid, rnr=$r->{'rnr'}, datum=$r->{'rechnungsdatum'}, betrag=$b, steuer=$mwst, infotext=${\qquote $rtxt,1}, rtext=${\qquote $bla}, flags=$bbit, konto=$kerloes");
						}
						my $seq=1;
						foreach my $ac(@$bda) {
							my($rku,$txt,$act,$df,$dt,$betr) = @$ac;
							Do("insert into buchung set rnr=$r->{'rnr'}, seq=$seq, buchtext=${\qquote $txt}, betrag=$betr, beginn=$df,ende=$dt, kunde=$rku,konto=$act");
							$seq++;
						}
						$r->db();
						log_update("rechnungen","rnr",$r->{'rnr'},undef,"*");
					}
					if($flg & 16) {
						my $f1 = tmpnam();
						my $f2 = tmpnam();
						open(F1,"> $f1");
						if($r->{'repro'}) {
							DoSelect {
								my($rtxt) = $_[0];
								$rtxt =~ s/\n\s+=+ Fortsetzung Seite \d+ =+\s*\n+\f\n*\s+Seite \d+\s*\n+/\n/g;
								$rtxt =~ s/\n+\s+A..c..h..t..u..n..g[\000-\377]+?(?:I..B..A..N..\:|hrten Konten m).*\n+/\n/ig;
								print F1 $rtxt;
							} "select rtext from rechnungen where rnr=$r->{'repro'}";
						}
						close(F1);
						$bla =~ s/\n\s+=+ Fortsetzung Seite \d+ =+\s*\n+\f\n*\s+Seite \d+\s*\n+/\n/g;
						$bla =~ s/\n+\s+A..C..H..T..U..N..G[\000-\377]+?(?:I..B..A..N..\:|hrten Konten m).*\n+/\n/ig;
						open(F2,"> $f2"); print F2 $bla; close(F1);
						system("diff -ubiB $f1 $f2 >/dev/null 2>&1");
						my $doit = $?;

						if($r->{'repro'}) {
							my($cb,$cmwst,$crtxt,$ckerloes) = DoFn("select betrag,steuer,infotext,konto from rechnungen where rnr=$r->{'repro'}");
							$doit++ if not defined $cb or $cb != $b or $cmwst != $mwst or $crtxt ne $rtxt or $kerloes != $ckerloes;
						}

						my $lcmp = sub($$) {
							my($x,$y) = @_;
							# kunde,buchtext,konto,beginn,ende,betrag
							foreach my $p(0,2,5,3,4) {
								no warnings "uninitialized";
								# insbes. das Enddatum kann NULL sein
								return -1 if $x->[$p] < $y->[$p];
								return 1  if $x->[$p] > $y->[$p];
							}
							return -1 if $x->[1] lt $y->[1];
							return 1  if $x->[1] gt $y->[1];
							return 0;
						};
						my $lstr = sub($) {
							my($ku,$tx,$ac,$f,$t,$btr) = @{$_[0]};
							"Kunde $ku  Betr $btr  Kto $ac  \@ ".sdaterange($f,$t);
						};
						my @cbda;
						if($r->{'repro'}) {
							DoSelect {
								push(@cbda,[@_]);
							} "select kunde,buchtext,konto,beginn,ende,betrag from buchung where rnr=$r->{'repro'}";
						}

						my $bda = join("\n",map $lstr->($_), sort $lcmp @$bda);
						my $cbda = join("\n",map $lstr->($_), sort $lcmp @cbda);

						$doit++ if $cbda ne $bda;

						if($doit) {
							open(F3,">> $f3");
							print F3 "\n*** $kid *** ".name_kunde($kid)." ***\n";
							if($r->{'repro'}) {
								my($cb,$cmwst,$crtxt,$ckerloes) = DoFn("select betrag,steuer,infotext,konto from rechnungen where rnr=$r->{'repro'}");
								if(not defined $cb) {
									print F3 "??? kein Rechnungsdatensatz??\n";
								} else {
									if($cb != $b or $cmwst != $mwst or $crtxt ne $rtxt or $kerloes != $ckerloes) {
										print F3 "Rechnung $r->{'repro'}: ";
										print F3 " Betrag $cb $b " if $cb != $b;
										print F3 " MWst $cmwst $mwst " if $cmwst != $mwst;
										print F3 " Text '$crtxt' '$rtxt' " if $crtxt ne $rtxt;
										print F3 " Konto $ckerloes $kerloes " if $ckerloes != $kerloes;
										print F3 "\n";
									}
								}
								open(F1,">> $f1");
								open(F2,">> $f2");
								print F1 "Buchungen:\n$bda\n";
								print F2 "Buchungen:\n$cbda\n";
								close(F1);
								close(F2);
							}
							close(F3);
							system("diff -ubiB $f1 $f2 >> $f3");
						}
						unlink($f1,$f2);
					}
					$b = ($b+$mwst) * 0.01;
					if($blz) {
						Do("update rechnungen set flags = flags | $abit where rnr = $r->{'rnr'}") if $final == 1;
					}
				} elsif($b) {
					printf "$kid/".name_kunde($kid).": Betrag: EUR %5.2f, nächste Rechnung\n",$b/100 unless $r->{'flags'}{'quiet'};
				} else {
					print STDERR "$kid/".name_kunde($kid).": Kein Betrag.\n" unless $r->{'flags'}{'quiet'};
				}
				Do("update kunde set skip = 'y' where id = $kid") if $id == 0 and $final == 1;
			};
			DoTransExit(1);
		} sub {
			DoTransExit(0);
			print STDERR "\n";

			my $err = report_fehler(0,"$kid:".name_kunde($kid));
			$err =~ s/\n\.\.\.Stack-Dump\.\.\..*//m 
				if $err =~ /Dienst nicht berechenbar/;

			$errs .= "\n\n" if $errs ne "";
			$errs .= $err;
			print STDERR "\n";
		};
	} continue {
		print STDERR "\n" unless $id == 0 and $final == 1 and DoFn("select skip from kunde where id = $kid") eq "y" or ref $r and $r->{'flags'}{'quiet'};
		if(not defined $bla or $bla eq "") { # nix ausgegeben?
			if($ornr) {
				open(F3,">> $f3");
				print F3 "\n*** $kid *** ".name_kunde($kid)." *** keine Rechnung (war: $ornr) *** \n";
				close(F3);
			}
		}
		report_status(4|8, "$kid:".name_kunde($kid));
	}
	# nur nochmal ausgeben, wenn über alle Kunden
	print "*** Fehlermeldungen:\n\n$errs\n" if not $id and $errs ne "";

	if($final and not $id and $letzte) {
		print STDERR "\nFERTIG, von $erste bis $letzte.\n";
		my $rlid = DoSeq("rechnungslauf");
		Do("insert into rechlauf set id=$rlid, anfang=$erste,ende=$letzte, template=".($template || "NULL"));
		if($rlsock) {
			$rlsock->print("$rlid\n");
			print "Der RL-Dump $rlid wurde angestoßen. Bitte abwarten und Kaffee trinken.\n";
			DoTransExit(1);

			while(<$rlsock>) {
				chomp;
				if($_ eq "OK") {
					print "... OK.\n";
					last;
				} elsif($_ eq "BAD") {
					print "NICHT OK\n";
				} else {
					print "$_\n";
				}
			}
		}
	} elsif($final and not $id) { ## $letzte nicht gesetzt == keine Rechnung
		return problem "Keine Rechnung generiert. rddump vergessen?";
	}
	if(($flg&(512|16)) == 16) {
		if(-s $f3) {
			line_printer(1);

			open(F3,"< $f3");
			while(<F3>) {
				print $Db::pr_fh $_;
			}
			close(F3);
			line_print_end();
		} else {
			print STDERR "... keine Unterschiede gefunden.\n";
		}
		unlink($f3);
	}
	$f3;
}

1;
