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;#########################################################################