File Coverage

blib/lib/Net/DHCP/Packet/IPv4Utils.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	6	6	100.0
condition	11	12	91.6
subroutine	13	13	100.0
pod	6	6	100.0
total	72	73	98.6

#!/bin/false
# PODNAME: Net::DHCP::Packet::IPv4Utils
# Author : D. Hamstead
# Original Author: F. van Dun, S. Hadinger
# ABSTRACT: Object methods for IPv4 in Net::DHCP
use strict;
use warnings;
use 5.8.0;

package Net::DHCP::Packet::IPv4Utils;
$Net::DHCP::Packet::IPv4Utils::VERSION = '0.7_007'; # TRIAL

$Net::DHCP::Packet::IPv4Utils::VERSION = '0.7007';# standard module declaration
our ( @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
use Exporter;
@ISA       = qw(Exporter);
@EXPORT    = qw( ); # FIXME this is rude
@EXPORT_OK = qw( packinet packinets unpackinet unpackinets packinets_array unpackinets_array );
%EXPORT_TAGS = ( all => \@EXPORT_OK );

use Carp;

#=======================================================================
# never failing versions of the "Socket" module functions
sub packinet {    # bullet-proof version, never complains
    use bytes;
    my $addr = shift;

    if ( $addr && $addr =~ m/(\d+)\.(\d+)\.(\d+)\.(\d+)/ ) {
        return chr($1) . chr($2) . chr($3) . chr($4);
    }

    return "\0\0\0\0"
}

sub unpackinet {    # bullet-proof version, never complains
    use bytes;
    my $ip = shift;
    return '0.0.0.0' unless ( $ip && length($ip) == 4 );
    return
        ord( substr( $ip, 0, 1 ) ) . q|.|
      . ord( substr( $ip, 1, 1 ) ) . q|.|
      . ord( substr( $ip, 2, 1 ) ) . q|.|
      . ord( substr( $ip, 3, 1 ) );
}

sub packinets {     # multiple ip addresses, space delimited
    return join(
        q(), map { packinet($_) }
          split( /[\s\/,;]+/, shift || 0 )
    );
}

sub unpackinets {    # multiple ip addresses
    return join( q| |, map { unpackinet($_) } unpack( '(a4)*', shift || 0 ) );
}

sub packinets_array {    # multiple ip addresses, space delimited
    return unless @_;
    return join( q(), map { packinet($_) } @_ );
}

sub unpackinets_array {    # multiple ip addresses, returns an array
    return map { unpackinet($_) } unpack( '(a4)*', shift || 0 );
}

#=======================================================================

1;

__END__