r54850 - in /branches/upstream/libnet-cidr-lite-perl/current: Changes Lite.pm MANIFEST META.yml t/base.t t/more.t
chrisb at users.alioth.debian.org
chrisb at users.alioth.debian.org
Sun Mar 28 14:39:57 UTC 2010
Author: chrisb
Date: Sun Mar 28 14:39:12 2010
New Revision: 54850
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54850
Log:
[svn-upgrade] Integrating new upstream version, libnet-cidr-lite-perl (0.21)
Added:
branches/upstream/libnet-cidr-lite-perl/current/t/more.t
Modified:
branches/upstream/libnet-cidr-lite-perl/current/Changes
branches/upstream/libnet-cidr-lite-perl/current/Lite.pm
branches/upstream/libnet-cidr-lite-perl/current/MANIFEST
branches/upstream/libnet-cidr-lite-perl/current/META.yml
branches/upstream/libnet-cidr-lite-perl/current/t/base.t
Modified: branches/upstream/libnet-cidr-lite-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-cidr-lite-perl/current/Changes?rev=54850&op=diff
==============================================================================
--- branches/upstream/libnet-cidr-lite-perl/current/Changes (original)
+++ branches/upstream/libnet-cidr-lite-perl/current/Changes Sun Mar 28 14:39:12 2010
@@ -1,5 +1,13 @@
Revision history for Perl extension Net::CIDR::Lite.
+0.21 Wed Mar 28 14:34:18 2007
+ - Fix RT Tickets:
+ - 14535: Fix spanner clean() docs (reported by carbon at pobox.com).
+ - 25898: Undef dereference with empty object (patch by Adam Tomason).
+ - 30777: Add short_list_range() method (patch by Josef Kutej).
+ - 48308: clean() or list() before add() causes error (reported by David Cawley).
+ - 50042: spanner add() did not accept non-object (patch by Tomo.M).
+ - 52571: "::" not accepted as valid IPv6 address (reported by Tim Wilde).
0.20 Sun Feb 12 01:00:00 2006
- Fix error message on mask values.
0.19 Sat Jan 30 01:00:00 2006
Modified: branches/upstream/libnet-cidr-lite-perl/current/Lite.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-cidr-lite-perl/current/Lite.pm?rev=54850&op=diff
==============================================================================
--- branches/upstream/libnet-cidr-lite-perl/current/Lite.pm (original)
+++ branches/upstream/libnet-cidr-lite-perl/current/Lite.pm Sun Mar 28 14:39:12 2010
@@ -4,7 +4,7 @@
use vars qw($VERSION);
use Carp qw(confess);
-$VERSION = '0.20';
+$VERSION = '0.21';
my %masks;
my @fields = qw(PACK UNPACK NBITS MASKS);
@@ -49,6 +49,7 @@
sub clean {
my $self = shift;
+ return $self unless $self->{RANGES};
my $ranges = $$self{RANGES};
my $total;
$$self{RANGES} = {
@@ -61,6 +62,7 @@
sub list {
my $self = shift;
+ return unless $self->{NBITS};
my $nbits = $$self{NBITS};
my ($start, $total);
my @results;
@@ -101,6 +103,54 @@
wantarray ? @results : \@results;
}
+sub list_short_range {
+ my $self = shift;
+
+ my $start;
+ my $total;
+ my @results;
+
+ for my $ip (sort keys %{$$self{RANGES}}) {
+ # we begin new range when $total is zero
+ $start = $ip if not $total;
+
+ # add to total (1 for start of the range or -1 for end of the range)
+ $total += $$self{RANGES}{$ip};
+
+ # in case of end of range
+ if (not $total) {
+ while ($ip gt $start) {
+ $ip = $self->_minus_one($ip);
+
+ # in case of single ip not a range
+ if ($ip eq $start) {
+ push @results,
+ $self->{UNPACK}->($start);
+ next;
+ }
+
+ # get the last ip octet number
+ my $to_octet = ( unpack('C5', $ip) )[4];
+
+ # next ip end will be current end masked by c subnet mask 255.255.255.0 - /24
+ $ip = $ip & $self->{MASKS}[32];
+
+ # if the ip range is in the same c subnet
+ if ($ip eq ($start & $self->{MASKS}[32])) {
+ push @results,
+ $self->{UNPACK}->($start) . "-" . $to_octet;
+ }
+ # otherwise the range start is .0 (end of range masked by c subnet mask)
+ else {
+ push @results,
+ $self->{UNPACK}->($ip & $self->{MASKS}[32]) . "-" . $to_octet;
+ }
+ };
+ }
+ }
+ wantarray ? @results : \@results;
+}
+
sub _init {
my $self = shift;
my $ip = shift;
@@ -142,6 +192,7 @@
sub _pack_ipv6 {
my $ip = shift;
+ $ip =~ s/^::$/::0/;
return if $ip =~ /^:/ and $ip !~ s/^::/:/;
return if $ip =~ /:$/ and $ip !~ s/::$/:/;
my @nums = split /:/, $ip, -1;
@@ -251,6 +302,7 @@
my $self = shift;
$self->prep_find unless $self->{FIND};
return $self->bin_find(@_) unless @{$self->{FIND}} < $self->{PCT};
+ return 0 unless $self->{PACK};
my $this_ip = $self->{PACK}->(shift);
my $ranges = $self->{RANGES};
my $last = -1;
@@ -315,8 +367,10 @@
my $self = shift;
my $ranges = $self->{RANGES};
if (@_ && !$self->{PACK}) {
- $self->{PACK} = $_[0]->_packer;
- $self->{UNPACK} = $_[0]->_unpacker;
+ my $cidr = $_[0];
+ $cidr = Net::CIDR::Lite->new($cidr) unless ref($cidr);
+ $self->{PACK} = $cidr->_packer;
+ $self->{UNPACK} = $cidr->_unpacker;
}
while (@_) {
my ($cidr, $label) = (shift, shift);
@@ -413,6 +467,11 @@
sub clean {
my $self = shift;
+ unless ($self->{PACK}) {
+ my $ip = shift;
+ my $cidr = Net::CIDR::Lite->new($ip);
+ return $cidr->clean($ip);
+ }
my $ip = $self->{PACK}->(shift) || return;
$self->{UNPACK}->($ip);
}
@@ -504,12 +563,30 @@
=item $cidr->list_range()
- @cidr_list = $cidr->list;
- $list_ref = $cidr->list;
+ @cidr_list = $cidr->list_range;
+ $list_ref = $cidr->list_range;
Returns a list of the merged addresses, but in hyphenated range
format. Returns an array if called in list context, an array reference
if not.
+
+=item $cidr->list_short_range()
+
+ @cidr_list = $cidr->list_short_range;
+ $list_ref = $cidr->list_short_range;
+
+Returns a list of the C subnet merged addresses, in short hyphenated range
+format. Returns an array if called in list context, an array reference
+if not.
+
+Example:
+
+ 1.1.1.1-2
+ 1.1.1.5-7
+ 1.1.1.254-255
+ 1.1.2.0-2
+ 1.1.3.5
+ 1.1.3.7
=item $cidr->find()
@@ -578,7 +655,7 @@
$clean_address = $spanner->clean($ip_address);
-Validates a returns a cleaned up version of an ip address (which is
+Validates and returns a cleaned up version of an ip address (which is
what you will find as the key in the result from the $spanner->find(..),
not necessarily what the original argument looked like). E.g. removes
unnecessary leading zeros, removes null blocks from IPv6
Modified: branches/upstream/libnet-cidr-lite-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-cidr-lite-perl/current/MANIFEST?rev=54850&op=diff
==============================================================================
--- branches/upstream/libnet-cidr-lite-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-cidr-lite-perl/current/MANIFEST Sun Mar 28 14:39:12 2010
@@ -5,5 +5,6 @@
META.yml
README
t/base.t
+t/more.t
t/pod.t
t/podcov.t
Modified: branches/upstream/libnet-cidr-lite-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-cidr-lite-perl/current/META.yml?rev=54850&op=diff
==============================================================================
--- branches/upstream/libnet-cidr-lite-perl/current/META.yml (original)
+++ branches/upstream/libnet-cidr-lite-perl/current/META.yml Sun Mar 28 14:39:12 2010
@@ -1,10 +1,21 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Net-CIDR-Lite
-version: 0.20
-version_from: Lite.pm
-installdirs: site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+--- #YAML:1.0
+name: Net-CIDR-Lite
+version: 0.21
+abstract: Perl extension for merging IPv4 or IPv6 CIDR addresses
+author:
+ - Douglas Wilson <dougw at cpan.org>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.56
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libnet-cidr-lite-perl/current/t/base.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-cidr-lite-perl/current/t/base.t?rev=54850&op=diff
==============================================================================
--- branches/upstream/libnet-cidr-lite-perl/current/t/base.t (original)
+++ branches/upstream/libnet-cidr-lite-perl/current/t/base.t Sun Mar 28 14:39:12 2010
@@ -8,7 +8,7 @@
use Test;
use strict;
$|++;
-BEGIN { plan tests => 34 };
+BEGIN { plan tests => 39 };
use Net::CIDR::Lite;
ok(1); # If we made it this far, we are ok.
@@ -16,6 +16,9 @@
# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.
+
+my $empty = Net::CIDR::Lite->new;
+ok(!$empty->find('127.0.0.1'));
my $cidr = Net::CIDR::Lite->new;
@@ -111,3 +114,22 @@
eval { $err_cidr->add("209.152.214.112/33") };
ok($@ =~ /Bad mask/);
+# Test list shor range
+my @list_short_range = Net::CIDR::Lite->new('0.0.0.0/32')->list_short_range;
+ok(scalar(@list_short_range), 1, 'should have one "range"');
+ok($list_short_range[0], '0.0.0.0', 'that is 0.0.0.0');
+
+ at list_short_range = sort Net::CIDR::Lite->new(qw{
+ 10.0.0.1
+ 10.0.0.5
+ 10.0.0.2
+})->list_short_range;
+ok(join(', ', @list_short_range), '10.0.0.1-2, 10.0.0.5');
+
+ at list_short_range = sort Net::CIDR::Lite->new(qw{
+ 10.0.0.250-10.0.1.20
+ 10.0.1.22
+ 10.0.2.250-10.0.5.8
+})->list_short_range;
+ok(join(', ', @list_short_range), '10.0.0.250-255, 10.0.1.0-20, 10.0.1.22, 10.0.2.250-255, 10.0.3.0-255, 10.0.4.0-255, 10.0.5.0-8');
+
Added: branches/upstream/libnet-cidr-lite-perl/current/t/more.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-cidr-lite-perl/current/t/more.t?rev=54850&op=file
==============================================================================
--- branches/upstream/libnet-cidr-lite-perl/current/t/more.t (added)
+++ branches/upstream/libnet-cidr-lite-perl/current/t/more.t Sun Mar 28 14:39:12 2010
@@ -1,0 +1,34 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test;
+use strict;
+$|++;
+BEGIN { plan tests => 2 };
+use Net::CIDR::Lite;
+ok(1); # If we made it this far, we are ok.
+
+#########################
+
+
+# Testing RT Tickets that caused fatal errors
+# TODO: Could probably also test for results
+
+my $cidr = Net::CIDR::Lite->new();
+$cidr->add_range(":: - 2001:1ff:ffff:ffff:ffff:ffff:ffff:ffff");
+
+my $ipobj1 = Net::CIDR::Lite->new;
+
+$ipobj1->clean;
+$ipobj1->add('1.2.3.4/32');
+
+my $ipobj2 = Net::CIDR::Lite->new;
+
+$ipobj2->list;
+$ipobj2->add('1.2.3.4/32');
+
+ok(1);
More information about the Pkg-perl-cvs-commits
mailing list