r74762 - in /trunk/libnetaddr-ip-perl: Changes IP.pm Lite/README META.yml debian/changelog t/v4-compact.t
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Thu May 19 18:23:50 UTC 2011
Author: periapt-guest
Date: Thu May 19 18:23:32 2011
New Revision: 74762
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=74762
Log:
New upstream release
Modified:
trunk/libnetaddr-ip-perl/Changes
trunk/libnetaddr-ip-perl/IP.pm
trunk/libnetaddr-ip-perl/Lite/README
trunk/libnetaddr-ip-perl/META.yml
trunk/libnetaddr-ip-perl/debian/changelog
trunk/libnetaddr-ip-perl/t/v4-compact.t
Modified: trunk/libnetaddr-ip-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnetaddr-ip-perl/Changes?rev=74762&op=diff
==============================================================================
--- trunk/libnetaddr-ip-perl/Changes (original)
+++ trunk/libnetaddr-ip-perl/Changes Thu May 19 18:23:32 2011
@@ -1,4 +1,11 @@
Revision history for Perl extension NetAddr::IP
+
+4.044 Wed May 18 14:47:34 PDT 2011
+ added missing support for ->compactref(\@list) which is described
+ in the documentation but not implemented.
+
+ Thanks to Rusty Bourland codebard at gmail.com for spotting this
+ and providing both a patch and test code
4.043 Wed Apr 6 11:31:19 PDT 2011
Update documentation on the use of "adding constants
Modified: trunk/libnetaddr-ip-perl/IP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnetaddr-ip-perl/IP.pm?rev=74762&op=diff
==============================================================================
--- trunk/libnetaddr-ip-perl/IP.pm (original)
+++ trunk/libnetaddr-ip-perl/IP.pm Thu May 19 18:23:32 2011
@@ -4,7 +4,7 @@
use strict;
#use diagnostics;
-use NetAddr::IP::Lite 1.27 qw(Zero Zeros Ones V4mask V4net);
+use NetAddr::IP::Lite 1.28 qw(Zero Zeros Ones V4mask V4net);
use NetAddr::IP::Util 1.36 qw(
sub128
inet_aton
@@ -34,7 +34,7 @@
@ISA = qw(Exporter NetAddr::IP::Lite);
-$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.43 $ =~ /\d+/g) };
+$VERSION = do { sprintf " %d.%03d", (q$Revision: 4.44 $ =~ /\d+/g) };
=pod
@@ -390,7 +390,9 @@
}
sub compact {
- return @{compactref(\@_)};
+ return (ref $_[0] eq 'ARRAY')
+ ? compactref($_[0]) # Compact(\@list)
+ : @{compactref(\@_)}; # Compact(@list) or ->compact(@list)
}
*Compact = \&compact;
@@ -1084,7 +1086,9 @@
=item C<$me-E<gt>compactref(\@list)>
-As usual, a faster version of =item C<-E<gt>compact()> that returns a
+=item C<$compacted_object_list = Compact(\@list)>
+
+As usual, a faster version of C<-E<gt>compact()> that returns a
reference to a list. Note that this method takes a reference to a list
instead.
@@ -1097,39 +1101,57 @@
# or return [];
# return [] unless @r;
- return [] unless (my @unr = @{$_[0]});
-
- foreach(0..$#unr) {
- $unr[$_]->{addr} = $unr[$_]->network->{addr};
+ my @r;
+ {
+ my $unr = [];
+ my $args = $_[0];
+
+ if (ref $_[0] eq __PACKAGE__ and ref $_[1] eq 'ARRAY') {
+ # ->compactref(\@list)
+ #
+ $unr = [$_[0], @{$_[1]}]; # keeping structures intact
+ }
+ else {
+ # Compact(@list) or ->compact(@list) or Compact(\@list)
+ #
+ $unr = $args;
+ }
+
+ return [] unless @$unr;
+
+ foreach(@$unr) {
+ $_->{addr} = $_->network->{addr};
+ }
+
+ @r = sort @$unr;
}
- my @r = sort @unr;
my $changed;
do {
- $changed = 0;
- for(my $i=0; $i <= $#r -1;$i++) {
- if ($r[$i]->contains($r[$i +1])) {
- splice(@r,$i +1,1);
- ++$changed;
- --$i;
- }
- elsif ((notcontiguous($r[$i]->{mask}))[1] == (notcontiguous($r[$i +1]->{mask}))[1]) { # masks the same
- if (hasbits($r[$i]->network->{addr} ^ $r[$i +1]->network->{addr})) { # if not the same netblock
- my $upnet = $r[$i]->copy;
- $upnet->{mask} = shiftleft($upnet->{mask},1);
- if ($upnet->contains($r[$i +1])) { # adjacent nets in next net up
- $r[$i] = $upnet;
- splice(@r,$i +1,1);
- ++$changed;
- --$i;
- }
- } else { # identical nets
- splice(@r,$i +1,1);
- ++$changed;
- --$i;
- }
- }
- }
+ $changed = 0;
+ for(my $i=0; $i <= $#r -1;$i++) {
+ if ($r[$i]->contains($r[$i +1])) {
+ splice(@r,$i +1,1);
+ ++$changed;
+ --$i;
+ }
+ elsif ((notcontiguous($r[$i]->{mask}))[1] == (notcontiguous($r[$i +1]->{mask}))[1]) { # masks the same
+ if (hasbits($r[$i]->{addr} ^ $r[$i +1]->{addr})) { # if not the same netblock
+ my $upnet = $r[$i]->copy;
+ $upnet->{mask} = shiftleft($upnet->{mask},1);
+ if ($upnet->contains($r[$i +1])) { # adjacent nets in next net up
+ $r[$i] = $upnet;
+ splice(@r,$i +1,1);
+ ++$changed;
+ --$i;
+ }
+ } else { # identical nets
+ splice(@r,$i +1,1);
+ ++$changed;
+ --$i;
+ }
+ }
+ }
} while $changed;
return \@r;
}
Modified: trunk/libnetaddr-ip-perl/Lite/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnetaddr-ip-perl/Lite/README?rev=74762&op=diff
==============================================================================
--- trunk/libnetaddr-ip-perl/Lite/README (original)
+++ trunk/libnetaddr-ip-perl/Lite/README Thu May 19 18:23:32 2011
@@ -148,7 +148,7 @@
hosts above the current objects start address. For instance, this
code:
- print NetAddr::IP::Lite->new('127.0.0.1') + 5;
+ print NetAddr::IP::Lite->new('127.0.0.1/8') + 5;
will output 127.0.0.6/8. The address will wrap around at the
broadcast back to the network address. This code:
Modified: trunk/libnetaddr-ip-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnetaddr-ip-perl/META.yml?rev=74762&op=diff
==============================================================================
--- trunk/libnetaddr-ip-perl/META.yml (original)
+++ trunk/libnetaddr-ip-perl/META.yml Thu May 19 18:23:32 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: NetAddr-IP
-version: 4.043
+version: 4.044
abstract: Manages IPv4 and IPv6 addresses and subnets
license: ~
author:
Modified: trunk/libnetaddr-ip-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnetaddr-ip-perl/debian/changelog?rev=74762&op=diff
==============================================================================
--- trunk/libnetaddr-ip-perl/debian/changelog (original)
+++ trunk/libnetaddr-ip-perl/debian/changelog Thu May 19 18:23:32 2011
@@ -1,11 +1,12 @@
-libnetaddr-ip-perl (4.043+dfsg-1) UNRELEASED; urgency=low
+libnetaddr-ip-perl (4.044+dfsg-1) UNRELEASED; urgency=low
IGNORE-VERSION: 4.043+dfsg-1
Only doc change; very active package
* New upstream release
-
- -- Nicholas Bamber <nicholas at periapt.co.uk> Fri, 08 Apr 2011 10:27:25 +0100
+ * New upstream release
+
+ -- Nicholas Bamber <nicholas at periapt.co.uk> Thu, 19 May 2011 19:26:29 +0100
libnetaddr-ip-perl (4.042+dfsg-1) unstable; urgency=low
Modified: trunk/libnetaddr-ip-perl/t/v4-compact.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnetaddr-ip-perl/t/v4-compact.t?rev=74762&op=diff
==============================================================================
--- trunk/libnetaddr-ip-perl/t/v4-compact.t (original)
+++ trunk/libnetaddr-ip-perl/t/v4-compact.t Thu May 19 18:23:32 2011
@@ -18,44 +18,93 @@
exit 0;
}
-print "1..2\n";
+print "1..9\n";
-my @ips;
+my @ips1;
for my $ip ('10.0.0.0', '11.0.0.0', '12.0.0.0') {
- push @ips, NetAddr::IP->new($ip, 24)->split(32);
+ push @ips1, NetAddr::IP->new($ip, 24)->split(32);
}
for my $ip ('20.0.0.0', '30.0.0.0', '40.0.0.0') {
- push @ips, NetAddr::IP->new($ip, 16)->split(28);
+ push @ips1, NetAddr::IP->new($ip, 16)->split(28);
}
-my @c = Compact(@ips);
-my @m;
+my @ips2;
-for my $c (@c) {
- push @m, grep { $c->addr eq $_->[0] and $c->mask eq $_->[1] } @r;
+for my $num (0 .. 255) {
+ push @ips2, NetAddr::IP->new("192.168.$num.0", 24);
+}
+my $ips2_compact = '192.168.0.0/16';
+
+# Compact(@)
+#
+compact_ips1_check(1, Compact(@ips1));
+compact_ips2_check(2, Compact(@ips2));
+
+# ->compact(@)
+#
+compact_ips1_check(3, $ips1[0]->compact(@ips1[1..$#ips1]));
+compact_ips2_check(4, $ips2[0]->compact(@ips2[1..$#ips2]));
+
+# Compact([])
+#
+compact_ips1_check(5, @{Compact(\@ips1)});
+compact_ips2_check(6, @{Compact(\@ips2)});
+
+# ->compactref([])
+#
+compact_ips1_check(7, @{$ips1[0]->compactref([@ips1[1..$#ips1]])});
+compact_ips2_check(8, @{$ips2[0]->compactref([@ips2[1..$#ips2]])});
+
+# duplicate IP
+#
+ at ips1 = ();
+
+for my $ip (qw(1.1.1.1 1.1.1.1 1.1.1.1 1.1.1.1)) {
+ push(@ips1, NetAddr::IP->new($ip));
}
-if (@m == @c) {
- print "ok 1\n";
+ at c = NetAddr::IP::compact(@ips1);
+
+if (@c == 1 and $c[0]->cidr() eq '1.1.1.1/32') {
+ print "ok 9\n";
}
else {
- print "not ok 1\n";
+ print "not ok 9\n";
}
- at ips = ();
-for my $ip (qw(1.1.1.1 1.1.1.1 1.1.1.1 1.1.1.1)) {
- push(@ips, NetAddr::IP->new($ip));
+######################################################################
+sub compact_ips1_check
+{
+ my $num = shift;
+ my @ips = shift;
+
+ my @mips;
+ for my $ip (@ips) {
+ push @mips, grep { $ip->addr eq $_->[0] and $ip->mask eq $_->[1] } @r;
+ }
+
+ if (@mips == @ips) {
+ print "ok $num\n";
+ }
+ else {
+ print "not ok $num\n";
+ }
}
- at c = NetAddr::IP::compact(@ips);
-if (@c == 1 and $c[0]->cidr() eq '1.1.1.1/32') {
- print "ok 2\n";
+######################################################################
+sub compact_ips2_check
+{
+ my $num = shift;
+ my @ips = shift;
+
+ if (@ips == 1 and $ips[0] eq $ips2_compact) {
+ print "ok $num\n";
+ }
+ else {
+ print "not ok $num\n";
+ }
}
-else {
- print "not ok 2\n";
-}
-
More information about the Pkg-perl-cvs-commits
mailing list