package IPv4;

###########################################################################
# Calculate IP Version 4 Address
# Rolf Rost, 18.5.2011
###########################################################################


use strict;
use warnings;
use Net::Ping;
use overload '++' => \&increase, '--' => \&decrease;

# IP, NUM ++/--, increase, decrease ######### OVERLOAD ####################
sub increase{
	my $self = shift;

	my $num = $self->{NUM};
	if($num < 0xFFFFFFFF){
		$num++;
	}
	else{
		$num = 0;
	}
	
	my $ip = _num2ip($num);
	my $masknum = _ip2num($self->{MASK});
	my $masklen = _num2masklen($masknum);
	
	# neues Objekt erstellen
	my $ipo = ref($self)->new("$ip/$masklen");
	
	# self-Attribute werden komplett überschrieben
	%{$self} = (%{$self}, %{$ipo});
}

sub decrease{
	my $self = shift;

	my $num = $self->{NUM};
	if($num > 0){
		$num--;
	}
	else{
		$num = 0xFFFFFFFF;
	}
	my $ip = _num2ip($num);
	my $masknum = _ip2num($self->{MASK});
	my $masklen = _num2masklen($masknum);
	
	# neues Objekt erstellen
	my $ipo = ref($self)->new("$ip/$masklen");
	
	# self-Attribute werden komplett überschrieben
	%{$self} = (%{$self}, %{$ipo});
}

####################### Public Methods ####################################
# Einfaches IP-Objekt erstellen, Konstruktor
sub new{
	my $class = shift;
	my $cidr  = shift;

	my $self = bless { 
		VALID   => 0, 
		ERR     => '',
		NUM     => '',
		IP      => '',
		MASK    => '',
		NETADDR => '',
		BCADDR  => '',
	}, $class;

	if(!$cidr){
		$self->{VALID} = 0;
		$self->{ERR} = "Keine IP/CIDR like '0.0.0.0/0' angegeben";
		return $self;
	}


	my ($ip, $masklen) = split(/\//, $cidr);
	if(not defined $masklen){
		$self->{VALID} = 0;
		$self->{ERR} = 'Keine Maske angegeben';
		return $self;
	}
	if($masklen !~ /^\d+$/){
		$self->{VALID} = 0;
		$self->{ERR} = 'Maske nicht numerisch';
		return $self;
	}
	if($masklen > 32){
		$self->{VALID} = 0;
		$self->{ERR} = "Maske muss kleiner 32 sein";
		return $self;
	}

	my @octs = split /\./, $ip;
	# each octet must be a number!!!
	foreach my $o(@octs){
		if($o !~ /^\d+$/){ 
			$self->{ERR} = "IP-Adresse nicht korrekt";
			$self->{VALID} = 0;
			return $self;
		}
	}

	# IP numerisch
	my $num = _ip2num($ip);

	# zum Prüfen einmal hin und zurück rechnen
	my $hip = _num2ip($num);
	if($ip ne $hip){
		$self->{ERR} = "IP-Adresse nicht korrekt";
		$self->{VALID} = 0;
		return $self;
	}

	$self->{NUM}     = $num;
	$self->{IP}      = $ip;
	$self->{MASK}    = _num2ip(_masklen2num($masklen));
	$self->{NETADDR} = _num2ip(_masklen2num($masklen) & $num);
	$self->{BCADDR}  = _num2ip($num |~ _masklen2num($masklen));
	$self->{VALID}   = 1;

	return $self;
}

# Anzahl der Hosts, count hosts
sub hosts{
	my $self = shift;
	# single host
	return 1 if $self->{MASK} eq '255.255.255.255';
	my $fst = _ip2num($self->{NETADDR});
	my $last = _ip2num($self->{BCADDR});
	my $hosts = $last - $fst - 1;
	return $hosts;
}

# das nächste höhere Netz, net above
sub nextnet{
	my $self = shift;

	if($self->{MASK} eq '0.0.0.0'){
		return $self->clone;
	}
	elsif($self->{BCADDR} eq '255.255.255.255'){
		return $self->firstnet;
	}
	else{
		my $masknum = _ip2num($self->{MASK});
		my $masklen = _num2masklen($masknum);
	
		my $num = _ip2num($self->{BCADDR});
		$num++;
		my $addr = _num2ip($num);
	
		# object clone
		my $ipo = ref($self)->new("$addr/$masklen");
		return $ipo;
	}
}

# das darunter liegende Netz, net below
sub prevnet{
	my $self = shift;
	
	if($self->{MASK} eq '0.0.0.0'){
		return $self->clone;
	}
	elsif($self->{NETADDR} eq '0.0.0.0'){
		return $self->lastnet;
	}
	else{
		my $masknum = _ip2num($self->{MASK});
		my $masklen = _num2masklen($masknum);
		
		my $num = _ip2num($self->{NETADDR});
		$num--;
		my $addr = _num2ip($num);
		
		# object clone
		my $ipo = ref($self)->new("$addr/$masklen");
		return $ipo;
	}
}

# das letzte Netz im IP-Range
sub lastnet{
	my $self = shift;
	my $masknum = _ip2num($self->{MASK});
	my $masklen = _num2masklen($masknum);
	my $ipo = ref($self)->new("255.255.255.254/$masklen");
	return $ipo;	
}

# das erste Netz im IP-Range
sub firstnet{
	my $self = shift;
	my $masknum = _ip2num($self->{MASK});
	my $masklen = _num2masklen($masknum);
	my $ipo = ref($self)->new("0.0.0.1/$masklen");
	return $ipo;	
}

# Clone Object
sub clone{
	my $self = shift;
	my $masknum = _ip2num($self->{MASK});
	my $masklen = _num2masklen($masknum);
	# object clone
	my $ipo = ref($self)->new("$self->{IP}/$masklen");
	return $ipo;
}

# zum Testen des IP-Objekts, monitoring
sub dump{
	my $self = shift;
	printf "IP: %s\nNUM: %s\nMASK: %s\nNETADDR: %s\nBCADDR: %s\nVALID: %s\n\n", 
		$self->{IP}, $self->{NUM}, $self->{MASK}, $self->{NETADDR}, $self->{BCADDR}, $self->{VALID};
}

# Delegate Net::Ping::ping
sub ping{
	my $self = shift;
	# create Ping-Attribut on demand
	if(not exists $self->{PING}){
		$self->{PING} = Net::Ping->new('icmp');		
	}
	return $self->{PING}->ping($self->{IP}, @_);
}

# for monitoring
sub getip{return shift->{IP};}

# assign an new netmask, syntax '0.0.0.0'
sub newmask{
	my $self = shift;
	my $mask = shift or do{
		$self->{ERR} = "Keine neue Maske angegeben";
		$self->{VALID} = 0;
		return;
	};

	my @octs = split(/\./, $mask, 4);
	if(scalar @octs != 4){
		$self->{ERR} = 'Anzahl der Oktetten nicht korrekt';
		$self->{VALID} = 0;
		return;
	}
	# each octet must be a number!!!
	foreach my $o(@octs){
		if($o !~ /^\d+$/){ 
			$self->{ERR} = "Oktetten nicht korrekt";
			$self->{VALID} = 0;
			return;
		}
	}

	# Mask numerisch
	my $num = _ip2num($mask);
	my $masklen = _num2masklen($num);
	if($masklen == -1){
		$self->{ERR} = "Maske nicht korrekt";
		$self->{VALID} = 0;
		return;
	}

	my $ipo = ref($self)->new("$self->{IP}/$masklen");
	%{$self} = (%{$self}, %{$ipo});
	return 1;
}

# Neue Maskenlänge
sub newmasklen{
	my $self = shift;
	my $len = shift;

	# Netaddr und BCaddr vom ursprünglichen Netz sichern
	# und die original Maskenlänge
	my $ip0 = $self->{NETADDR};
	my $ip1 = $self->{BCADDR};
	my $masklen = _num2masklen(_ip2num($self->{MASK}));
	
	if(not defined $len){
		$self->{ERR} = 'Keine neue Maske angegeben';
		$self->{VALID} = 0;
		return;
	}
	elsif($len !~ /^\d+$/){
		$self->{ERR} = 'Neue Maske nicht numerisch';
		$self->{VALID} = 0;
		return;
	}
	elsif($len > 32){
		$self->{ERR} = 'Maske nicht zwischen 0 und 32';
		$self->{VALID} = 0;
		return;
	}
	else{
		my $ipo = ref($self)->new("$self->{IP}/$len");
		%{$self} = (%{$self}, %{$ipo});
		
		# je nach neuer Masklen die Rückgabe
		if($len > $masklen){
			# das Netz wurde geteilt
			# erzeuge das kleinste und größte Netz aus dem
			# Subnet-Bereich
			my $sub0 = ref($self)->new("$ip0/$len");
			my $sub1 = ref($self)->new("$ip1/$len");
			my $n = 2**($len-$masklen); # Anzahl der Subnetze
			return($sub0, $sub1, $n);
		}		
		else{
			# das Netz wurde vergrößert, keine Subnetze
			# erzeuge zwei Netze mit der kleineren(original) Masklen
			my $sub0 = ref($self)->new("$ipo->{NETADDR}/$masklen");
			my $sub1 = ref($self)->new("$ipo->{BCADDR}/$masklen");
			return($sub0, $sub1, 0);
		}
	}	
}

# HashRef zum Netz zurückgeben
sub refnet{
	my $self = shift;
	return {
		NETADDR => $self->{NETADDR},
		BCADDR  => $self->{BCADDR},
		MASK    => $self->{MASK},
		IP      => $self->{IP},
		MASKLEN => _num2masklen(_ip2num($self->{MASK})),
		HOSTS   => $self->hosts,
	};
}


# Fehlerbehandlung
sub valid{ return shift->{VALID}}
sub errstr{ return shift->{ERR}}

# geplant: Berechnen der Default Class

############################ Private Methods ##############################
sub _masklen2num{
	my $masklen = shift;
	if($masklen == 0){ return 0;}
	else{ return(0xffffFFFF <<(32 - $masklen));}
}

sub _num2masklen{
	my $n = shift;
	
	my $bit = 0;
	my $masklen = 0;
	my $merk = 0;
	my $changes = 0;
	# Beim Durchgehen durch die Bits darf es max nur einen Wechsel geben

	for(my $i = 0; $i < 32; $i++){
		$bit = ($n >> $i) & 1;
		if($i == 0){ $merk = $bit; }

		if($bit != $merk){
			# Wechsel
			$changes++;
			$merk = $bit;
		}

		if($bit){$masklen++;}
	}

	if($changes <= 1){ return $masklen ;}
	else{ return -1; } # Maske ist nicht gueltig
}

sub _num2ip{ 
	my $num = shift;
	return join(".", unpack("CCCC", pack("N", $num)));
}

sub _ip2num{
	my $ip = shift;
	unpack "N", pack("CCCC", split /\./, $ip);
}
1;#########################################################################