use utf8;
use warnings; no warnings "redefine";
use strict;
use Dbase::Help qw(Do DoFn DoSelect qquote);
use Dbase::Globals qw(aufzaehlung content def_or_minus mpersinfo);
use Fehler qw(report_status warnung);
use Loader qw(log_update list_person_domains get_adresse line_in);

sub set_person_adresse($;$) {
	my($pers,$kn) = @_;
	
	{
		my @hardware;
		DoSelect { push @hardware, @_ } "SELECT id FROM hardware WHERE standort = $pers";
		warnung 'Diese Person ist als Standort bei '
		  . ( @hardware == 1 ? " Hardware-Objekt @hardware" : 'den Hardware-Objekten ' . aufzaehlung @hardware )
		  . " eingetragen.\n"
		  . ( @hardware == 1 ? 'Ist das' : 'Sind die' )
		  . ' wirklich umgezogen?'
		  if @hardware;
	}
	DoSelect {
		warnung qq(Diese Person ist als Standort fürs RZ "@_" eingetragen.\nIst das wirklich umgezogen?);
	} "SELECT name FROM rz WHERE standort = $pers";

	report_status;

	my $oadrid = DoFn("select adresse from person where id=$pers");
	my @personen;

	if ($oadrid) {
		DoSelect { push @personen, shift } <<_;
	SELECT id FROM person WHERE adresse = $oadrid AND id != $pers
_
		if(@personen) {
		    print 'Diese Adresse ist auch bei folgende'
		             . ( @personen == 1 ? 'r Person' : 'n Personen' )
		             . " eingetragen:\n"
		             . (join "\n", map sprintf('#%5d: %s', $_, mpersinfo($_)), @personen)
					 . "\n\n";
		}
	}

	my $adrid = get_adresse($kn);
	return unless defined $adrid;
	if($adrid eq "-") {
		$adrid="NULL";
		@personen = ();
	}
	if(@personen) {
		my $x = line_in 'Soll die Adresse bei de' . ( @personen == 1 ? 'r anderen Person' : 'n anderen Personen' ) . ' ebenfalls geändert werden?';
		if ( $x !~ /^j/i ) {
			@personen = ();
			print "OK, dann nur hier.\n";
		}
	}

	for ( $pers, @personen ) {
		printf "Ändere #$_:" . mpersinfo($_) . ".\n" if @personen > 1;
		log_update( person => id => $pers, undef, adresse => undef, def_or_minus($oadrid) );
		Do("UPDATE person SET adresse = $adrid WHERE id = $_");
		list_person_domains( $pers, $kn, 2 );
		report_status();
	}
}

1;
