use utf8;
use warnings; no warnings "redefine";
use strict;
use Loader qw(line_in log_update edit_ipaddr get_free_ip
	serve_ipnr_name get_free_ipaddr);
use Dbase::Help qw(DoSelect Do DoFn DoT qquote DoTime);
use Dbase::Globals qw(find_dienst oberkunden 
	get_descr addr_from_block content get_vrf);
use Dbase::IP;
use Fehler qw(problem report_fehler fehler warnung);

my $resolv;

# Flag&1: liefert die Adresse zurück, ohne einen Datensatz dafür anzulegen

sub add_kunde_ipaddr($$;$$$) {
	my($id,$kn,$flag,$ibits,$prompt) = @_;
	$flag ||= 0;
	$prompt = "Adresse" if not defined $prompt;

	my ($nm,$adr);
	ml: while(not $adr) {
		$adr = line_in "$prompt> ";
		return undef unless defined $adr and $adr ne "";
		if($adr eq "?") {
			print <<END;
10.23.45.67      IP-Adresse (auch IPv6)
10.23.45.60/30   IP-Subnetz (auch IPv6)
name!10.1.2.3    IPv4-Adresse aus dem VRF "name"
name!10.1.2.0/30 IPv4-Subnetz aus dem VRF "name"
bla              nächste freie Adresse aus Zone "bla" (Name oder Nummer OK)
bla/30           ein freies /30er-Subnetz aus Zone "bla" (dito)

Zonen für die automatische Belegung von freien Adressen:
END
			my $res = DoSelect {
				my($ii,$name,$info) = @_;
				$info = '' unless defined $info;
				printf "%5d %-15s %s\n",$ii,$name,$info;
			} "select id,zone,infotext from ipregion where kunde = 1 or ".oberkunden($id)." order by zone,id";

			print "_keine_\n" unless $res>0;
			$adr = undef; next;
		}

		my $bits;
		if(defined $ibits) {
			if ($adr =~ s#/(\d+)$##) {
				if ($1 == 32-$ibits or $1 == 128-$ibits) {
					# nimm an, es ist dasselbe
				} else {
					problem "Diese Adresslänge passt nicht zur Vorgabe!";
					next;
				}
			}
			$bits=0;
		} elsif($adr =~ s#/(\d+)$##) {
			$bits = $1;
		} else {
			$bits = undef;
		}

		my ($zone,$alloc, $uip);
		if($adr =~ /^\d+$/) {
			($zone,$alloc) = DoFn("select id,alloc from ipregion where id=$adr");
		} else {
			($zone,$alloc) = DoFn("select id,alloc from ipregion where zone=${\qquote $adr}");
		}
		if(not defined $bits) {
			my ($mx,$ad);
			if(defined $zone) {
				my($ubits);
				($uip,$ubits) = DoFn <<_;
select ipkunde.ip6,ipkunde.bits
  from ipkunde,ipregion
 where ipregion.id=$zone
   and ipkunde.id=ipregion.ipkunde
_
				$uip = Dbase::IP->new_db($uip,$ubits);
				if(defined $uip) {
					$mx = $uip->is_v4rf ? 32 : 128;
					$ad = $uip->is_v4rf ? 32 : ($uip->masklen >= 64) ? 128 : 64;
				}
			}

			$ad = "Host" if not defined $ad or $ad == $mx;
			$bits = line_in "Bits[$ad]: ";
			return undef unless defined $bits;
			if($bits) {
				return problem "Bitte eine Zahl..." if $bits !~ /^\d+$/;
				return problem "Das ist zu groß!" if defined $mx and $bits > $mx;
			}
			$bits=$ad if defined $mx and $bits eq "";
		}
		if(not defined $zone) {
			if($adr !~ /[:!]/ and DoFn("select count(*) from ipkunde where kunde=$id and vrf is not null")) {
				while(1) {
					my $vrf = line_in "VRF> ";
					last if not content $vrf or $vrf eq "-";
					if ($vrf eq "?") {
						print <<_;
-      kein VRF verwenden
l      Liste der VRFs des Kunden ausgeben
ll     Liste der VRFs aller Kunden ausgeben
name   VRF auswählen
###    VRF auswählen
_
						next;
					}
					if($vrf eq 'l') {
						list_vrfs($id);
						next;
					}
					if($vrf eq 'll') {
						list_vrfss();
						next;
					}
					unless(get_vrf($vrf)) {
						print "Dieses VRF ist unbekannt.\n";
						next;
					}
					$adr = "$vrf!$adr";
					last;
				}
			}

			my $ad = Dbase::IP->new($adr);
			defined $ad or return problem('Das ist keine gültige IP-Adresse.');
			if(defined $ibits) {
				$adr = $ad->bitmask($ibits,2);
			} elsif($bits) {
				if($ad->is_v4rf and $bits <= 32) {
					$adr = $ad->bitmask(32-$bits,2);
				} else {
					$adr = $ad->bitmask(128-$bits,2);
				}
			} else {
				$adr = $ad;
			}
		} else {
			my @frar;
			my @fnum;
			if(defined $ibits) {
				$bits=$ibits;
			} elsif(not $bits or $bits eq "Host") {
				$bits=0;
			} elsif(defined $uip) {
				$bits=(($uip->is_v4rf and $bits <= 32) ? 32 : 128) - $bits;
			} elsif($alloc>32) {
				$bits=128-$bits;
			} else {
				$bits=32-$bits;
			}
			# Diese Heuristik funktioniert, weil automatische Allokation
			# von IPv6-Adressen wegen der Adressstruktur bei 64 anfängt.

			DoSelect {
				my($id) = @_;
				return if $frar[$bits];
				get_free_ip($id,@fnum,@frar);
			} "select id from ipkunde where ipkunde.ipregion = $zone";
			$adr = addr_from_block($bits,@frar);
			unless($adr) {
				@frar=();
				my($block,$bbits,$knd) = DoFn("select ipkunde,alloc,kunde from ipregion where id = $zone");
				return problem "Kein freier Block im Bereich gefunden.","Dieser Bereich kann nicht automatisch erweitert werden." unless $block;
				get_free_ip($block,@fnum,@frar);

				if($bbits <= $bits) { # belege direkt
					$adr = addr_from_block($bits,@frar);
					print "\n*** Neuer Adressblock ***\n\nDie neue Adresse wird direkt zugeteilt:";
				} else { # belege indirekt
					$adr = addr_from_block($bbits,@frar);
					return problem "Kein freier Block im Bereich gefunden.","Die automatische Erweiterung schlug fehl -- nix mehr frei!\n" unless $adr;

					my $idn = get_free_ipaddr($adr,$knd);
					print "\n*** Neuer Adressblock ***\n\nAus diesem Block wird die neue Adresse belegt.\n\nEditiere zunächst den neuen Adressblock (z. B. Netzname):\n";
					Do("update ipkunde set ipregion = $zone where id = $idn");
					$idn = edit_ipaddr($idn,$id,$kn);
					$adr=undef,next unless $idn;
					@frar = ();
					get_free_ip($idn,@fnum,@frar);
					$adr = addr_from_block($bits,@frar);
					print "Editiere nun die neu belegte Adresse:\n";
				}
			}
			last ml;
		}
		next;
	fehler:
		report_fehler;
		$adr = undef;
	}
	return problem "Keine freien Adressen gefunden.\n" unless $adr;
	return $adr if $flag&1;

	my $idi = get_free_ipaddr($adr,$id);

	serve_ipnr_name($idi) if defined $idi and not $adr->db_bits;

	$idi = edit_ipaddr($idi,$id,$kn) if defined $idi;
	return $idi;

	fehler: report_fehler; undef;
}

1;
