package Net::CIDR::Lite;

use strict;
use vars qw($VERSION $DEBUG);
use Carp qw(confess);

$VERSION = '0.02';

my %masks;
my @fields = qw(PACK UNPACK NBITS ZERO MASKS);

# Preloaded methods go here.

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    bless {}, $class;
}

sub add {
    my $self = shift;
    my ($ip, $mask) = split "/", shift;
    $self->_init($ip) || confess "Can't determine ip format" unless %$self;
    my $start = $self->{PACK}->($ip) & $self->{MASKS}[$mask]
        or confess "Bad ip address: $ip";
    my $end = _add_bit($start, $mask);
    ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
    --$$self{RANGES}{$end}   || delete $$self{RANGES}{$end};
}

sub clean {
    my $self = shift;
    my $ranges = $$self{RANGES};
    my $total;
    $$self{RANGES} = {
      map { $total ? ($total+=$$ranges{$_})? () : ($_=>1)
                   : do { $total+=$$ranges{$_}; ($_=>-1) }
          } sort keys %$ranges
    };
}

sub list {
    my $self = shift;
    my $nbits = $$self{NBITS};
    my ($start, $total);
    my @results;
    for my $ip (sort keys %{$$self{RANGES}}) {
        $start = $ip unless $total;
        $total += $$self{RANGES}{$ip};
        unless ($total) {
            while ($start lt $ip) {
                my ($end, $bits);
                (my $zeros = unpack("B*", $start)) =~ s/.*1//;
                for my $mask ($nbits-length($zeros)..$nbits) {
                    $end = _add_bit($start, $mask) or next;
                    $bits = $mask, last if $end le $ip;
                }
                push @results, $self->{UNPACK}->($start) . "/$bits";
                $start = $end;
            }
        }
    }
    wantarray ? @results : \@results;
}

sub _init {
    my $self = shift;
    my $ip = shift;
    my ($nbits, $pack, $unpack);
    if (_pack_ipv4($ip)) {
        $nbits = 32;
        $pack = \&_pack_ipv4;
        $unpack = \&_unpack_ipv4;
    } elsif (_pack_ipv6($ip)) {
        $nbits = 128;
        $pack = \&_pack_ipv6;
        $unpack = \&_unpack_ipv6;
    } else {
        return;
    }
    $$self{PACK}  = $pack;
    $$self{UNPACK}  = $unpack;
    $$self{NBITS} = $nbits;
    $$self{ZERO}  = "0" x $nbits;
    $$self{MASKS} = $masks{$nbits} ||= [
      map { pack("B*", substr("1" x $_ . "0" x $nbits, 0, $nbits))
          } 0..$nbits
    ];
}

sub _pack_ipv4 {
    my @nums = split /\./, shift(), -1;
    return unless @nums == 4;
    for (@nums) {
        return unless /^\d{1,3}$/ and $_ <= 255;
    }
    pack("C*", @nums);
}

sub _unpack_ipv4 {
    join(".", unpack("C*", shift));
}

sub _pack_ipv6 {
    my $ip = shift;
    return if $ip =~ /^:/ and $ip !~ s/^::/:/;
    return if $ip =~ /:$/ and $ip !~ s/::$/:/;
    my @nums = split /:/, $ip, -1;
    return unless @nums <= 8;
    my ($empty, $ipv4, $str) = (0,'','');
    for (@nums) {
        return if $ipv4;
        $str .= "0" x (4-length) . $_, next if /^[a-fA-F\d]{1,4}$/;
        do { return if $empty++ }, $str .= "X", next if $_ eq '';
        next if $ipv4 = _pack_ipv4($_);
        return;
    }
    return if $ipv4 and @nums > 6;
    $str =~ s/X/"0" x (($ipv4 ? 25 : 33)-length($str))/e if $empty;
    pack("H*", $str).$ipv4;
}

sub _unpack_ipv6 {
    _compress_ipv6(join(":", (unpack("H*", shift)) =~ /..../g)),
}

sub _compress_ipv6 {
    my $ip = shift;
    if (my @runs = $ip =~ /((?:(?:^|:)(?:0000))+:?)/g ) {
        my $max = $runs[0];
        for (@runs[1..$#runs]) {
            $max = $_ if length($max) < length;
        }
        $ip =~ s/$max/::/;
    }
    $ip;
}

sub add_range {
    my $self = shift;
    local $_ = shift;
    my ($ip_start, $ip_end) = split "-";
    $self->_init($ip_start) || confess "Can't determine ip format"
      unless %$self;
    my $start = $self->{PACK}->($ip_start)
      or confess "Bad ip address: $ip_start";
    my $end = $self->{PACK}->($ip_end)
      or confess "Bad ip address: $ip_end";
    my $end = _add_bit($start, $$self{NBITS});
    $$self{RANGES}{$start}++;
    $$self{RANGES}{$end}--;
}

sub add_cidr {
    my $self = shift;
    my $cidr = shift;
    unless (%$self) {
        @$self{@fields} = @$cidr{@fields};
    }
    $$self{RANGES}{$_} += $$cidr{RANGES}{$_} for keys %{$$cidr{RANGES}};
}

sub _add_bit {
    my ($start, $add) = @_;
    $add--;
    my $end = unpack("B*", $start);
    {
        if ($add < 0) {
            return "\xFF" x (length($start)+1) if $end eq "0" x length($end);
            return;
        }
        if (substr($end, $add, 1) eq "0") {
            substr($end, $add, 1) = "1";
            last;
        }
        substr($end, $add, 1) = "0";
        $add--;
        redo;
    }
    pack("B*", $end);
}

1;
__END__