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

use Dbase::Globals qw(bignum content def_or_minus list_descr mpersinfo);
use Dbase::Help qw(Do DoFn DoSelect qquote);
use Fehler qw(problem warnung);
use Loader qw(
	check_monitoring_person
	check_person_braucht_nicht
	line_in
	list_person_domains
	log_update
	personenliste
  );

sub set_person_email($;$) {
	my($pers,$kn) = @_;
	my $old = DoFn("SELECT email FROM person WHERE id = $pers")
	  and check_monitoring_person($pers);
	content ( my $mail = line_in "E-Mail-Adr.: " ) or return;
	if($mail eq "-") {
		return warnung 'Was willst Du denn löschen, wenn hier schon vorher nix eingetragen war?!'
			unless defined $old;
		return unless check_person_braucht_nicht( $pers, 'email' );
		log_update("person","id",$pers,undef,"email",undef,
			def_or_minus($old));
		Do("update person set email=NULL where id=$pers");
	} else {
		return warnung 'Genau diese E-Mail-Adresse ist hier doch eh schon eingetragen!?'
			if defined $old and $old eq $mail;
		unless($ENV{TESTING2}) {
			require Email::Valid;
			my $v = new Email::Valid;
			if ( my $address = $v->address($mail) ) {
				$v->mx( $mail = $address )
					or warnung 'Für diese Domain existiert kein MX- oder A-Record im DNS.';
			} else {
				return problem 'Das ist keine gültige E-Mail-Adresse.'
			}
		}

		if( my $person_id = DoFn( 'SELECT person FROM mailassoc WHERE email = ' . ( my $qqmail = qquote($mail) ) ) ) {
			return problem( "Diese E-Mail-Adresse ist bereits bei Person #$person_id:"
			                . mpersinfo($person_id)
			                . ' assoziiert.'
			              );
		}
		else {
			my @personen;
			DoSelect { push @personen, \@_ } <<_;
	SELECT   id, kunde
	FROM     person
	WHERE    email = $qqmail AND id != $pers
	ORDER BY person.id
_
			warnung( "\nDiese Adresse ist auch bei folgende"
			         . ( @personen == 1 ? 'r Person' : 'n Personen' )
			         . " eingetragen:\n\n"
			         . personenliste(@personen)
			       )
			  if @personen;
		}

		if ( defined( my $queue = DoFn <<_ ) ) {
	SELECT name FROM queue WHERE email = ${\qquote $mail}
_
			return problem <<_;
Diese Mail-Adresse gehört der RT-Queue "$queue"
und kann hier daher nicht eingetragen werden.
_
		}

		{
			my($flags, $problem);
			list_descr 'pwdomain', undef, 'mail', sub {
				defined( $flags ||= DoFn("SELECT pwuse FROM person WHERE id=$pers") )
					or return problem "Kann die Flags fuer diese Person nicht ermitteln!?\n";
				(undef, my $flag_id, my $flag_name) = @_;
				my $flag_mask = bignum(1)<<$flag_id;
				if ( $flags & $flag_mask and defined( my $person_id = DoFn <<_ ) ) {
	SELECT person.id
	FROM   person
	WHERE  person.email = ${\qquote $mail}
	   AND person.pwuse & $flag_mask
	   AND person.id != $pers
_
			$problem .= <<_;
Diese Mail-Adresse kann hier nicht eingetragen werden,
da Person #$person_id dieselbe Adresse und auch ein $flag_name-Flag hat.
_
				}
			};
			return problem $problem if $problem;
		}

		log_update("person","id",$pers,undef,"email",undef,
			def_or_minus(DoFn("select email from person where id=$pers")));
		Do("update person set email=${\qquote $mail,1} where id=$pers");
	}

	list_person_domains $pers, $kn, 2;
}

1;
