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              
3 4     4   14 use strict;
  4         14  
  4         90  
4 4     4   13 use warnings;
  4         5  
  4         127  
5              
6             our $VERSION = '0.22';
7              
8 4     4   14 use Carp qw( confess );
  4         4  
  4         149  
9 4     4   12 use Math::Int128 qw( net_to_uint128 uint128_to_net );
  4         6  
  4         157  
10 4     4   1847 use Socket qw( AF_INET AF_INET6 inet_pton inet_ntop );
  4         9928  
  4         543  
11 4     4   19 use Scalar::Util qw( blessed );
  4         2  
  4         142  
12              
13 4     4   13 use Exporter qw( import );
  4         3  
  4         924  
14              
15             our @EXPORT_OK = qw(
16             _string_address_to_integer
17             _integer_address_to_binary
18             _binary_address_to_string
19             _integer_address_to_string
20             _validate_ip_string
21             );
22              
23             ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
24             sub _string_address_to_integer {
25 900     900   787 my $string = shift;
26 900         621 my $version = shift;
27              
28 900 100       2735 my $binary = inet_pton( $version == 4 ? AF_INET : AF_INET6, $string )
    100          
29             or return;
30              
31 882 100       4512 return $version == 4
32             ? unpack( N => $binary )
33             : net_to_uint128($binary);
34             }
35              
36             sub _integer_address_to_binary {
37 2736     2736   2236 my $integer = shift;
38              
39 2736 100 66     11119 if ( ref $integer && blessed $integer) {
40 2259         5065 return uint128_to_net($integer);
41             }
42             else {
43 477         1316 return pack( N => $integer );
44             }
45             }
46              
47             sub _binary_address_to_string {
48 2736     2736   2437 my $binary = shift;
49              
50 2736 100       3821 my $family = length($binary) == 4 ? AF_INET : AF_INET6;
51              
52 2736         9786 my $string = inet_ntop( $family, $binary );
53 2736 100       39250 return $string eq '::' ? '::0' : $string;
54             }
55              
56             sub _integer_address_to_string {
57 2736     2736   54179 _binary_address_to_string( _integer_address_to_binary( $_[0] ) );
58             }
59              
60             sub _validate_ip_string {
61 84     84   86 my $str = shift;
62 84         63 my $version = shift;
63              
64 84 100       107 my $str_val = defined $str ? $str : 'undef';
65 84 100       102 if ( $version == 4 ) {
66 7 50 66     1301 confess("$str_val is not a valid IPv4 address")
67             unless defined $str && defined inet_pton( AF_INET, $str );
68             }
69             else {
70 77 100 100     2394 confess("$str_val is not a valid IPv6 address")
71             unless defined $str && defined inet_pton( AF_INET6, $str );
72             }
73             }
74              
75             1;
76              
77             # ABSTRACT: Utility subroutines for Net-Works
78              
79             __END__