File Coverage

blib/lib/Net/IPAddress/Util/Range.pm

Criterion	Covered	Total	%
statement	95	107	88.7
branch	21	30	70.0
condition	6	12	50.0
subroutine	12	16	75.0
pod	10	10	100.0
total	144	175	82.2

package Net::IPAddress::Util::Range;

use strict;
use warnings;
use 5.012;

use overload (
  '""' => 'as_string',
  '<=>' => '_spaceship',
  'cmp' => '_spaceship',
);

use Net::IPAddress::Util qw( :constr :manip );
require Net::IPAddress::Util::Collection;

our $VERSION = '5.000';

sub new {
  my $class = shift;
  $class = ref($class) || $class;
  my ($arg_ref) = @_;
  my ($l, $u);
  if ($arg_ref->{ lower } && $arg_ref->{ upper }) {
    $arg_ref->{ lower } = IP($arg_ref->{ lower });
    $arg_ref->{ upper } = IP($arg_ref->{ upper });
    if ($arg_ref->{ lower } > $arg_ref->{ upper }) {
      ($arg_ref->{ lower }, $arg_ref->{ upper }) = ($arg_ref->{ upper }, $arg_ref->{ lower });
    }
    return bless $arg_ref => $class;
  }
  elsif ($arg_ref->{ ip }) {
    my $ip;
    my $nm = 2;
    if ($arg_ref->{ netmask }) {
      $ip = IP($arg_ref->{ ip      });
      my $was_ipv4 = $ip->is_ipv4;
      $nm = IP($arg_ref->{ netmask });
      $ip &= $nm;
      $nm = ~$nm;
      if ($was_ipv4) {
        $nm &= ipv4_mask();
      }
      $l = $ip;
      $u = $ip | $nm;
    }
    elsif ($arg_ref->{ ip } =~ m{(.*?)/(\d+)}) {
      my ($t, $cidr) = ($1, $2);
      $ip = IP($t);
      my $was_ipv4 = $ip->is_ipv4;
      my $span
        = ($was_ipv4
        ? 32
        : 128) - $cidr
        ;
      $nm = implode_ip(substr(('1' x 128) . ('0' x $span), -128));
      $ip &= $nm;
      $l = $ip;
      $u = $ip | ~$nm;
    }
    elsif ($arg_ref->{ cidr }) {
      $ip = IP($arg_ref->{ ip });
      my $was_ipv4 = $ip->is_ipv4;
      my $cidr = $arg_ref->{ cidr };
      my $span
        = ($was_ipv4
        ? 32
        : 128) - $cidr
        ;
      $nm = implode_ip(substr(('1' x 128) . ('0' x $span), -128));
      $ip &= $nm;
      $l = $ip;
      $u = $ip | ~$nm;
    }
    else {
      $l = IP($arg_ref->{ ip });
      $u = IP($arg_ref->{ ip });
    }
  }
  return bless { lower => $l, upper => $u } => $class;
}

sub as_string {
  my $self = shift;
  return "($self->{ lower } .. $self->{ upper })";
}

sub outer_bounds {
  my $self = shift;
  my @l = explode_ip($self->{ lower });
  my @u = explode_ip($self->{ upper });
  my @cidr = common_prefix(@l, @u);
  my $cidr = scalar @cidr;
  my $base = implode_ip(ip_pad_prefix(@cidr));
  if ($base->is_ipv4()) {
    $cidr -= 96;
  }
  my @mask = prefix_mask(@l, @u);
  my $nm = implode_ip(ip_pad_prefix(@mask));
  my $x = ~$nm;
  if ($base->is_ipv4()) {
    $nm &= ipv4_mask();
  }
  my $hi = IP($base);
  $hi |= $x;
  return bless {
    lower   => $base,
    cidr    => $cidr,
    netmask => $nm,
    upper   => $hi,
  } => ref($self);
}

sub inner_bounds {
  my $self = shift;
  return $self if $self->{ upper } == $self->{ lower };
  my $bounds = $self->outer_bounds();
  my $new = ref($self)->new($self);
  while ($bounds->{ upper } > $self->{ upper } or $bounds->{ lower } < $self->{ lower }) {
    $new = ref($self)->new({ ip => $self->{ lower }, cidr => $bounds->{ cidr } + 1 });
    $bounds = $new->outer_bounds();
  }
  return $new;
}

sub as_cidr {
  my $self = shift;
  my $hr = $self->outer_bounds();
  return "$hr->{ lower }" . '/' . "$hr->{ cidr }";
}

sub as_netmask {
  my $self = shift;
  my $hr = $self->outer_bounds();
  return "$hr->{ lower }" . ' (' . "$hr->{ netmask }" . ')';
}

sub loose {
  my $self = shift;
  my $hr = $self->outer_bounds();
  return ref($self)->new({ lower => $hr->{ lower }, upper => $hr->{ upper } });
}

sub _spaceship {
  my ($self, $rhs, $swapped) = @_;
  ($self, $rhs) = ($rhs, $self) if $swapped;
  $rhs = ref($self)->new({ ip => $rhs }) unless ref($self) eq ref($rhs);
  return
    $self->{ lower } <=> $rhs->{ lower }
    || $self->{ upper } <=> $rhs->{ upper }
    ;
}

sub tight {
  my $self = shift;
  my $inner = $self->inner_bounds();
  my $rv = Net::IPAddress::Util::Collection->new();
  push @$rv, $inner;
  if ($inner->{ upper } < $self->{ upper }) {
    my $remainder = ref($self)->new({ lower => $inner->{ upper } + 1, upper => $self->{ upper } });
    push @$rv, @{$remainder->tight()};
  }
  return $rv;
}

sub lower {
  my $self = shift;
  return $self->{ lower };
}

sub upper {
  my $self = shift;
  return $self->{ upper };
}

1;

__END__