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


line stmt bran cond sub pod time code
1             #!/bin/false
2             # Net::DHCP::Packet::IPv4Utils.pm
3             # Author : D. Hamstead
4             # Original Author: F. van Dun, S. Hadinger
5 12     12   19382 use strict;
  12         88  
  12         274  
6 12     12   129 use warnings;
  12         19  
  12         280  
7 12     12   103 use 5.8.0;
  12         41  
8              
9             package Net::DHCP::Packet::IPv4Utils;
10             $Net::DHCP::Packet::IPv4Utils::VERSION = '0.7_004';
11             # standard module declaration
12             our ( @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
13 12     12   55 use Exporter;
  12         17  
  12         940  
14             @ISA = qw(Exporter);
15             @EXPORT = qw( ); # FIXME this is rude
16             @EXPORT_OK = qw( packinet packinets unpackinet unpackinets packinets_array unpackinets_array );
17             %EXPORT_TAGS = ( all => \@EXPORT_OK );
18              
19 12     12   49 use Carp;
  12         21  
  12         811  
20              
21             #=======================================================================
22             # never failing versions of the "Socket" module functions
23             sub packinet { # bullet-proof version, never complains
24 12     12   10220 use bytes;
  12         118  
  12         56  
25 51     51 1 96 my $addr = shift;
26              
27 51 100 100     317 if ( $addr && $addr =~ m/(\d+)\.(\d+)\.(\d+)\.(\d+)/ ) {
28 35         261 return chr($1) . chr($2) . chr($3) . chr($4);
29             }
30              
31 16         62 return "\0\0\0\0"
32             }
33              
34             sub unpackinet { # bullet-proof version, never complains
35 12     12   1438 use bytes;
  12         20  
  12         40  
36 44     44 1 72 my $ip = shift;
37 44 100 100     263 return '0.0.0.0' unless ( $ip && length($ip) == 4 );
38             return
39 32         222 ord( substr( $ip, 0, 1 ) ) . q|.|
40             . ord( substr( $ip, 1, 1 ) ) . q|.|
41             . ord( substr( $ip, 2, 1 ) ) . q|.|
42             . ord( substr( $ip, 3, 1 ) );
43             }
44              
45             sub packinets { # multiple ip addresses, space delimited
46             return join(
47 11   100 11 1 66 q(), map { packinet($_) }
  25         62  
48             split( /[\s\/,;]+/, shift || 0 )
49             );
50             }
51              
52             sub unpackinets { # multiple ip addresses
53 8   100 8 1 48 return join( q| |, map { unpackinet($_) } unpack( '(a4)*', shift || 0 ) );
  10         18  
54             }
55              
56             sub packinets_array { # multiple ip addresses, space delimited
57 11 100   11 1 592 return unless @_;
58 7         18 return join( q(), map { packinet($_) } @_ );
  11         23  
59             }
60              
61             sub unpackinets_array { # multiple ip addresses, returns an array
62 10   50 10 1 65 return map { unpackinet($_) } unpack( '(a4)*', shift || 0 );
  14         31  
63             }
64              
65             #=======================================================================
66              
67             1;
68              
69             =pod
70              
71             =head1 NAME
72              
73             Net::DHCP::Packet::IPv4Utils - Object methods for IPv4 in Net::DHCP
74              
75             =head1 VERSION
76              
77             version 0.7_004
78              
79             =head1 SYNOPSIS
80              
81             use Net::DHCP::Packet::IPv4Utils qw( :all );
82              
83             =head1 DESCRIPTION
84              
85             Probably not at all useful on its own
86              
87              
88             =head2 IPv4 UTILITY METHODS
89              
90             =over 4
91              
92             =item packinet ( STRING )
93              
94             Transforms a IP address "xx.xx.xx.xx" into a packed 4 bytes string.
95              
96             These are simple never failing versions of inet_ntoa and inet_aton.
97              
98             =item packinets ( STRING )
99              
100             Transforms a list of space delimited IP addresses into a packed bytes string.
101              
102             =item packinets_array( LIST )
103              
104             Transforms an array (list) of IP addresses into a packed bytes string.
105              
106             =item unpackinet ( STRING )
107              
108             Transforms a packed bytes IP address into a "xx.xx.xx.xx" string.
109              
110             =item unpackinets ( STRING )
111              
112             Transforms a packed bytes list of IP addresses into a list of
113             "xx.xx.xx.xx" space delimited string.
114              
115             =item unpackinets_array ( STRING )
116              
117             Transforms a packed bytes list of IP addresses into a array of
118             "xx.xx.xx.xx" strings.
119              
120             =back
121              
122             =head1 AUTHOR
123              
124             Dean Hamstead Edean@bytefoundry.com.au
125             Previously Stephan Hadinger Eshadinger@cpan.orgE.
126             Original version by F. van Dun.
127              
128             =head1 BUGS
129              
130             See L
131              
132             =head1 GOT PATCHES?
133              
134             Many young people like to use Github, so by all means send me pull requests at
135              
136             https://github.com/djzort/Net-DHCP
137              
138             =head1 COPYRIGHT
139              
140             This is free software. It can be distributed and/or modified under the same terms as
141             Perl itself.
142              
143             =head1 SEE ALSO
144              
145             L, L.
146              
147             =cut