File Coverage

blib/lib/Net/Works/Util.pm
Criterion Covered Total %
statement 40 40 100.0
branch 19 20 95.0
condition 7 9 77.7
subroutine 12 12 100.0
pod n/a
total 78 81 96.3


line stmt bran cond sub pod time code
1             package Net::Works::Util;
2             $Net::Works::Util::VERSION = '0.20';
3 4     4   15 use strict;
  4         5  
  4         121  
4 4     4   14 use warnings;
  4         4  
  4         89  
5              
6 4     4   13 use Carp qw( confess );
  4         10  
  4         184  
7 4     4   24 use Math::Int128 qw( net_to_uint128 uint128_to_net );
  4         5  
  4         175  
8 4     4   2188 use Socket qw( AF_INET AF_INET6 inet_pton inet_ntop );
  4         13855  
  4         748  
9 4     4   23 use Scalar::Util qw( blessed );
  4         6  
  4         181  
10              
11 4     4   18 use Exporter qw( import );
  4         5  
  4         1094  
12              
13             our @EXPORT_OK = qw(
14             _string_address_to_integer
15             _integer_address_to_binary
16             _binary_address_to_string
17             _integer_address_to_string
18             _validate_ip_string
19             );
20              
21             sub _string_address_to_integer {
22 888     888   1020 my $string = shift;
23 888         754 my $version = shift;
24              
25 888 100       3481 my $binary = inet_pton( $version == 4 ? AF_INET : AF_INET6, $string )
    100          
26             or return;
27              
28 870 100       5583 return $version == 4
29             ? unpack( N => $binary )
30             : net_to_uint128($binary);
31             }
32              
33             sub _integer_address_to_binary {
34 2730     2730   2799 my $integer = shift;
35              
36 2730 100 66     12646 if ( ref $integer && blessed $integer) {
37 2255         6195 return uint128_to_net($integer);
38             }
39             else {
40 475         1550 return pack( N => $integer );
41             }
42             }
43              
44             sub _binary_address_to_string {
45 2730     2730   3006 my $binary = shift;
46              
47 2730 100       4661 my $family = length($binary) == 4 ? AF_INET : AF_INET6;
48              
49 2730         12221 my $string = inet_ntop( $family, $binary );
50 2730 100       50284 return $string eq '::' ? '::0' : $string;
51             }
52              
53             sub _integer_address_to_string {
54 2730     2730   66444 _binary_address_to_string( _integer_address_to_binary( $_[0] ) );
55             }
56              
57             sub _validate_ip_string {
58 84     84   84 my $str = shift;
59 84         135 my $version = shift;
60              
61 84 100       136 my $str_val = defined $str ? $str : 'undef';
62 84 100       128 if ( $version == 4 ) {
63 7 50 66     1803 confess("$str_val is not a valid IPv4 address")
64             unless defined $str && defined inet_pton( AF_INET, $str );
65             }
66             else {
67 77 100 100     2682 confess("$str_val is not a valid IPv6 address")
68             unless defined $str && defined inet_pton( AF_INET6, $str );
69             }
70             }
71              
72             1;
73              
74             # ABSTRACT: Utility subroutines for Net-Works
75              
76             __END__