r2408 - in packages: . libnet-cidr-lite-perl
libnet-cidr-lite-perl/branches
libnet-cidr-lite-perl/branches/upstream
libnet-cidr-lite-perl/branches/upstream/current
Niko Tyni
ntyni-guest at costa.debian.org
Fri Mar 17 22:17:24 UTC 2006
Author: ntyni-guest
Date: 2006-03-17 22:17:22 +0000 (Fri, 17 Mar 2006)
New Revision: 2408
Added:
packages/libnet-cidr-lite-perl/
packages/libnet-cidr-lite-perl/branches/
packages/libnet-cidr-lite-perl/branches/upstream/
packages/libnet-cidr-lite-perl/branches/upstream/current/
packages/libnet-cidr-lite-perl/branches/upstream/current/Changes
packages/libnet-cidr-lite-perl/branches/upstream/current/Lite.pm
packages/libnet-cidr-lite-perl/branches/upstream/current/MANIFEST
packages/libnet-cidr-lite-perl/branches/upstream/current/Makefile.PL
packages/libnet-cidr-lite-perl/branches/upstream/current/README
packages/libnet-cidr-lite-perl/branches/upstream/current/test.pl
packages/libnet-cidr-lite-perl/tags/
Log:
[svn-inject] Installing original source of libnet-cidr-lite-perl
Added: packages/libnet-cidr-lite-perl/branches/upstream/current/Changes
===================================================================
--- packages/libnet-cidr-lite-perl/branches/upstream/current/Changes 2006-03-17 21:31:30 UTC (rev 2407)
+++ packages/libnet-cidr-lite-perl/branches/upstream/current/Changes 2006-03-17 22:17:22 UTC (rev 2408)
@@ -0,0 +1,77 @@
+Revision history for Perl extension Net::CIDR::Lite.
+
+0.15 Wed Apr 16 13:00:00 2003
+ - Fixed # of tests in test.pl. Thanks to CPAN testers.
+ - Squelched '-w' warning about doubly declared lexical variable.
+ Thanks to Jan Pieter Cornet.
+0.14 Mon Jul 14 09:00:00 2002
+ - Fixed list_range for '0.0.0.0/32' (and '::0/32').
+ Besides, I needed to get past lucky version 13.
+0.13 Mon Jul 14 02:30:00 2002
+ - internal _add_bit method was never meant to overflow, but previous
+ fix made it necessary, but it wasn't doing it correctly, so I
+ had to change the internal data structure to store N+1 bytes
+ (5 bytes for 32 bit IPv4, and 17 bytes for IPv6), and change the
+ rest of the program to deal with it.
+0.12 Sun Jul 14 22:00:00 2002
+ - Fixed off by one error on end of range in list_range method.
+ found by Allen Smith. added test.
+ - binary find was not working when target address was beginning
+ of a range. Also found by Allen Smith. added another test.
+0.11 Mon Apr 15 21:05:00 2002
+ - Fixed infinite loop in list() when 0.0.0.0/x was given as an address.
+ found by Allen Smith. added test.
+0.10 Tue Nov 27 09:05:00 2001
+ - Allow whitespace around '-' in add_range. So that what I posted
+ in a dead newsgroup on Usenet will actually work :-)
+ - Document add_any() method.
+0.09 Mon Nov 26 21:05:00 2001
+ - Fixed warning in add_range().
+0.08 Mon Nov 26 10:05:00 2001
+ - Fixed docs.
+0.07 Wed Oct 31 10:05:00 2001
+ - Lifted some code from Array::IntSpan and tweaked it for my
+ purposes to do a binary search on a find() if the (# of IP addresses)/(the
+ # of ranges) is below some percentage (default 4%). The initial
+ search setup is still O(n*log(n)) for the sort, but it can speed up
+ subsequent searches for IP addresses. I haven't benchmarked
+ any of this, so for you Benchmark fanatics who use this module,
+ let me know some stats, please :-)
+ - Added binary search capability to N::C::L find method.
+ - Fixed NCL::Span find method (never trust version 1 of this stuff).
+0.06 Tue Oct 30 10:05:00 2001
+ - Add find methods, one for ip lookup within a single cidr object, and
+ another as an Array::IntSpan style lookup, but for looking up addresses
+ in labeled cidr objects. Both are moderately inefficient for looking up
+ single ip addresses multiple times, but the latter is fairly efficient
+ at looking up many ip addresses all at once.
+0.05 Thu Oct 25 10:05:00 2001
+ - Changed some unpack/pack code to use vec(). Thanks to Tye
+ for the knowledge and know-how (especially on how to efficiently use
+ the little-endian vec function on a big-endian string).
+ Unpack/pack w/operations on strings is sometimes faster
+ than the vec() method for some strings, but probably not
+ in the common case.
+0.04 Tue Oct 23 18:05:00 2001
+ - bug in add_range() wasn't entering the end ip correctly.
+ - added list_range() function. Not sure if its useful since
+ it doesn't output ranges in CIDR netblocks. Could be changed
+ if desired, let me know either way.
+0.03 Tue Oct 23 17:05:00 2001
+ - _compress_ipv6() was not stripping leading zeros within a block.
+0.02 Tue Oct 23 14:45:00 2001
+ - Do addition with pseudo-bit manipulation (thanks to Tye for
+ initial idea, may go to complete binary operations in the future).
+ - Added IPv6 support.
+ - Clean up null nodes on 'as you go' on contiguous ranges (thanks
+ again to Tye for the idea and directly lifted code).
+ - Added more methods to simulate functionality of Net::CIDR and then
+ some (e.g. added add_range() function). Still don't have
+ octets function.
+0.01 Tue Oct 16 09:26:01 2001
+ - Basic idea to use a hash to store the ranges improves speed
+ over Net::CIDR ( O(n*n) vs. O(n*log(n)) for you big O fans).
+ (created in answer to a 'challenge' posted by Dominus on perlmonks).
+ - original version; created by h2xs 1.21 with options
+ -A -X -n Net::CIDR::Lite
+
Added: packages/libnet-cidr-lite-perl/branches/upstream/current/Lite.pm
===================================================================
--- packages/libnet-cidr-lite-perl/branches/upstream/current/Lite.pm 2006-03-17 21:31:30 UTC (rev 2407)
+++ packages/libnet-cidr-lite-perl/branches/upstream/current/Lite.pm 2006-03-17 22:17:22 UTC (rev 2408)
@@ -0,0 +1,594 @@
+package Net::CIDR::Lite;
+
+use strict;
+use vars qw($VERSION);
+use Carp qw(confess);
+
+$VERSION = '0.15';
+
+my %masks;
+my @fields = qw(PACK UNPACK NBITS MASKS);
+
+# Preloaded methods go here.
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = bless {}, $class;
+ $self->add_any($_) for @_;
+ $self;
+}
+
+sub add_any {
+ my $self = shift;
+ for (@_) {
+ tr|/|| && do { $self->add($_); next };
+ tr|-|| && do { $self->add_range($_); next };
+ UNIVERSAL::isa($_, 'Net::CIDR::Lite') && do {
+ $self->add_cidr($_); next
+ };
+ $self->add_ip($_), next;
+ }
+ $self;
+}
+
+sub add {
+ my $self = shift;
+ my ($ip, $mask) = split "/", shift;
+ $self->_init($ip) || confess "Can't determine ip format" unless %$self;
+ confess "Bad mask $mask"
+ unless $mask =~ /^\d+$/ and 2 <= $mask and $mask <= $self->{NBITS};
+ $mask += 8;
+ my $start = $self->{PACK}->($ip) & $self->{MASKS}[$mask]
+ or confess "Bad ip address: $ip";
+ my $end = $self->_add_bit($start, $mask);
+ ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
+ --$$self{RANGES}{$end} || delete $$self{RANGES}{$end};
+ $self;
+}
+
+sub clean {
+ my $self = shift;
+ my $ranges = $$self{RANGES};
+ my $total;
+ $$self{RANGES} = {
+ map { $total ? ($total+=$$ranges{$_})? () : ($_=>-1)
+ : do { $total+=$$ranges{$_}; ($_=>1) }
+ } sort keys %$ranges
+ };
+ $self;
+}
+
+sub list {
+ my $self = shift;
+ my $nbits = $$self{NBITS};
+ my ($start, $total);
+ my @results;
+ for my $ip (sort keys %{$$self{RANGES}}) {
+ $start = $ip unless $total;
+ $total += $$self{RANGES}{$ip};
+ unless ($total) {
+ while ($start lt $ip) {
+ my ($end, $bits);
+ my $sbit = $nbits-1;
+ # Find the position of the last 1 bit
+ $sbit-- while !vec($start, $sbit^7, 1) and $sbit>0;
+ for my $pos ($sbit+1..$nbits) {
+ $end = $self->_add_bit($start, $pos);
+ $bits = $pos-8, last if $end le $ip;
+ }
+ push @results, $self->{UNPACK}->($start) . "/$bits";
+ $start = $end;
+ }
+ }
+ }
+ wantarray ? @results : \@results;
+}
+
+sub list_range {
+ my $self = shift;
+ my ($start, $total);
+ my @results;
+ for my $ip (sort keys %{$$self{RANGES}}) {
+ $start = $ip unless $total;
+ $total += $$self{RANGES}{$ip};
+ unless ($total) {
+ $ip = $self->_minus_one($ip);
+ push @results,
+ $self->{UNPACK}->($start) . "-" . $self->{UNPACK}->($ip);
+ }
+ }
+ wantarray ? @results : \@results;
+}
+
+sub _init {
+ my $self = shift;
+ my $ip = shift;
+ my ($nbits, $pack, $unpack);
+ if (_pack_ipv4($ip)) {
+ $nbits = 40;
+ $pack = \&_pack_ipv4;
+ $unpack = \&_unpack_ipv4;
+ } elsif (_pack_ipv6($ip)) {
+ $nbits = 136;
+ $pack = \&_pack_ipv6;
+ $unpack = \&_unpack_ipv6;
+ } else {
+ return;
+ }
+ $$self{PACK} = $pack;
+ $$self{UNPACK} = $unpack;
+ $$self{NBITS} = $nbits;
+ $$self{MASKS} = $masks{$nbits} ||= [
+ map { pack("B*", substr("1" x $_ . "0" x $nbits, 0, $nbits))
+ } 0..$nbits
+ ];
+ $$self{RANGES} = {};
+ $self;
+}
+
+sub _pack_ipv4 {
+ my @nums = split /\./, shift(), -1;
+ return unless @nums == 4;
+ for (@nums) {
+ return unless /^\d{1,3}$/ and $_ <= 255;
+ }
+ pack("CC*", 0, @nums);
+}
+
+sub _unpack_ipv4 {
+ join(".", unpack("xC*", shift));
+}
+
+sub _pack_ipv6 {
+ my $ip = shift;
+ return if $ip =~ /^:/ and $ip !~ s/^::/:/;
+ return if $ip =~ /:$/ and $ip !~ s/::$/:/;
+ my @nums = split /:/, $ip, -1;
+ return unless @nums <= 8;
+ my ($empty, $ipv4, $str) = (0,'','');
+ for (@nums) {
+ return if $ipv4;
+ $str .= "0" x (4-length) . $_, next if /^[a-fA-F\d]{1,4}$/;
+ do { return if $empty++ }, $str .= "X", next if $_ eq '';
+ next if $ipv4 = _pack_ipv4($_);
+ return;
+ }
+ return if $ipv4 and @nums > 6;
+ $str =~ s/X/"0" x (($ipv4 ? 25 : 33)-length($str))/e if $empty;
+ pack("H*", "00" . $str).$ipv4;
+}
+
+sub _unpack_ipv6 {
+ _compress_ipv6(join(":", unpack("xH*", shift) =~ /..../g)),
+}
+
+# Replace longest run of null blocks with a double colon
+sub _compress_ipv6 {
+ my $ip = shift;
+ if (my @runs = $ip =~ /((?:(?:^|:)(?:0000))+:?)/g ) {
+ my $max = $runs[0];
+ for (@runs[1..$#runs]) {
+ $max = $_ if length($max) < length;
+ }
+ $ip =~ s/$max/::/;
+ }
+ $ip =~ s/:0{1,3}/:/g;
+ $ip;
+}
+
+# Add a single IP address
+sub add_ip {
+ my $self = shift;
+ my $ip = shift;
+ $self->_init($ip) || confess "Can't determine ip format" unless %$self;
+ my $start = $self->{PACK}->($ip) or confess "Bad ip address: $ip";
+ my $end = $self->_add_bit($start, $self->{NBITS});
+ ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
+ --$$self{RANGES}{$end} || delete $$self{RANGES}{$end};
+ $self;
+}
+
+# Add a hyphenated range of IP addresses
+sub add_range {
+ my $self = shift;
+ local $_ = shift;
+ my ($ip_start, $ip_end, $crud) = split /\s*-\s*/;
+ confess "Only one hyphen allowed in range" if defined $crud;
+ $self->_init($ip_start) || confess "Can't determine ip format"
+ unless %$self;
+ my $start = $self->{PACK}->($ip_start)
+ or confess "Bad ip address: $ip_start";
+ my $end = $self->{PACK}->($ip_end)
+ or confess "Bad ip address: $ip_end";
+ confess "Start IP is greater than end IP" if $start gt $end;
+ $end = $self->_add_bit($end, $$self{NBITS});
+ ++$$self{RANGES}{$start} || delete $$self{RANGES}{$start};
+ --$$self{RANGES}{$end} || delete $$self{RANGES}{$end};
+ $self;
+}
+
+# Add ranges from another Net::CIDR::Lite object
+sub add_cidr {
+ my $self = shift;
+ my $cidr = shift;
+ confess "Not a CIDR object" unless UNIVERSAL::isa($cidr, 'Net::CIDR::Lite');
+ unless (%$self) {
+ @$self{@fields} = @$cidr{@fields};
+ }
+ $$self{RANGES}{$_} += $$cidr{RANGES}{$_} for keys %{$$cidr{RANGES}};
+ $self;
+}
+
+# Increment the ip address at the given bit position
+# bit position is in range 1 to # of bits in ip
+# where 1 is high order bit, # of bits is low order bit
+sub _add_bit {
+ my $self= shift;
+ my $base= shift();
+ my $bits= shift()-1;
+ while (vec($base, $bits^7, 1)) {
+ vec($base, $bits^7, 1) = 0;
+ $bits--;
+ return $base if $bits < 0;
+ }
+ vec($base, $bits^7, 1) = 1;
+ return $base;
+}
+
+# Subtract one from an ip address
+sub _minus_one {
+ my $self = shift;
+ my $nbits = $self->{NBITS};
+ my $ip = shift;
+ $ip = ~$ip;
+ $ip = $self->_add_bit($ip, $nbits);
+ $ip = $self->_add_bit($ip, $nbits);
+ $self->_add_bit(~$ip, $nbits);
+}
+
+sub find {
+ my $self = shift;
+ $self->prep_find unless $self->{FIND};
+ return $self->bin_find(@_) unless @{$self->{FIND}} < $self->{PCT};
+ my $this_ip = $self->{PACK}->(shift);
+ my $ranges = $self->{RANGES};
+ my $last = -1;
+ for my $ip (@{$self->{FIND}}) {
+ last if $this_ip lt $ip;
+ $last = $ranges->{$ip};
+ }
+ $last > 0;
+}
+
+sub bin_find {
+ my $self = shift;
+ my $ip = $self->{PACK}->(shift);
+ $self->prep_find unless $self->{FIND};
+ my $find = $self->{FIND};
+ my ($start, $end) = (0, $#$find);
+ return unless $ip ge $find->[$start] and $ip lt $find->[$end];
+ while ($end - $start > 0) {
+ my $mid = int(($start+$end)/2);
+ if ($start == $mid) {
+ if ($find->[$end] eq $ip) {
+ $start = $end;
+ } else { $end = $start }
+ } else {
+ ($find->[$mid] lt $ip ? $start : $end) = $mid;
+ }
+ }
+ $self->{RANGES}{$find->[$start]} > 0;
+}
+
+sub prep_find {
+ my $self = shift;
+ $self->clean;
+ $self->{PCT} = shift || 20;
+ my $aref = $self->{FIND} = [];
+ push @$aref, $_ for sort keys %{$self->{RANGES}};
+ $self;
+}
+
+sub spanner {
+ Net::CIDR::Lite::Span->new(@_);
+}
+
+sub ranges {
+ sort keys %{shift->{RANGES}};
+}
+
+sub packer { shift->{PACK} }
+sub unpacker { shift->{UNPACK} }
+
+package Net::CIDR::Lite::Span;
+use Carp qw(confess);
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = bless {RANGES=>{}}, $class;
+ $self->add(@_);
+}
+
+sub add {
+ my $self = shift;
+ my $ranges = $self->{RANGES};
+ if (@_ && !$self->{PACK}) {
+ $self->{PACK} = $_[0]->packer;
+ $self->{UNPACK} = $_[0]->unpacker;
+ }
+ while (@_) {
+ my ($cidr, $label) = (shift, shift);
+ $cidr = Net::CIDR::Lite->new($cidr) unless ref($cidr);
+ $cidr->clean;
+ for my $ip ($cidr->ranges) {
+ push @{$ranges->{$ip}}, $label;
+ }
+ }
+ $self;
+}
+
+sub find {
+ my $self = shift;
+ my $pack = $self->{PACK};
+ my $unpack = $self->{UNPACK};
+ my %results;
+ my $in_range;
+ $self->prep_find unless $self->{FIND};
+ return {} unless @_;
+ return $self->bin_find(@_) if @_/@{$self->{FIND}} < $self->{PCT};
+ my @ips = sort map { $pack->($_) || confess "Bad IP: $_" } @_;
+ my $last;
+ for my $ip (@{$self->{FIND}}) {
+ if ($ips[0] lt $ip) {
+ $results{$unpack->(shift @ips)} = $self->_in_range($last)
+ while @ips and $ips[0] lt $ip;
+ }
+ last unless @ips;
+ $last = $ip;
+ }
+ if (@ips) {
+ my $no_range = $self->_in_range({});
+ $results{$unpack->(shift @ips)} = $no_range while @ips;
+ }
+ \%results;
+}
+
+sub bin_find {
+ my $self = shift;
+ return {} unless @_;
+ $self->prep_find unless $self->{FIND};
+ my $pack = $self->{PACK};
+ my $unpack = $self->{UNPACK};
+ my $find = $self->{FIND};
+ my %results;
+ for my $ip ( map { $pack->($_) || confess "Bad IP: $_" } @_) {
+ my ($start, $end) = (0, $#$find);
+ $results{$unpack->($ip)} = $self->_in_range, next
+ unless $ip ge $find->[$start] and $ip lt $find->[$end];
+ while ($start < $end) {
+ my $mid = int(($start+$end)/2);
+ if ($start == $mid) {
+ if ($find->[$end] eq $ip) {
+ $start = $end;
+ } else { $end = $start }
+ } else {
+ ($find->[$mid] lt $ip ? $start : $end) = $mid;
+ }
+ }
+ $results{$unpack->($ip)} = $self->_in_range($find->[$start]);
+ }
+ \%results;
+}
+
+sub _in_range {
+ my $self = shift;
+ my $ip = shift || '';
+ my $aref = $self->{PREPPED}{$ip} || [];
+ my $key = join "|", sort @$aref;
+ $self->{CACHE}{$key} ||= { map { $_ => 1 } @$aref };
+}
+
+sub prep_find {
+ my $self = shift;
+ my $pct = shift || 4;
+ $self->{PCT} = $pct/100;
+ $self->{FIND} = [ sort keys %{$self->{RANGES}} ];
+ $self->{PREPPED} = {};
+ $self->{CACHE} = {};
+ my %cache;
+ my %in_range;
+ for my $ip (@{$self->{FIND}}) {
+ my $keys = $self->{RANGES}{$ip};
+ $_ = !$_ for @in_range{@$keys};
+ my @keys = grep $in_range{$_}, keys %in_range;
+ my $key_str = join "|", @keys;
+ $self->{PREPPED}{$ip} = $cache{$key_str} ||= \@keys;
+ }
+ $self;
+}
+
+sub clean {
+ my $self = shift;
+ my $ip = $self->{PACK}->(shift) || return;
+ $self->{UNPACK}->($ip);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Net::CIDR::Lite - Perl extension for merging IPv4 or IPv6 CIDR addresses
+
+=head1 SYNOPSIS
+
+ use Net::CIDR::Lite;
+
+ my $cidr = Net::CIDR::Lite->new;
+ $cidr->add($cidr_address);
+ @cidr_list = $cidr->list;
+ @ip_ranges = $cidr->list_range;
+
+=head1 DESCRIPTION
+
+Faster alternative to Net::CIDR when merging a large number
+of CIDR address ranges. Works for IPv4 and IPv6 addresses.
+
+=head1 METHODS
+
+=item new()
+
+ $cidr = Net::CIDR::Lite->new
+ $cidr = Net::CIDR::Lite->new(@args)
+
+Creates an object to represent a list of CIDR address ranges.
+No particular format is set yet; once an add method is called
+with a IPv4 or IPv6 format, only that format may be added for this
+cidr object. Any arguments supplied are passed to add_any() (see below).
+
+=item add()
+
+ $cidr->add($cidr_address)
+
+Adds a CIDR address range to the list.
+
+=item add_range()
+
+ $cidr->add_range($ip_range)
+
+Adds a hyphenated IP address range to the list.
+
+=item add_cidr()
+
+ $cidr1->add_cidr($cidr2)
+
+Adds address ranges from one object to another object.
+
+=item add_ip()
+
+ $cidr->add_ip($ip_address)
+
+Adds a single IP address to the list.
+
+=item add_any()
+
+ $cidr->add_any($cidr_or_range_or_address);
+
+Determines format of range or single ip address and calls add(),
+add_range(), add_cidr(), or add_ip() as appropriate.
+
+=item $cidr->clean()
+
+ $cidr->clean;
+
+If you are going to call the list method more than once on the
+same data, then for optimal performance, you can call this to
+purge null nodes in overlapping ranges from the list. Boundary
+nodes in contiguous ranges are automatically purged during add().
+Only useful when ranges overlap or when contiguous ranges are added
+out of order.
+
+=item $cidr->list()
+
+ @cidr_list = $cidr->list;
+ $list_ref = $cidr->list;
+
+Returns a list of the merged CIDR addresses. Returns an array if called
+in list context, an array reference if not.
+
+=item $cidr->list_range()
+
+ @cidr_list = $cidr->list;
+ $list_ref = $cidr->list;
+
+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->find()
+
+ $found = $cidr->find($ip);
+
+Returns true if the ip address is found in the CIDR range. False if not.
+Not extremely efficient, is O(n*log(n)) to sort the ranges in the
+cidr object O(n) to search through the ranges in the cidr object.
+The sort is cached on the first call and used in subsequent calls,
+but if more addresses are added to the cidr object, prep_find() must
+be called on the cidr object.
+
+=item $cidr->prep_find()
+
+ $cidr->prep_find($num);
+
+Caches the result of sorting the ip addresses. Implicitly called on the first
+find call, but must be explicitly called if more addresses are added to
+the cidr object. find() will do a binary search if the number of ranges is
+greater than or equal to $num (default 20);
+
+=item $cidr->spanner()
+
+ $spanner = $cidr1->spanner($label1, $cidr2, $label2, ...);
+
+Creates a spanner object to find out if multiple ip addresses are within
+multiple labeled address ranges. May also be called as (with or without
+any arguments):
+
+ Net::CIDR::Lite::Span->new($cidr1, $label1, $cidr2, $label2, ...);
+
+=item $spanner->add()
+
+ $spanner->add($cidr1, $label1, $cidr2, $label2,...);
+
+Adds labeled address ranges to the spanner object. The 'address range' may
+be a Net::CIDR::Lite object, a single CIDR address range, a single
+hyphenated IP address range, or a single IP address.
+
+=item $spanner->find()
+
+ $href = $spanner->find(@ip_addresses);
+
+Look up which range(s) ip addresses are in, and return a lookup table
+of the results, with the keys being the ip addresses, and the value an
+hash reference of which address ranges the ip address is in.
+
+=item $spanner->prep_find()
+
+ $spanner->prep_find($num);
+
+Called implicitly the first time $spanner->find(..) is called, must be called
+again if more cidr objects are added to the spanner object. Will do a
+binary search if ratio of the number of ip addresses to the number of ranges
+is less than $num percent (default 4).
+
+=item $spanner->clean()
+
+ $clean_address = $spanner->clean($ip_address);
+
+Validates a 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
+addresses, etc.
+
+=head1 CAVEATS
+
+Garbage in/garbage out. This module does do validation, but maybe
+not enough to suit your needs.
+
+=head1 AUTHOR
+
+Douglas Wilson, E<lt>dougw at cpan.orgE<gt>
+w/numerous hints and ideas borrowed from Tye McQueen.
+
+=head1 COPYRIGHT
+
+ This module is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+L<Net::CIDR>.
+
+=cut
Added: packages/libnet-cidr-lite-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libnet-cidr-lite-perl/branches/upstream/current/MANIFEST 2006-03-17 21:31:30 UTC (rev 2407)
+++ packages/libnet-cidr-lite-perl/branches/upstream/current/MANIFEST 2006-03-17 22:17:22 UTC (rev 2408)
@@ -0,0 +1,6 @@
+Changes
+Lite.pm
+Makefile.PL
+MANIFEST
+README
+test.pl
Added: packages/libnet-cidr-lite-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libnet-cidr-lite-perl/branches/upstream/current/Makefile.PL 2006-03-17 21:31:30 UTC (rev 2407)
+++ packages/libnet-cidr-lite-perl/branches/upstream/current/Makefile.PL 2006-03-17 22:17:22 UTC (rev 2408)
@@ -0,0 +1,11 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Net::CIDR::Lite',
+ 'VERSION_FROM' => 'Lite.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'Lite.pm', # retrieve abstract from module
+ AUTHOR => 'Douglas Wilson <dougw at cpan.org>') : ()),
+);
Added: packages/libnet-cidr-lite-perl/branches/upstream/current/README
===================================================================
--- packages/libnet-cidr-lite-perl/branches/upstream/current/README 2006-03-17 21:31:30 UTC (rev 2407)
+++ packages/libnet-cidr-lite-perl/branches/upstream/current/README 2006-03-17 22:17:22 UTC (rev 2408)
@@ -0,0 +1,20 @@
+Net/CIDR/Lite version 0.01
+==========================
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+See tests (in the test.pl file) for an example.
+
+COPYRIGHT AND LICENCE
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Copyright (C) 2001 Douglas Wilson <dougw at cpan.org>
Added: packages/libnet-cidr-lite-perl/branches/upstream/current/test.pl
===================================================================
--- packages/libnet-cidr-lite-perl/branches/upstream/current/test.pl 2006-03-17 21:31:30 UTC (rev 2407)
+++ packages/libnet-cidr-lite-perl/branches/upstream/current/test.pl 2006-03-17 22:17:22 UTC (rev 2408)
@@ -0,0 +1,94 @@
+# 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 => 28 };
+use Net::CIDR::Lite;
+ok(1); # If we made it this far, we're ok.
+
+#########################
+
+# 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 $cidr = Net::CIDR::Lite->new;
+
+$cidr->add("209.152.214.112/30");
+$cidr->add("209.152.214.116/31");
+$cidr->add("209.152.214.118/31");
+
+my @list = $cidr->list;
+ok(scalar(@list), 1);
+ok($list[0], "209.152.214.112/29");
+
+ok($cidr->find('209.152.214.112'));
+ok($cidr->find('209.152.214.114'));
+ok(! $cidr->find('209.152.214.111'));
+ok(! $cidr->find('209.152.214.120'));
+ok($cidr->bin_find('209.152.214.114'));
+ok(! $cidr->bin_find('209.152.214.111'));
+ok(! $cidr->bin_find('209.152.214.120'));
+
+my $cidr6 = Net::CIDR::Lite->new;
+
+$cidr6->add("dead:beef:0000:0000:0000:0000:0000:0000/128");
+$cidr6->add("dead:beef:0000:0000:0000:0000:0000:0001/128");
+my @list6 = $cidr6->list;
+ok(scalar(@list6), 1);
+ok($list6[0], "dead:beef::/127");
+
+my $cidr6a = Net::CIDR::Lite->new;
+$cidr6a->add("dead:beef:0000:0000:0000:0000:0000:0002/127");
+$cidr6a->add("dead:beef:0000:0000:0000:0000:0000:0004/127");
+my @list6a = $cidr6a->list;
+ok(scalar(@list6a), 2);
+ok($list6a[0], "dead:beef::2/127");
+ok($list6a[1], "dead:beef::4/127");
+
+my $spanner = $cidr->spanner('HAL');
+ok($spanner);
+my @ips = qw(209.152.214.111 209.152.214.113);
+my $lkup = $spanner->find(@ips);
+ok(exists $lkup->{$ips[1]}{HAL});
+ok(scalar(keys %{$lkup->{$ips[1]}}), 1);
+
+# Add a new ip and make sure its in all ranges
+my $new_ip = '209.152.214.114';
+$spanner->add($new_ip,'label');
+$spanner->prep_find;
+$lkup = $spanner->find($new_ip);
+ok($lkup->{$new_ip}{HAL});
+ok($lkup->{$new_ip}{label});
+
+# Force a binary find and make sure it all still works
+$spanner->prep_find(50);
+$lkup = $spanner->find($new_ip);
+ok($lkup->{$new_ip}{HAL});
+ok($lkup->{$new_ip}{label});
+
+# Make sure 0.0.0.0 works
+my $zero = Net::CIDR::Lite->new("0.0.0.0/8");
+my @zero = $zero->list;
+ok($zero[0] eq "0.0.0.0/8");
+
+# Make sure list range works
+my $cidr_tlist = Net::CIDR::Lite->new("156.147.0.0/16");
+my @range = $cidr_tlist->list_range;
+ok(scalar(@range), 1);
+ok($range[0], "156.147.0.0-156.147.255.255");
+
+# Test find in beginning of range
+my $cidr_find =
+ Net::CIDR::Lite->new('218.48.0.0/13','218.144.0.0/12','218.232.0.0/15');
+
+ok($cidr_find->bin_find('218.144.0.0'));
+
+my @list_zero = Net::CIDR::Lite->new('0.0.0.0/32')->list_range;
+ok(scalar(@list_zero), 1);
+ok($list_zero[0], '0.0.0.0-0.0.0.0');
More information about the Pkg-perl-cvs-commits
mailing list