use utf8;
use warnings; no warnings "redefine";
use strict;
use Cf '$UID_MINIMUM';
use Dbase::Globals qw(
  add_acct
  bignum
  content
  find_descr
  flag_names
  get_descr
  list_descr
);
use Dbase::Help qw(Do DoFn quote);
use Fehler qw(problem warnung);
use Loader qw( check_mailrules_auf_username current_user
               log_update set_person_userid select_flags
             );

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

	my $uid = DoFn "SELECT uid FROM person WHERE id = $pers";
	unless ( defined $uid ) {
		print "Erst die UserID setzen..:\n";
		content( $uid = set_person_userid( $pers, $kn ) ) or return;
	}
	my ( $ofl, $kunde, $redirect, $user ) =
	  DoFn("SELECT pwuse, kunde, redirect, user FROM person WHERE id = $pers");
	my $flag = select_flags($ofl,'pwdomain','Flags','!hide');
	return undef unless defined $flag;
	
	# beim Testen ist das nichtsetzendürfen von Flags eher hinderlich...
	unless(defined $ENV{'TESTING2'} and current_user() == $pers) {
		foreach my $f (qw(verwaltung rt_admin perso rechnung buchen)) {
			my $fl = bignum(1) << find_descr("pwdomain",$f);

			return problem "Du kannst das Flag '$f' nicht setzen.\n"
				if not $ofl & $fl and $flag & $fl and not $fl & DoFn("select pwuse from person where id=".current_user());
		}
	}

	{
		my %flag;
		$flag{$_} = bignum(1) << find_descr pwdomain => $_, 1 for qw(dialin ipass ppp);
		my @ofl = grep $ofl  & $flag{$_}, sort keys %flag;
		my @nfl = grep $flag & $flag{$_}, sort keys %flag;
		return problem 'Die Flags ' . join(' und ', @nfl) . " dürfen nicht gleichzeitig gesetzt sein,\n"
		  . 'da sie kollidierende (weil gleichnamige) radius-Accounts erzeugen würden.'
		  if "@ofl" ne "@nfl" && @nfl > 1;
	}

	{
		defined( my $mailflag = find_descr pwdomain=>'mail' )
		  or return problem 'In dieser Datenbank scheint es kein mail-Flag für Personen zu geben.';
		$mailflag = bignum(1)<<$mailflag;
		if ( $ofl & $mailflag && not $flag & $mailflag and my @adr = check_mailrules_auf_username($pers) ) {
			return problem "Das mail-Flag kann hier nicht gelöscht werden, solange folgende\nMail-Regel"
			               . (@adr != 1 && 'n')
			               . ' auf den Usernamen der Person zeig'
			               . (@adr == 1 ? 't' : 'en')
			               . ":\n\t"
			               . join "\n\t", @adr;
		}
		elsif ( $flag & $mailflag && not $ofl & $mailflag and not check_mailrules_auf_username($pers) ) {
			warnung(<<_);
Wahrscheinlich möchtest Du nun noch eine auf diesen User(namen)
zeigende MailRegel eintragen.
_
		}
	}

	{
		my($mail_addr, $problem);
		list_descr 'pwdomain', undef, 'mail', sub {
			(undef, my $flag_id, my $flag_name) = @_;
			my $flag_mask = bignum(1)<<$flag_id;
			return unless $flag & bignum(1)<<$flag_id;
			$mail_addr = DoFn <<_ || '' unless defined $mail_addr;
	SELECT email
	FROM   person
	WHERE  id = $pers
_
			return unless $mail_addr;
			if ( my $person_id = DoFn <<_ ) {
	SELECT person.id
	FROM   person
	WHERE  email = '${\quote $mail_addr}'
	   AND person.pwuse & $flag_mask
	   AND person.id != $pers
_
					$problem .= <<_
Hier darf kein $flag_name-Flag gesetzt sein,
da Person #$person_id dieselbe Mail-Adresse und bereits eines hat.
_
			}
		};
		return problem $problem if $problem;
	}

	if ( defined( my $flag_mysql = find_descr( pwdomain => 'mysql' ) ) ) {
		$flag_mysql = bignum(1) << $flag_mysql;
		if ( $flag & $flag_mysql && not $ofl & $flag_mysql
			and ( my $chars = length $user ) > 16 )
		{
			return problem(<<_);
Für diesen Benutzer kann keine MySQL-Datenbank angelegt werden,
weil sein Benutzername länger als 16 (nämlich $chars) Zeichen ist.
_
		}
	}

	if ( defined( my $flag_www = find_descr pwdomain => 'www' ) ) {
		$flag_www = bignum(1) << $flag_www;
		if ( $flag & $flag_www && not $ofl & $flag_www ) {
			warnung <<_ if $UID_MINIMUM && $uid < $UID_MINIMUM;
Das mit dem WebSpace wird wohl nicht klappen,
weil die UID der Person zu klein ist, vgl. RT#215417.
_
			warnung <<_ if defined $redirect;
Wahrscheinlich möchtest Du jetzt das bei dieser Person eingetragene HTTP-
Redirect-Ziel löschen, weil das durch das www-Flag nun eh ignoriert wird.
_
		}
	}

	{
		my $sfl = $ofl & (-1-$flag);
		Do "insert into pwhist set person=$pers, flag=$sfl" if $sfl; # löschen

		$sfl = $flag & (-1-$ofl);
		Do "insert into pwhist set person=$pers, flag=1+$sfl" if $sfl; # setzen

		my $ci = 0;
		while($sfl) {
			if($sfl & 1) { ## gesetzt
				my $nam = get_descr("pwdomain",$ci);
				$nam = find_descr("update",$nam) if defined $nam;
				if(defined $nam) {
					add_acct $kunde, update => $nam,0,0,0, 1,0, kpersinfo $pers if $nam;
					print "Accountingdatensatz 'update/$nam' angelegt.\n";
				}
			}
		} continue {
			$sfl >>= 1;
			$ci++;
		}
	}
	
	log_update("person","id",$pers,undef,"pwuse",undef,
		scalar flag_names($flag,"pwdomain", $ofl) );
	Do("update person set pwuse=$flag where id=$pers");
	$flag;
}

1;
