diff --git a/Changes b/Changes index c687d65..440d80f 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,12 @@ Revision history for Perl extension NetAddr::IP +4.032 Wed Sep 22 13:39:08 PDT 2010 + Added overload => 'ne' and '!=' to Lite.pm v1.18 + +4.031 Tue Sep 21 19:21:04 PDT 2010 + Pull Socket6 stuff out of Lite 1.17 and put into + NetAddr::IP::Util.pm 1.33 in its own namespace + 4.030 Tue Jul 20 15:32:23 PDT 2010 Resolve named hosts in Lite.pm using gethostbyname, followed by gethostbyname6 to determine whether to set ipV6 flag diff --git a/IP.pm b/IP.pm index bd358ee..1b6deba 100644 --- a/IP.pm +++ b/IP.pm @@ -4,8 +4,8 @@ use strict; #use diagnostics; -use NetAddr::IP::Lite 1.14 qw(Zero Zeros Ones V4mask V4net); -use NetAddr::IP::Util 1.32 qw( +use NetAddr::IP::Lite 1.18 qw(Zero Zeros Ones V4mask V4net); +use NetAddr::IP::Util 1.33 qw( sub128 inet_aton inet_any2n @@ -34,7 +34,7 @@ @ISA = qw(Exporter NetAddr::IP::Lite); -$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.30 $ =~ /\d+/g) }; +$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.32 $ =~ /\d+/g) }; =pod diff --git a/Lite/Changes b/Lite/Changes index 2aa097a..464e4c6 100644 --- a/Lite/Changes +++ b/Lite/Changes @@ -1,5 +1,16 @@ Revision history for Perl extension NetAddr::IP::Lite +1.18 Wed Sep 22 13:39:08 PDT 2010 + Added overload => 'ne' and '!=' to Lite.pm + +1.17 Tue Sep 21 17:50:50 PDT 2010 + Pull Socket6 stuff out of Lite and put into + NetAddr::IP::Util.pm in its own namespace + +1.16 Wed Aug 11 12:45:49 PDT 2010 + When using Socket6, pull in missing symbol PF_INET6, which may + or may not be present, from Socket. + 1.15 Tue Jul 20 15:32:23 PDT 2010 Resolve named hosts using gethostbyname, followed by gethostbyname6 to determine whether to set ipV6 flag diff --git a/Lite/Lite.pm b/Lite/Lite.pm index f11c9f0..b68eee5 100644 --- a/Lite/Lite.pm +++ b/Lite/Lite.pm @@ -24,10 +24,12 @@ ipv6_n2x mask4to6 ipv4to6 + naip_gethostbyname ); + use vars qw(@ISA @EXPORT_OK $VERSION $Accept_Binary_IP $Old_nth $AUTOLOAD *Zero); -$VERSION = do { my @r = (q$Revision: 1.15 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.18 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; require Exporter; @@ -180,48 +182,6 @@ return $_v4net; } -# invoke replacement subroutine for Perl's "gethostbyname" -# if Socket6 is available. -# -# used only in 'sub _xnew' below -# -sub _end_gethostbyname { - my $tip = $_[0]; - return 0 unless $tip && $tip ne $_v4zero && $tip ne $_zero; - my $len = length($tip); - if ($len == 4) { - return ipv4to6($tip); - } - elsif ($len == 16) { - return $tip; - } - return 0; -} - -my $_gethostbyname; -unless (eval { require Socket6 }) { - $_gethostbyname = sub { - my $tip = gethostbyname($_[0]); - return &_end_gethostbyname($tip); - }; -} else { - require Socket; - my $_AF_INET6 = (defined eval { &Socket::AF_INET6 }) - ? \&Socket::AF_INET6 - : \&Socket6::AF_INET6; - $_AF_INET6 = $_AF_INET6->(); - - import Socket6 qw( gethostbyname2 ); - my $tip; - $_gethostbyname = sub { - unless ($tip = gethostbyname2($_[0],$_AF_INET6)) { - $tip = gethostbyname($_[0]); - } - return &_end_gethostbyname($tip); - }; -} - - ############################################# # These are the overload methods, placed here # for convenience. @@ -247,11 +207,22 @@ $a eq $b; }, + 'ne' => sub { + my $a = (UNIVERSAL::isa($_[0],__PACKAGE__)) ? $_[0]->cidr : $_[0]; + my $b = (UNIVERSAL::isa($_[1],__PACKAGE__)) ? $_[1]->cidr : $_[1]; + $a ne $b; + }, + '==' => sub { return 0 unless UNIVERSAL::isa($_[0],__PACKAGE__) && UNIVERSAL::isa($_[1],__PACKAGE__); $_[0]->cidr eq $_[1]->cidr; }, + '!=' => sub { + return 1 unless UNIVERSAL::isa($_[0],__PACKAGE__) && UNIVERSAL::isa($_[1],__PACKAGE__); + $_[0]->cidr ne $_[1]->cidr; + }, + '>' => sub { return &comp_addr_mask > 0 ? 1 : 0; }, @@ -325,7 +296,7 @@ =item B -You can test for equality with either C or C<==>. C allows the +You can test for equality with either C, C, C<==> or C. C, C allows the comparison with arbitrary strings as well as NetAddr::IP::Lite objects. The following example: @@ -334,10 +305,7 @@ Will print out "Yes". -Comparison with C<==> requires both operands to be NetAddr::IP::Lite objects. - -In both cases, a true value is returned if the CIDR representation of -the operands is equal. +Comparison with C<==> and C requires both operands to be NetAddr::IP::Lite objects. =item B, E, E=, E=, E=E and C> @@ -859,7 +827,7 @@ last; } # check for resolvable IPv6 hosts - elsif ($ip !~ /[^a-zA-Z0-9\.-]/ && ($tmp = $_gethostbyname->($ip))) { + elsif ($ip !~ /[^a-zA-Z0-9\.-]/ && ($tmp = naip_gethostbyname($ip))) { $ip = $tmp; $isV6 = 1; last; diff --git a/Lite/README b/Lite/README index 5b42987..ee95365 100644 --- a/Lite/README +++ b/Lite/README @@ -91,20 +91,17 @@ Will print the string Equality - You can test for equality with either "eq" or "==". "eq" allows the - comparison with arbitrary strings as well as NetAddr::IP::Lite - objects. The following example: + You can test for equality with either "eq", "ne", "==" or "!=". + "eq", "ne" allows the comparison with arbitrary strings as well as + NetAddr::IP::Lite objects. The following example: if (NetAddr::IP::Lite->new('127.0.0.1','255.0.0.0') eq '127.0.0.1/8') { print "Yes\n"; } Will print out "Yes". - Comparison with "==" requires both operands to be NetAddr::IP::Lite - objects. - - In both cases, a true value is returned if the CIDR representation - of the operands is equal. + Comparison with "==" and "!=" requires both operands to be + NetAddr::IP::Lite objects. Comparison via >, <, >=, <=, <=> and "cmp" Internally, all network objects are represented in 128 bit format. diff --git a/Lite/Util/Changes b/Lite/Util/Changes index daa1151..5943fde 100644 --- a/Lite/Util/Changes +++ b/Lite/Util/Changes @@ -1,5 +1,9 @@ Revision history for Perl extension NetAddr::IP::Util +1.33 Tue Sep 21 17:50:50 PDT 2010 + Add UtilPolluted namespace to contain name space pollution + created by "use Socket" when invoking Socket6. + 1.32 Wed May 12 14:18:20 PDT 2010 In Util.xs, changed netswap() to postincrement diff --git a/Lite/Util/README b/Lite/Util/README index de7ee8d..b3ebb63 100644 --- a/Lite/Util/README +++ b/Lite/Util/README @@ -26,6 +26,7 @@ bin2bcd bcd2bin mode + naip_gethostbyname ); use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math) @@ -34,14 +35,14 @@ ipv6_n2x, ipv6_n2d, inet_any2n, inet_n2dx, inet_n2ad, ipv4to6, mask4to6, ipanyto6, maskanyto6, - ipv6to4 + ipv6to4, naip_gethostbyname :ipv4 => inet_aton, inet_ntoa :ipv6 => ipv6_aton, ipv6_n2x, ipv6_n2d, inet_any2n, inet_n2dx, inet_n2ad ipv4to6, mask4to6, ipanyto6, - maskanyto6, ipv6to4 + maskanyto6, ipv6to4, naip_gethostbyname :math => hasbits, isIPv4, addconst, add128, sub128, notcontiguous, @@ -73,6 +74,7 @@ $bcdtext = bin2bcd($bits128); $bits128 = bcd2bin($bcdtxt); $modetext = mode; + ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME); NetAddr::IP::Util::lower(); NetAddr::IP::Util::upper(); @@ -301,6 +303,9 @@ returns: "Pure Perl" or "CC XS" + * ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME); + Replacement for Perl's gethostbyname if Socket6 is available + * NetAddr::IP::Util::lower(); Return IPv6 strings in lowercase. @@ -421,6 +426,7 @@ bin2bcd bcd2bin mode + naip_gethostbyname AUTHOR Michael Robinton diff --git a/Lite/Util/Util.pm b/Lite/Util/Util.pm index fd079ab..da3a11b 100644 --- a/Lite/Util/Util.pm +++ b/Lite/Util/Util.pm @@ -13,7 +13,7 @@ @ISA = qw(Exporter DynaLoader); -$VERSION = do { my @r = (q$Revision: 1.32 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; +$VERSION = do { my @r = (q$Revision: 1.33 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; @EXPORT_OK = qw( inet_aton @@ -44,6 +44,7 @@ bcdn2bin simple_pack comp128 + naip_gethostbyname ); %EXPORT_TAGS = ( @@ -62,6 +63,7 @@ ipanyto6 maskanyto6 ipv6to4 + naip_gethostbyname )], math => [qw( shiftleft @@ -90,6 +92,7 @@ ipanyto6 maskanyto6 ipv6to4 + naip_gethostbyname )], ); @@ -137,6 +140,61 @@ sub DESTROY {}; +my $mygethostbyname; + +package NetAddr::IP::UtilPolluted; + +# Socket pollutes the name space with all of its symbols. Since +# we don't want them all, confine them to this name space. + +use strict; +use Socket; + +sub DESTROY {}; + +# invoke replacement subroutine for Perl's "gethostbyname" +# if Socket6 is available. +# +my $_v4zero = pack('L',0); +my $_zero = pack('L4',0,0,0,0); + +sub _end_gethostbyname { + my $tip = $_[0]; + return 0 unless $tip && $tip ne $_v4zero && $tip ne $_zero; + my $len = length($tip); + if ($len == 4) { + return Util::ipv4to6($tip); + } + elsif ($len == 16) { + return $tip; + } + return 0; +} + +unless (eval { require Socket6 }) { + $mygethostbyname = sub { + my $tip = gethostbyname($_[0]); + return &_end_gethostbyname($tip); + }; +} else { + import Socket6 qw( gethostbyname2 AF_INET6 ); + my $tip; + $mygethostbyname = sub { + unless ($tip = gethostbyname2($_[0],&AF_INET6)) { + $tip = gethostbyname($_[0]); + } + return &_end_gethostbyname($tip); + }; +} + +package NetAddr::IP::Util; + +sub naip_gethostbyname { +# turn off complaint from Socket6 about missing numeric argument + undef local $^W; + return &$mygethostbyname($_[0]); +} + 1; __END__ @@ -170,6 +228,7 @@ bin2bcd bcd2bin mode + naip_gethostbyname ); use NetAddr::IP::Util qw(:all :inet :ipv4 :ipv6 :math) @@ -178,14 +237,14 @@ ipv6_n2x, ipv6_n2d, inet_any2n, inet_n2dx, inet_n2ad, ipv4to6, mask4to6, ipanyto6, maskanyto6, - ipv6to4 + ipv6to4, naip_gethostbyname :ipv4 => inet_aton, inet_ntoa :ipv6 => ipv6_aton, ipv6_n2x, ipv6_n2d, inet_any2n, inet_n2dx, inet_n2ad ipv4to6, mask4to6, ipanyto6, - maskanyto6, ipv6to4 + maskanyto6, ipv6to4, naip_gethostbyname :math => hasbits, isIPv4, addconst, add128, sub128, notcontiguous, @@ -217,6 +276,7 @@ $bcdtext = bin2bcd($bits128); $bits128 = bcd2bin($bcdtxt); $modetext = mode; + ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME); NetAddr::IP::Util::lower(); NetAddr::IP::Util::upper(); @@ -598,6 +658,10 @@ returns: "Pure Perl" or "CC XS" +=item * ($name,$aliases,$addrtype,$length,@addrs)=naip_gethostbyname(NAME); + +Replacement for Perl's gethostbyname if Socket6 is available + =item * NetAddr::IP::Util::lower(); Return IPv6 strings in lowercase. @@ -726,6 +790,7 @@ bin2bcd bcd2bin mode + naip_gethostbyname =head1 AUTHOR @@ -766,4 +831,3 @@ =cut 1; - diff --git a/Lite/t/over_equal.t b/Lite/t/over_equal.t index 626fa31..9b1ff18 100644 --- a/Lite/t/over_equal.t +++ b/Lite/t/over_equal.t @@ -4,7 +4,7 @@ $| = 1; -print "1..8\n"; +print "1..14\n"; my $test = 1; sub ok() { @@ -17,6 +17,11 @@ my $t432 = '0.0.0.4/32'; my $t4120 = '0:0:0:0:0:0:0:4/120'; +my $five = new NetAddr::IP::Lite('0.0.0.5'); +my $t532 = '0.0.0.5/32'; + + +# 1 ## test '""' overload my $txt = sprintf ("%s",$four120); @@ -24,6 +29,7 @@ unless $txt eq $t4120; &ok; +# 2 ## test '""' again $txt = sprintf ("%s",$four); @@ -31,33 +37,86 @@ unless $txt eq $t432; &ok; +# 3 ## test 'eq' to scalar print 'failed ',$four," eq $t432\nnot " unless $four eq $t432; &ok; +# 4 ## test scalar 'eq' to print "failed $t432 eq ",$four,"\nnot " unless $t432 eq $four; &ok; +# 5 ## test 'eq' to self print 'failed ',$four,' eq ', $four,"\nnot " unless $four eq $four; &ok; +# 6 ## test 'eq' cidr != print 'failed ',$four,' should not eq ',$four120,"\nnot " if $four eq $four120; &ok; +# 7 ## test '==' not for scalars print "failed scalar $t432 should not == ",$four,"\nnot " if $t432 == $four; &ok; +# 8 ## test '== not for scalar, reversed args print 'failed scalar ',$four," should not == $t432\nnot " if $four == $t432; &ok; +# ========================================== +# +# test "ne" and "!=" +# +# 9 +## test 'ne' to scalar +print 'failed ',$four120," ne $t432\nnot " + unless $four120 ne $t432; +&ok; + +# 10 +## test scalar 'ne' to +print "failed $t432 ne ",$four120,"\nnot " + unless $t432 ne $four120; +&ok; + +# 11 +## test 'ne' to cidr +print 'failed ',$four,' ne ', $four120,"\nnot " + unless $four ne $four120; +&ok; + +# 12 +## test '!=' not for scalar, reversed args +$rv = $five != $four ? 1 : 0; +#print "rv=$rv\n"; +print "failed scalar $five != $four\nnot " + unless $rv; +&ok; + +# unblessed scalars not welcome +undef local $^W; +# 13 +## test '!=' not for scalars +my $rv = $t432 != $five ? 1 : 0; +#print "rv=$rv\n"; +print "failed scalar $t432 != ",$five,"\nnot " + unless $rv; +&ok; + +# 14 +# since both of these are string scalars, the != should fail +$rv = $t532 != $t432 ? 1 : 0; +#print "rv = $rv\n"; +print "failed scalar $t532 != $t432\nnot " + if $rv; +&ok; diff --git a/META.yml b/META.yml index 9c65e80..c1e7221 100644 --- a/META.yml +++ b/META.yml @@ -1,6 +1,6 @@ --- #YAML:1.0 name: NetAddr-IP -version: 4.030 +version: 4.032 abstract: Manages IPv4 and IPv6 addresses and subnets license: ~ author: