use utf8;
use warnings; no warnings "redefine";
use strict;
use Loader qw(check_mailrules_auf_username edit_personen line_in list_person_domains log_update);
use Fehler qw(problem report_status warnung);
use Dbase::Globals qw(aufzaehlung name_kunde);
use Dbase::Help qw(DoFn Do DoSelect DoTrans);

sub delete_person(;$$) {
	my($pers,$kn) = @_;

	unless($pers) {
		$pers = edit_personen(1,1, "zu löschende Person");
		return unless $pers;
	}
    DoTrans {
	my $cnt;

	if ( my @adr = check_mailrules_auf_username($pers) ) {
		return problem "Die Person kann nicht gelöscht werden, solange folgende\nMail-Regel"
			               . (@adr != 1 && 'n')
			               . ' auf ihren Usernamen zeig'
			               . (@adr == 1 ? 't' : 'en')
			               . ":\n\t"
			               . join "\n\t", @adr;
	}

	{
		my @domains;
		DoSelect { push @domains, sprintf '#%d:%s', @_ } <<_;
	SELECT   id, domain
	FROM     domainkunde
	WHERE    $pers IN (owner,adminc,techc,billc,zonec)
	ORDER BY domain, id
_
		return problem( "Die Person kann nicht gelöscht werden,\nweil sie als Kontakt bei folgende" .
		                ( @domains == 1 ? 'r Domain' : 'n Domains' ) .
		                " eingetragen ist:\n" . aufzaehlung(@domains) )
			if @domains;
	}

	if($ENV{'TESTING2'}) {
		Do("update updatelog set person=1 where person = $pers");
	} else {
		$cnt = DoFn("select count(*) from updatelog where person = $pers");
		return problem "Person #$pers hat $cnt Änderungen vorgenommen." if $cnt;
	}
	$cnt = DoFn("select count(*) from ipassacct where person = $pers");
	return problem "Person #$pers ist in $cnt IPass-Accounting-Datensätzen der Owner" if $cnt;
	$cnt = DoFn("select count(*) from ipkunde where owner = $pers");
	return problem "Person #$pers ist in $cnt IP-Datensätzen der Owner" if $cnt;
	$cnt = DoFn("select count(*) from ipkunde where adminc = $pers");
	return problem "Person #$pers ist in $cnt IP-Datensätzen der Admin-C" if $cnt;
	$cnt = DoFn("select count(*) from ipkunde where techc = $pers");
	return problem "Person #$pers ist in $cnt IP-Datensätzen der Tech-C" if $cnt;

	$cnt = DoFn("select count(*) from kunde where hauptperson = $pers");
	return problem "Person #$pers ist in $cnt Kunden die Hauptperson" if $cnt;
	$cnt = DoFn("select count(*) from kunde where adminc = $pers");
	return problem "Person #$pers ist in $cnt Kunden der Admin-Kontakt" if $cnt;
	$cnt = DoFn("select count(*) from kunde where billc = $pers");
	return problem "Person #$pers ist in $cnt Kunden der Billing-Kontakt" if $cnt;

	$cnt = DoFn("select count(*) from domreg where techc = $pers");
	return problem "Person #$pers ist in $cnt Domaindefaults der Tech-C" if $cnt;
	$cnt = DoFn("select count(*) from domreg where zonec = $pers");
	return problem "Person #$pers ist in $cnt Domaindefaults der Zone-C" if $cnt;
	$cnt = DoFn("select count(*) from domreg where billc = $pers");
	return problem "Person #$pers ist in $cnt Domaindefaults der Bill-C" if $cnt;

	{
		my %ende;
		for (qw(a b)) {
			DoSelect { push @{$ende{$_}}, @_ }
			  "SELECT id FROM leitung WHERE ${_}_ende = $pers ORDER BY id";
		}
		return problem( 'Diese Person kann nicht gelöscht werden, da sie '
			        . join( ' und ',
		                        map "als \u$_-Ende bei de"
		                            . ( @{$ende{$_}} == 1 ? 'r Leitung' : 'n Leitungen' )
					    . ' '
		                            . aufzaehlung( map "#$_", @{$ende{$_}} ),
		                            sort keys %ende
		                      )
		                . ' eingetragen ist.' )
			if keys %ende;
				    
	}

	{
		my @wv;
		DoSelect { push @wv, @_ }
		  "SELECT id FROM wartungsvertrag WHERE ansprechpartner = $pers";
		return problem @wv == 1 ? "Diese Person ist Ansprechpartner für Wartungsvertrag #@wv."
		                        : 'Diese Person ist Ansprechpartner bei den Wartungsverträgen ' . aufzaehlung(@wv) . '.'
		  if @wv;
	}
	{
		my @ap;
		DoSelect {
			my ($kunde_id) = @_;
			push @ap, "#$kunde_id:" . name_kunde($kunde_id);
		} "SELECT id FROM kunde WHERE $pers IN (ap_technik, ap_vertrieb)";
		return problem( 'Diese Person ist als Ansprechpartner bei ' . aufzaehlung(@ap) . ' eingetragen.' )
		  if @ap;
	}
	{
		my $eigentuemer = '';
		DoSelect {
			my ($id, $name) = @_;
			$eigentuemer .= "#$id:$name\n";
		} "SELECT id, name FROM hardware WHERE eigentuemer = $pers";
		return problem( "Diese Person ist Eigentümer folgender Hardware:\n$eigentuemer" )
		  if $eigentuemer;
	}
	{
		my $standort = '';
		DoSelect {
			my ($id, $name) = @_;
			$standort .= "#$id:$name\n";
		} "SELECT id, name FROM hardware WHERE standort = $pers";
		return problem( "Diese Person ist Standort folgender Hardware:\n$standort" )
		  if $standort;
	}
	{
		my $verantwortlich = '';
		DoSelect {
			my ($id, $name) = @_;
			$verantwortlich .= "#$id:$name\n";
		} "SELECT id, name FROM hardware WHERE verantwortlich = $pers";
		return problem( "Diese Person ist verantwortlich für folgende Hardware:\n$verantwortlich" )
		  if $verantwortlich;
	}

	return problem <<_ if list_person_domains $pers, $kn;
Die Person kann nicht gelöscht werden,
solange sie bei den o.g. Domains eingetragen ist.
_

	if ( my $radacct =
		DoFn("SELECT COUNT(*) FROM radacct WHERE person = $pers") )
	{
		return problem(
			'Zu dieser Person gibt es '
			  . (
				$radacct == 1
				? 'einen Radius-Accounting-Datensatz'
				: "$radacct Radius-Accounting-Datensätze"
			  )
			  . ".\nSie kann daher nicht gelöscht werden."
		);
	}

	unless($ENV{"TESTING2"}) {
		warnung <<_;
Das Löschen von Personen kann diverse Nebenwirkungen haben, z. B. könnte das
Accounting durcheinanderkommen, vgl. etwa RT#180786-20 und RT#181052.

War das Objekt denn eine Fehleingabe oder nur zu Testzwecken angelegt?
Sonst möchtest Du der Person wahrscheinlich eigentlich nur ihre Flags klauen
und/oder sie disassoziieren. Vgl. auch RT#392297-4.
_
		report_status;
		{
			my $answer = line_in 'Soll die Person wirklich gelöscht werden? ';
			return unless $answer =~ /^[jy]/i;
		}
	}

	my $id = DoFn "SELECT kunde FROM person WHERE id = $pers";
	Do "UPDATE kunde SET geaendert = UNIX_TIMESTAMP(NOW()) WHERE id = $id" if $id > 0;
	log_update("person","kunde",$id,undef,"id","-",undef,$pers);
	log_update("kunde","id",$id,undef,"person","-",undef,$pers);
	Do("delete from pwhist where person=$pers");
	Do("delete from kundemail where person=$pers");
	Do("delete from mailassoc where person=$pers");
	Do("delete from ipmap where person=$pers");
	Do("delete from nic where person=$pers");
	Do("delete from ticketadr where person=$pers");
	Do("update ticket set bearbeiter=NULL where bearbeiter=$pers");
	Do("update ticketid set timestamp=timestamp, person=NULL where person=$pers");
	Do("update person set mperson=NULL where mperson=$pers");
	Do("update domainkunde set person=NULL where person=$pers");
	Do("update domainkunde set nachricht=NULL where nachricht=$pers");

	Do("delete from stunden where person=$pers");
	Do("delete from persomonat where person=$pers");
	Do("delete from perso where person=$pers");
	Do("update perso set vorgesetzter=NULL where vorgesetzter=$pers");

	Do("delete from queue_acl where person=$pers");
	Do("delete from resellernic where person=$pers");
	Do("delete from person where id=$pers");
    };
	return $pers;
}

1;
