File Coverage

blib/lib/Net/CIDR/Set/IPv4.pm

Criterion	Covered	Total	%
statement	55	55	100.0
branch	30	34	88.2
condition	10	11	90.9
subroutine	14	14	100.0
pod	0	4	0.0
total	109	118	92.3

package Net::CIDR::Set::IPv4;

use warnings;
use strict;
use Carp;

use namespace::autoclean;

# ABSTRACT: Encode / decode IPv4 addresses

our $VERSION = '0.22';

sub new { bless \my $x, shift }

my $DEC = "(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})";
my $IP  = "(?:${DEC}\.){3}${DEC}";

sub _pack {
  my @nums = split /[.]/, shift, -1;
  return unless @nums == 4;
  for ( @nums ) {
    return unless /\A${DEC}\z/ and !/\A0[1-9]+/;
  }
  return pack "CC*", 0, @nums;
}

sub _unpack { join ".", unpack "xC*", shift }

sub _width2bits {
  my ( $width, $size ) = @_;
  return pack 'B*',
   ( '1' x ( $width + 8 ) ) . ( '0' x ( $size - $width ) );
}

sub _ip2bits {
  my $ip = shift or return;
  vec( $ip, 0, 8 ) = 255;
  my $bits = unpack 'B*', $ip;
  return unless $bits =~ /\A1*0*\z/;    # Valid mask?
  return $ip;
}

sub _is_cidr {
  my ( $lo, $hi ) = @_;
  my $mask = ~( $lo ^ $hi );
  my $bits = unpack 'B*', $mask;
  return unless $hi eq ($lo | $hi);
  return unless $bits =~ /\A(1*)0*\z/;
  return length( $1 ) - 8;
}

sub _encode {
  my ( $self, $ip ) = @_;
  if ( $ip =~ m{\A(${IP})/((?:3[0-2]|[12]?[0-9])|${IP})\z} ) {
    my $mask = $2;
    return unless my $addr = _pack( $1 );
    return
     unless my $bits
       = ( $mask =~ /\A[0-9]+\z/ )
      ? _width2bits( $mask, 32 )
      : _ip2bits( _pack( $mask ) );
    return ( $addr & $bits, Net::CIDR::Set::_inc( $addr | ~$bits ) );
  }
  elsif ( $ip =~ m{\A(${IP})-(${IP})\z} ) {
    return unless my $lo = _pack( $1 );
    return unless my $hi = _pack( $2 );
    return ( $lo, Net::CIDR::Set::_inc( $hi ) );
  }
  elsif ( $ip =~ m{\A${IP}\z} ) {
    return $self->_encode( "$ip/32" );
  }
  else {
    return;
  }
}

sub encode {
  my ( $self, $ip ) = @_;
  my @r = $self->_encode( $ip )
   or croak "Can't decode $ip as an IPv4 address";
  return @r;
}

sub decode {
  my $self    = shift;
  my $lo      = shift;
  my $hi      = Net::CIDR::Set::_dec( shift );
  my $generic = shift || 0;
  if ( $generic < 1 && $lo eq $hi ) {
    # Single address
    return _unpack( $lo );
  }
  elsif ( $generic < 2 && defined( my $w = _is_cidr( $lo, $hi ) ) ) {
    # Valid CIDR range
    return join '/', _unpack( $lo ), $w;
  }
  else {
    # General range
    return join '-', _unpack( $lo ), _unpack( $hi );
  }
}

sub nbits { 32 }

1;

__END__