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