view release on metacpan or  search on metacpan

lib/Net/IPAddress/Util.pm  view on Meta::CPAN

      0, 0, 0, 0,
      @siit_prefix,
      unpack('C4', pack('N', $address))
    ];
  }
  elsif ("$address" =~ $normalish) {
    my $fresh = $1;
    eval "require Math::BigInt" or return ERROR("Could not load Math::BigInt: $@");
    my $raw = Math::BigInt->from_hex("$fresh");
    while ($raw > 0) {
      my $word = $raw->copy->band(0xffffffff);
      unshift @$normal, unpack('C4', pack('N', $word));
      $raw = $raw->copy->brsft(32);
    }
    while (@$normal < 16) {
      unshift @$normal, 0;
    }
    eval "no Math::BigInt";
  }
  elsif ($address =~ $numberish) {
    eval "require Math::BigInt" or return ERROR("Could not load Math::BigInt: $@");
    my $raw = Math::BigInt->new("$address");
    while ($raw > 0) {
      my $word = $raw->copy->band(0xffffffff);
      unshift @$normal, unpack('C4', pack('N', $word));
      $raw = $raw->copy->brsft(32);
    }
    while (@$normal < 16) {
      unshift @$normal, 0;
    }
    eval "no Math::BigInt";
  }
  elsif (
    $address =~ $sixish
    and (
      scalar(grep { /::/o } split(/[[:alnum:]]+/, $address)) == 1
      or scalar(grep { /[[:alnum:]]+/ } split(/:/, $address)) == 8
    )
  ) {
    # new() from IPv6 address, accepting and ignoring the Scope ID
    $address = $1;
    my ($lhs, $rhs) = split /::/, $address;
    $rhs = '' unless defined $rhs;
    my $hex = '0' x 32;
    $lhs = join '', map { substr('0000' . $_, -4) } split /:/, $lhs;
    $rhs = join '', map { substr('0000' . $_, -4) } split /:/, $rhs;
    substr($hex, 0,              length($lhs)) = $lhs;
    substr($hex, - length($rhs), length($rhs)) = $rhs;
    my @hex = split //, $hex;
    while (@hex) {
      push @$normal, hex(join('', splice(@hex, 0, 2)));
    }
  }
  elsif (length($address) == 16) {
    $normal = [ unpack('C16', $address) ];
  }
  else {
    return ERROR("Invalid argument `$address', a(n) " . (ref($address) || 'bare scalar') . ' provided');
  }
  # warn(join(',', @$normal) . "\n");
  return bless { address => pack('C16', @$normal), %opt } => $class;
}

sub is_ipv4 {
  my $self = shift;
  my @octets = unpack 'C16', $self->{ address };
  __debug(join(' ', map { sprintf('%3s', $_) } @octets));
  # my $is_siit = $self->{ SIIT } || 0;
  return 0 if grep { $_ } @octets[ 0 .. 7 ];
  return 1;
}

sub ipv4 {
  my $self = shift;
  return join '.', unpack 'C4', substr($self->{ address }, -4);
}

sub as_n32 {
  my $self = shift;
  return unpack 'N', substr($self->{ address }, -4);
}

sub as_n128 {
  my $self = shift;
  my ($keep) = @_;
  my $rv;
  {
    eval "require Math::BigInt" or return ERROR("Could not load Math::BigInt: $@");
    my $accum = Math::BigInt->from_hex($self->normal_form);
    eval "no Math::BigInt" unless $keep;
    $rv = $keep ? $accum : "$accum";
  }
  return $rv;
}

sub normal_form {
  my $self = shift;
  my @addr = unpack('C16', $self->{ address });
  splice(@addr, 8, 4, @{$SIIT[$self->{ SIIT }]}) if $self->is_ipv4;
  my $hex = join('', map { sprintf('%02x', $_) } @addr);
  $hex = substr(('0' x 32) . $hex, -32);
  return lc $hex;
}

sub ipv6_expanded {
  my $self = shift;
  my $hex = $self->normal_form();
  my $rv;
  while ($hex =~ /(....)/g) {
    $rv .= ':' if defined $rv;
    $rv .= $1;
  }
  return $rv;
}

sub ipv6 {
  my $self = shift;
  if ($self->is_ipv4()) {
    return $self->{ SIIT }
      ? '::ffff:0:' . $self->ipv4()
      : '::ffff:' . $self->ipv4()