#!/usr/bin/perl -w

use utf8;
use warnings; no warnings "redefine";
use strict;
use Loader qw(line_in list_domains log_view
	add_kunde_domain valid_domain edit_domain);
use Fehler qw(report_fehler);
use Dbase::Globals qw(
  find_descr
  get_gruppen
  get_ipkunde
  get_kunde
  list_descr
  puny_encode
  unterkunden
);
use Dbase::Help qw(DoFn DoSelect in_list qquote);
use Dbase::IP;
use Fehler qw(problem);

# Flag: 1: Return mit einer Domain
#       4: '-' wird akzeptiert

my %suche = (

	d => sub {
		my ( $name, $mode, $not ) = @_;
		if ( $mode eq '?' ) {
			return problem('Die Namenssuche funktioniert nicht für IDNs.')
			  if puny_encode($name) ne $name;
			$name = "%$name" if $name !~ /^%/;
			$name .= '%' if $name !~ /%$/;
		}
		"domainkunde.domain$not LIKE " . qquote($name);
	},

	f  => sub {
		my ( $grs, $grc ) = get_gruppen( domainflags => $_[0], 1 ) or return;
		"(flags & $grs = $grs AND flags & $grc = 0)";
	},

	i => 'infotext',

	ns => sub {
		my ( $nserver, $mode, $not ) = @_;
		return "domainkunde.nserver IS$not NULL" unless length $nserver;
		unless ( Dbase::IP->new($nserver) ) {
			my @ids;
			if ( $mode eq '?' ) {
				$nserver = "%$nserver" if $nserver !~ /^%/;
				$nserver .= '%' if $nserver !~ /%$/;
			}
			DoSelect { push @ids, @_ } <<_;
	SELECT id
	FROM   ipkunde
	WHERE  name$not LIKE ${\ qquote($nserver) }
	   AND ( ende IS NULL OR ende >= UNIX_TIMESTAMP(NOW()) )
_
			if (@ids) { in_list( 'domainkunde.nserver', '', @ids ) }
			else { 'NULL' }
		}
		elsif ( defined( my $id = get_ipkunde( $nserver, 2 ) ) ) {
			'domainkunde.nserver ' . ( $not && '!' ) . "= $id";
		}
		elsif ($not) { 1 }
		else         { 'NULL' }
	},

	S => sub {
		my ( $statusgroup_list, $mode, $not ) = @_;
		my @status;
		list_descr(
			'domainstatus',
			0,
			$statusgroup_list,
			sub {
				my ( $name, $id ) = @_;
				push @status, $id;
			}
		);
		if (@status) { in_list( 'domainkunde.status', $not, @status ) }
		elsif ($not) { 1 }
		else         { 'NULL' }
	},

	s => sub {
		my ( $status_list, $mode, $not ) = @_;
		in_list( 'domainkunde.status', $not,
			map find_descr( domainstatus => $_, 1 ),
			split /,/, $status_list );
	},

	sr => sub {
		my ( $nic_list, $mode, $not ) = @_;
		in_list( 'domainkunde.nic', $not, map find_descr( nic => $_, 1 ),
			split /,/, $nic_list );
	},
);

sub edit_domains($;$$) {
	my($id,$flag,$kn) = @_;

	my $act;
	domain: while(1) {

		$act = line_in( "$kn Domain >", $flag & 1 ? 0 : 4 );
		$act = '' unless defined $act;
		$act =~ s/^\s+//;
		$act =~ s/\s+\z//;
		last if $act eq '';

		( $act, my @select ) = split ' ', $act;
		for (@select) {
			unless (s/^(!)?(${\ join '|', keys %suche })([?:])\s*//o) {
				problem("Unbekannte Suchmethode: $_");
				next domain;
			}
			elsif ( ref $suche{$2} ) {
				defined( $_ = $suche{$2}->( $_, $3, defined $1 && ' NOT' ) )
				  or next domain;
			}
			else {
				if ( $3 eq '?' ) {
					$_ = "%$_" unless /^%/;
					$_ .= '%' unless /%$/;
				}
				$_ = "domainkunde.$suche{$1}"
				  . (
					length()
					? ( defined $1 && ' NOT' ) . " LIKE ${\ qquote($_) }"
					: 'IS' . ( defined $3 && ' NOT' ) . ' NULL'
				  );
			}
		}

		if($act eq "?") {
			print <<'END';
l    auflisten                            *l  ... auch Domains von Unterkunden
L    auflisten (auch beendete Domains)    *L  ... auch Domains von Unterkunden

Bei den o.g. Funktionen können jeweils zusätzlich beliebig viele mit
Whitespace getrennte Suchargumente übergeben werden und funktionieren
ggf. als Filter:

d:...   Domains, deren Name zur SQL-Wildcard "..." passt
d?...   Domains, in deren Name "..." vorkommt
Beachte: Die Namenssuche funktioniert leider nicht für IDNs.
f:...   Domains mit den angegebenen Flags, z. B. "l f:expurgate,!no_mailrelay"
i:...   Domains, deren Infotext zur SQL-Wildcard "..." passt
i?...   Domains, in deren Infotext "..." vorkommt
ns:...  Domains, die den DNS-Server "..." haben;
        die Auswahl kann über den (in der Datenbank eingetragenen) FQDN
        oder die IP-Adresse erfolgen
S:...   Domains, deren Status vom Typ ... ist (z. B. "l S:registriert")
s:...   Domains mit Status "..." (Bezeichnung oder numerisch)
        Mehrere Status können durch Kommata getrennt angegeben werden,
        also z. B. "l s:OK,OK_NIC,upd_OK"
sr:...  Domains mit NIC "..." (Bezeichnung oder numerisch)
        Mehrere NICs können durch Kommata getrennt angegeben werden,
        also z. B. "l sr:partnergate,chnic"

Durch Voranstellen eines "!" kann ein Filter negiert werden.

Beispiele:
* "*l !S:registriert" zeigt alle nicht als registriert geltenden Domains
  inkl. derer von Unterkunden
* "L !ns:" zeigt alle (auch inaktive) Domains, bei denen ein NameServer
   (= nicht kein NameServer) eingetragen ist
* "l sr:partnergate d:%.de" zeigt alle .de-Domains mit NIC PartnerGate

a    hinzufügen
aa   hinzufügen, Tarif "domain" automatisch anlegen
END
			print <<'END' if $flag & 4;
-    Domain disassoziieren
END
			print <<'END';
?p   Liste aller Domainstatus anzeigen
END
			
			if($flag & 1) {
				print <<'END';
###  Domain aufrufen
NAME Domain aufrufen
?### Domain editieren

END
			} else {
				print <<'END';
###  Domain editieren
NAME Domain editieren

END
			}
			next;
		}
		if($act eq "-") {
			return $act if $flag & 4;
			print "???\n";
			next;
		}
		if($act eq "?p") { print list_descr("domainstatus",1)."\n"; next; }
		if ( $act =~ /^ (\*)? ([lL]) \z /ix ) {
			list_domains( ($1 && $id) ? [ unterkunden($id) ] : $id, $2 eq 'L', @select );
			next;
		}
		if($act eq "H") { log_view($kn,"domainkunde"); next; }
		if($act eq "a" or $act eq "aa") {
			my $kunde_id = $id;
			until ($kunde_id) {
				length( my $kunde = line_in 'Kunde      > ' ) or return;
				$kunde_id = get_kunde $kunde and last;
				print
				  qq(Kunde "$kunde" ist mit nicht bekannt; bitte versuch's nochmal:\n);
			}
			my $ret = add_kunde_domain($kunde_id, ($act eq "aa")?1:0, $kn);
			return $ret if $flag & 1 and $ret > 0;
			next;
		}
		my $force = ($act =~ s/^\?//) && $flag&1;
		if($act =~ /.\../) {
			$act=puny_encode($act,2);
			# bevorzugt die aktive Domain,
			# ansonsten bevorzugt eine zum Kunden passende,
			# davon ggf. die neueste
			if ( my $dom = DoFn(<<_1 . ($id?"kunde = $id DESC,":'') . <<_2) ) { $act = $dom }
	SELECT   id
	FROM     domainkunde
	WHERE    domain = ${\ qquote($act) }
	ORDER BY ende IS NULL OR ende > UNIX_TIMESTAMP(NOW()) DESC,
_1
	         beginn                                       DESC
	LIMIT    1
_2
		}
		if($act =~ /^D?(\d+)$/) { 
			$act = $1;
			next unless valid_domain($act, not $force);
			return $act if $flag&1 and not $force;
			edit_domain($act,$id,$kn);
			next;
		}
		if($act =~ /.\../) {
			print "Domain '$act' unbekannt.\n";
		} else {
			print "Aktion '$act' unbekannt.\n";
		}
		next; fehler: report_fehler(4);
	}
	undef;
}
1;
