#!/usr/bin/perl -w

use utf8;
use strict;
use warnings;

BEGIN {
    unshift( @INC, ( $ENV{POPHOME} || '@POPHOME@' ) . '/lib' )
      unless $ENV{'KUNDE_NO_PERLPATH'};
}

use Dbase::Getopt qw(:DEFAULT getopt_kunde);
use Dbase::Globals qw(get_person get_kunde unterkunden kpersinfo
		sdaterange name_dienst rund);
use Dbase::Help qw(
  :readonly
  DoFn
  DoSelect
  DoTime
  isodate
  isotime
  qquote
  unixdate
);
use Loader qw(current_user);
use Date::Calc qw(Today Add_Delta_YM);

sub betrag($) {
    my ($betrag) = @_;
    ( $betrag = sprintf '%.2f', ($betrag/1000) ) =~ y/./,/;
    $betrag;
}

my ($Jahr) = Today;
my @Kunden;
GetOptions(
	'debug|D'           => \my $Debug,
	'jahr|year|j|y=i'   => \$Jahr,
	'kunde|k=s'         => sub { push @Kunden, &getopt_kunde },
	'limit|l=i'         => \( my $Limit = -1 ),
	'monate|anzahl|n=i' => \( my $Monate = 3 * 12 ),
	'monat|month|m=i'   => \( my $Monat = 1 ),
	'unterkunden|uk|u'  => \my $Unterkunden,
	'vertrieb|v:s'      => \my $Vertrieb,
);

my $gesamtsumme = 0;

my $k_ende = "(kunde.ende is null or kunde.ende > ".unixdate($Jahr,$Monat,1).")";
my $k_sel = @Kunden ? "and ( kunde.id=".join(" or kunde.id =", ($Unterkunden ? map { unterkunden($_) } @Kunden : @Kunden))." )" : "";
my $uk_sel = $Unterkunden ? "" : "and kunde.kunde is null";

if(not defined $Vertrieb) { # nach IDs
	DoSelect \&proc, <<_;
	SELECT    kunde.id, kunde.name, person.user
	FROM      kunde
	LEFT JOIN person ON kunde.ap_vertrieb = person.id
	WHERE     $k_ende $k_sel $uk_sel
	ORDER BY  kunde.id
_
} elsif($Vertrieb eq "") { # nach vertrieblichem Ansprechpartner
	DoSelect \&proc, <<_;
	SELECT    kunde.id, kunde.name, person.user
	FROM      kunde
	LEFT JOIN person ON kunde.ap_vertrieb = person.id
	WHERE     $k_ende $k_sel $uk_sel
	ORDER BY  person.user, kunde.id
_
} else { # nur dieser Vertriebler
	my ( $v, $vn );
	if ( $Vertrieb eq '-' ) {
		$v  = 'IS NULL';
		$vn = '-';
	}
	else {
		$v  = get_person($Vertrieb) or die "Die Person '$Vertrieb' kenne ich nicht.\n";
		$vn = kpersinfo($v);
		$v  = "= $v";
	}
	DoSelect \&proc, <<_;
        SELECT   kunde.id, kunde.name, ${\ qquote($vn) }
	FROM     kunde
        WHERE    kunde.ap_vertrieb $v AND $k_ende $k_sel $uk_sel
	ORDER BY kunde.id
_
}

my %tdef; # Name => Dienst => [ [ start, Grundpreis ]... ]
my %mecker;
sub tkunden($)  {
	my($tnid) = @_;
	my @ret;
	DoSelect {
		push(@ret,$_[0]);
	} "select kunde from tarifklasse where tarifname=$tnid";
	@ret;
}
sub tpreis($$$$$$$$$) {
	my($kid,$tnid,$tarif,$dienst,$tm,$beginn,$ende,$ablauf,$nextrech) = @_;
	my($j,$m,$d)=isodate $tm;
	my($aj,$am,$ad)=isodate $ablauf;
	my($ej,$em,$ed)=($j,$m,$d); do { $ej++;$em=1; } if ++$em >12;
	my($tt,$td);
	my $tkid = DoFn("select id from tarifklasse where tarifname=$tnid and kunde=$kid")
		|| DoFn("select id from tarifklasse where tarifname=$tnid and kunde is null");
	unless($tkid) {
		print STDERR "Kunde #$kid: Tarif $tarif gibt es nur bei Kunden #".join(",",tkunden($tnid))."!\n"
			unless $mecker{"$tnid/$kid"}++;
		return 0;
	}

	unless(defined ($tt = $tdef{$tkid})) {
		$tdef{$tkid} = $tt = {};
	}

	unless(defined ($td = $tt->{$dienst})) {
		$tt->{$dienst} = $td = [];
		my $last_beg = 0;
		DoSelect {
			my($beg,$fpr,$int) = @_;
			return if $last_beg == $beg; $last_beg = $beg;
			push(@$td, [$beg,$fpr,$int]);
		} "select beginn,festpreis,intval from tarif where klasse=$tkid and dienst=$dienst order by beginn desc,mini,unitmini";
	}
	my @t = @$td;
	$nextrech ||= $beginn;
	while(@t) {
		next if $t[0][0] > $tm;

		my $int = $t[0][2];
		my $val = $t[0][1];

		return 0 if $int eq "e" and ((isodate($beginn))[1] != $m
		                          or (isodate($beginn))[0] != $j);
		return 0 if $int eq "y" and (isodate($nextrech))[1] != $m;
		return 0 if $int eq "q" and ((isodate($nextrech))[1] - $m) %3;

		if(defined $ablauf) {
			my($dj,$dm) = (0,1);
			($dj,$dm) = (0,3) if $int eq "q";
			($dj,$dm) = (1,0) if $int eq "y";

			my($cj,$cm,$cd) = Add_Delta_YM($j,$m,$d,$dj,$dm);
			my $c = unixdate($cj,$cm,$cd);

			return 0 if $ablauf < $c;
		}

		my($aj,$am,$at) = isodate $beginn;
		my($bj,$bm,$bt) = isodate $ende;
		if(defined $aj and $aj == $j and $am == $m) {
			if($int eq "a") {
				$at=30 if $at==31;
				return rund($val * (1-($at/30)),-1);
			} else {
				return 0 if $at>15;
			}
		} elsif(defined $bj and $bj == $j and $bm == $m) {
			if($int eq "a") {
				$bt=30 if $bt==31;
				return rund($val * $bt/30, -1);
			} else {
				return 0 if $bt<=15;
			}
		}

		return $val;
	} continue {
		shift @t;
	}
	return 0;
}

our $hdr;
sub proc {
	my($kid,$kname,$v) = @_;
	$v="-" unless defined $v;
	unless($hdr++) {
		print "ID\tKunde\tAnspr.\tSumme";
		my($y,$m) = ($Jahr,$Monat);
		foreach my $i(0..$Monate-1) {
			printf "\t%04d-%02d",$y,$m;
			($y,$m) = Add_Delta_YM($y,$m,1,0,1);
		}
		print "\n";
	}

	my @summen;
	print "Kunde: #$kid:$kname\n" if $Debug;
	DoSelect {
		my($tid,$ukid,$tnid,$tarif,$dienst,$anzahl,$beginn,$ende,$ablauf,$nextrech) = @_;
		print "  Tarif $tid:$tarif/".name_dienst($dienst).": ".sdaterange($beginn,$ende)." X:".($ablauf ? scalar isotime $ablauf : "-")."\n" if $Debug and (not $ende or $ende>DoTime);
		my($y,$m) = ($Jahr,$Monat);
		my $tm = unixdate($y,$m,1);
		my $yn = $y;
		my $mn = $m;
		my $tmn = unixdate($yn,$mn,1);
		my $skip=0;
		foreach my $i(0..$Monate-1) {
			$tmn = unixdate($yn,$mn,1);
			($yn,$mn) = Add_Delta_YM($y,$m,1,0,1); 
			$skip++ if $tm < DoTime;
			next if $beginn > $tmn;
			last if $ende and $ende <= $tm;
			unless($ablauf) {
				last if $Limit >= 0 and $i-$skip >= $Limit;
			}
			my $betr = tpreis($ukid,$tnid,$tarif,$dienst,$tm,$beginn,$ende,$ablauf,$nextrech);
			next unless $betr;
			print "    in ".isodate($tm).": $betr\n" if $Debug;
			$summen[$i] += $betr;
		} continue {
			($y,$m,$tm) = ($yn,$mn,$tmn);
		}
	} "select tarifkunde.id,tarifkunde.kunde,tarifname.id,tarifname.name,tarifkunde.dienst,tarifkunde.anzahl,tarifkunde.beginn,tarifkunde.ende,tarifkunde.ablauf,tarifkunde.nextrech from tarifkunde,tarifname where tarifkunde.anzahl>0 and tarifname.id=tarifkunde.tarifname and " . ($Unterkunden ? "tarifkunde.kunde=$kid" : unterkunden($kid,"tarifkunde.kunde"));

	my $summe=0;
	foreach my $betrag(@summen) {
		$summe += $betrag if $betrag;
		# kann undef sein wenn zwischendrin Monate ohne Betrag sind
	}
	return unless $summe;
	$gesamtsumme += $summe;

	print "$kid\t$kname\t$v\t".betrag($summe);
	foreach my $betrag(@summen) {
		print "\t"; print $betrag ? betrag($betrag) : 0.0;
	}
	print "\n";
}
print "0\tSumme\t-\t",betrag($gesamtsumme),"\n";

__END__

=head1 NAME

umsatzplanung - erzeugt eine Liste mit garantiertem Umsatz

=head1 GEBRAUCH

	umsatzplanung

=head1 BESCHREIBUNG

Gibt eine (optional nach vertrieblichem Ansprechpartner und) nach
Kunden-IDs sortierte Liste aller Kunden und deren garantierten Umsatz
aus.

Bei Kunden(tarifen) ohne "wie lang läuft dieser Tarif mindestens noch"-Datum
kann die angenommene Zeitspanne bis zur Kündigung als Option angegeben
werden.

Wenn das Ende des Garantiezeitraums in der Mitte des Berechnungsintervalls
eines Tarifs liegt, wird dieses letzte Intervall B<nicht> berücksichtigt.

=head1 OPTIONEN

=over 4

=item --monate=36

=item --anzahl=36

=item -n 36

begrenzt die Ausgabe auf max. die nächsten 36 (Default) Monate.

=item --limit=0

=item -l 0

gibt an, wie lang Kundentarife berücksichtigt werden sollen, für die
kein Ablaufdatum in der Datenbank eingetragen ist.

0 = gar nicht, Default: über den gesamten Zeitraum.

Die Berücksichtigung dieser Zeitspanne startet ab dem aktuellen Datum.

=item --monat=1

=item --month=1

=item -m 1

gibt an, dass die Liste im Januar (Default) starten soll.

=item --jahr=2006

=item --year=2006

=item -j 2006

=item -y 2006

gibt an, dass die Liste im angegebenen Jahr starten soll.

Default: Das aktuelle Jahr.

=item --vertrieb=PERSON

=item -v=PERSON

um die Liste auf diesen Vertriebsmenschen zu beschränken;
C<-v -> für Kunden ohne vertrieblichen Ansprechpartner

=item --vertrieb

=item -v

um nach Vertriebler zu sortieren

=item --unterkunden

=item --uk

=item -u

um Unterkunden einzeln aufzulisten; ansonsten werden sie dem Hauptkunden
dazugeschlagen.

=item --help

=item -?

um (nur) diese Dokumentation anzeigen zu lassen

=back

=head1 BEKANNTE FEHLER

Rabatte werden nicht beachtet, vgl. RT#274785-102.

=head1 AUTOR

 Matthias Urlichs <smurf@noris.net>
 für die noris network AG
 RT#233827

=cut

