File Coverage

blib/lib/Net/IP/Minimal.pm

Criterion	Covered	Total	%
statement	36	49	73.4
branch	20	34	58.8
condition	9	21	42.8
subroutine	5	5	100.0
pod	3	3	100.0
total	73	112	65.1

package Net::IP::Minimal;
{
  $Net::IP::Minimal::VERSION = '0.06';
}

#ABSTRACT: Minimal functions from Net::IP

use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(ip_get_version ip_is_ipv4 ip_is_ipv6);
our %EXPORT_TAGS = ( 'PROC' => [ @EXPORT_OK ] );

sub ip_get_version {
    my $ip = shift;

    # If the address does not contain any ':', maybe it's IPv4
    $ip !~ /:/ and ip_is_ipv4($ip) and return '4';

    # Is it IPv6 ?
    ip_is_ipv6($ip) and return '6';

    return;
}

sub ip_is_ipv4 {
    my $ip = shift;

    # Check for invalid chars
    unless ($ip =~ m/^[\d\.]+$/) {
        return 0;
    }

    if ($ip =~ m/^\./) {
        return 0;
    }

    if ($ip =~ m/\.$/) {
        return 0;
    }

    # Single Numbers are considered to be IPv4
    if ($ip =~ m/^(\d+)$/ and $1 < 256) { return 1 }

    # Count quads
    my $n = ($ip =~ tr/\./\./);

    # IPv4 must have from 1 to 4 quads
    unless ($n >= 0 and $n < 4) {
        return 0;
    }

    # Check for empty quads
    if ($ip =~ m/\.\./) {
        return 0;
    }

    foreach (split /\./, $ip) {

        # Check for invalid quads
        unless ($_ >= 0 and $_ < 256) {
            return 0;
        }
    }
    return 1;
}

sub ip_is_ipv6 {
    my $ip = shift;

    # Count octets
    my $n = ($ip =~ tr/:/:/);
    return 0 unless ($n > 0 and $n < 8);

    # $k is a counter
    my $k;

    foreach (split /:/, $ip) {
        $k++;

        # Empty octet ?
        next if ($_ eq '');

        # Normal v6 octet ?
        next if (/^[a-f\d]{1,4}$/i);

        # Last octet - is it IPv4 ?
        if ( ($k == $n + 1) && ip_is_ipv4($_) ) {
            $n++; # ipv4 is two octets
            next;
        }

        return 0;
    }

    # Does the IP address start with : ?
    if ($ip =~ m/^:[^:]/) {
        return 0;
    }

    # Does the IP address finish with : ?
    if ($ip =~ m/[^:]:$/) {
        return 0;
    }

    # Does the IP address have more than one '::' pattern ?
    if ($ip =~ s/:(?=:)/:/g > 1) {
        return 0;
    }

    # number of octets
    if ($n != 7 && $ip !~ /::/) {
        return 0;
    }

    # valid IPv6 address
    return 1;
}

qq[IP freely];

__END__