view release on metacpan or  search on metacpan

lib/Net/CIDR.pm  view on Meta::CPAN

sub _push_ipv6_octets {
    my $ary_ref=shift;
    my $octets=shift;

    if ( ($#{$octets} % 2) == 0)	# Odd number of octets
    {
	foreach (0 .. 255)
	{
	    push @$octets, $_;
	    _push_ipv6_octets($ary_ref, $octets);
	    pop @$octets;
	}
	return;
    }

    my $i;
    my $s="";

    for ($i=0; $i <= $#{$octets}; $i += 2)
    {
	$s .= ":" if $s ne "";
	$s .= sprintf("%02x%02x", $$octets[$i], $$octets[$i+1]);
    }
    push @$ary_ref, $s;
}

=pod

=head2 @cidr_list=Net::CIDR::cidradd($block, @cidr_list);

The cidradd() functions allows a CIDR list to be built one CIDR netblock
at a time, merging adjacent and overlapping ranges.
$block is a single netblock, expressed as either "start-finish", or
"address/prefix".
Example:

    @cidr_list=Net::CIDR::range2cidr("192.168.0.0-192.168.0.255");
    @cidr_list=Net::CIDR::cidradd("10.0.0.0/8", @cidr_list);
    @cidr_list=Net::CIDR::cidradd("192.168.1.0-192.168.1.255", @cidr_list);

The result is a two-element array: ("10.0.0.0/8", "192.168.0.0/23").
IPv6 addresses are handled in an analogous fashion.

=cut

sub cidradd {
    my @cidr=@_;

    my $ip=shift @cidr;

    $ip="$ip-$ip" unless $ip =~ /[-\/]/;

    unshift @cidr, $ip;

    @cidr=cidr2range(@cidr);

    my @a;
    my @b;

    grep {
	croak "This doesn't look like start-end\n" unless /(.*)-(.*)/;
	push @a, $1;
	push @b, $2;
    } @cidr;

    my $lo=shift @a;
    my $hi=shift @b;

    my $i;

    for ($i=0; $i <= $#a; $i++)
    {
	last if _ipcmp($lo, $hi) > 0;

	next if _ipcmp($b[$i], $lo) < 0;
	next if _ipcmp($hi, $a[$i]) < 0;

	if (_ipcmp($a[$i],$lo) <= 0 && _ipcmp($hi, $b[$i]) <= 0)
	{
	    $lo=_add1($hi);
	    last;
	}

	if (_ipcmp($a[$i],$lo) <= 0)
	{
	    $lo=_add1($b[$i]);
	    next;
	}

	if (_ipcmp($hi, $b[$i]) <= 0)
	{
	    $hi=_sub1($a[$i]);
	    next;
	}

	$a[$i]=undef;
	$b[$i]=undef;
    }

    unless ((! defined $lo) || (! defined $hi) || _ipcmp($lo, $hi) > 0)
    {
	push @a, $lo;
	push @b, $hi;
    }

    @cidr=();

    @a=grep ( (defined $_), @a);
    @b=grep ( (defined $_), @b);

    for ($i=0; $i <= $#a; $i++)
    {
	push @cidr, "$a[$i]-$b[$i]";
    }

    @cidr=sort {
	$a =~ /(.*)-/;

	my $c=$1;

	$b =~ /(.*)-/;