lite.pm

net cidr lite 相关源包算法

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 { map { $_ => {} } @_ } unless @{$self->{FIND}};
    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};
    return { map { $_ => {} } @_ } 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

=over 4

=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->bin_find()

Same as find(), but forces a binary search. See also prep_find.

=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 a
hash reference of which address ranges the ip address is in.

=item $spanner->bin_find()

Same as find(), but forces a binary search. See also prep_find.

=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.

=back

=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>[e-mail]<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