File Coverage

blib/lib/Range/Merge.pm

Criterion	Covered	Total	%
statement	126	134	94.0
branch	40	68	58.8
condition	2	3	66.6
subroutine	12	13	92.3
pod	2	2	100.0
total	182	220	82.7

#!/usr/bin/perl

#
# Copyright (C) 2016 Joel C. Maslak
# All Rights Reserved - See License
#

package Range::Merge v0.01.00;
$Range::Merge::VERSION = '1.002';
use Range::Merge::Boilerplate 'script';

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(merge merge_ipv4);

use List::Util qw(max);
use Net::CIDR;
use Socket;

# ABSTRACT: Merges ranges of data including subset/superset ranges



sub merge($ranges) {
    my $sorted = _sort($ranges);
    my $split = [];
    _split($ranges, $split);
    return _combine($split);
}


sub merge_ipv4($cidr) {
    my $ranges = [];
    @$ranges = map { _cidr2range($_) } @$cidr;
    my $combined = merge($ranges);
    return _range2cidr($combined);
}

sub _cidr2range($cidr) {
    my ($ip, @a) = @$cidr;
    my ($range) = Net::CIDR::cidr2range($ip);
    my (@parts) = map { unpack('N', inet_aton($_)) } split(/-/, $range);

    return [ @parts, @a ];
}

sub _range2cidr($ranges) {
    my @output;
    foreach my $range (@$ranges) {
        my ($start, $end, @other) = @$range;
        $start = inet_ntoa(pack('N', $start));
        $end   = inet_ntoa(pack('N', $end  ));
        foreach my $cidr (Net::CIDR::range2cidr("$start-$end")) {
            push @output, [ $cidr, @other ];
        }
    }
    return \@output;
}

# Sorts by starting address and then by reverse (less specific to more
# specific)
sub _sort($ranges) {
    my (@output) = sort { ($a->[0] <=> $b->[0]) || ($b->[1] <=> $a->[0]) } @$ranges;
    return \@output;
}

sub _merge($ranges) {
    my $split = [];
    _split($ranges, $split);
    return _combine($split);
}

sub _combine($ranges) {
    my @output;

    my $last;
    foreach my $range (@$ranges) {
        if (!defined($last)) {
            $last = [ @$range ];
            next;
        }
        if (($last->[1] == $range->[0] - 1) && (scalar(@$last) == scalar(@$range))) {
            my $nomatch;
            for (my $i=2; $i
                if ($last->[$i] ne $range->[$i]) {
                    $nomatch = 1;
                    last;
                }
            }
            if ($nomatch) {
                push @output, $last;
                $last = [ @$range ];
            } else {
                $last->[1] = $range->[1];
            }
        } else {
            push @output, $last;
            $last = [ @$range ];
        }
    }
    if (defined($last)) { push @output, $last }

    return \@output;
}

sub _split($ranges, $output, $stack = []) {
    # Termination condition
    if (scalar($ranges->@*) == 0) { return undef; }

    # We just repeatedly call _add_to_stack
    foreach my $range ($ranges->@*) {
        _add_to_stack($range, $stack, $output);
    }

    # Return stack
    if (scalar($stack->@*)) {
        push $output->@*, $stack->@*;
    }

    return undef;
}

sub _add_to_stack($range, $stack, $output) {
    if (!scalar($stack->@*)) {
        # Empty stack
        push $stack->@*, $range;
        return undef;
    }

    # We know the following:
    #
    # 1. The stack is sorted
    # 2. There are no overlapping elements
    #    2a. Thus we only have to split 1 element max
    # 3. The stack has at least one element

    my (@lstack) = grep { $_->[1] < $range->[0]} @$stack;
    my (@rstack) = grep { $_->[0] > $range->[1]} @$stack;
    my (@mid   ) = grep { ($_->[0] <= $range->[1]) && ($_->[1] >= $range->[0])} @$stack;

    # Clear stack
    @$stack = ();

    # Output the stuff completely to the left of the new range
    push @$output, @lstack;

    # Option 1 -> No middle element, so just add the range (and the
    # right stack) to the stack
    if (!scalar(@mid)) {
        push @$stack, $range, @rstack;
        return undef;
    }

    # We start with the left and right parts of the element that might
    # need to be split.
    my (@left)  = $mid[0]->@*;
    my (@right) = $mid[0]->@*;

    # Does the ele needing split start before the range?  If so, add the piece
    # needed to the output
    if ($left[0] < $range->[0]) {
        @left[1] = $range->[0] - 1;
        if ($left[0] <= $left[1]) {
            push @$output, \@left;
        }
    }

    # We need to add the range to the stack
    push @$stack, $range;

    # Does the ele needing split end after the range?  If so, add the
    # piece to the stack
    if ($right[1] > $range->[1]) {
        @right[0] = $range->[1] + 1;
        if ($right[0] <= $right[1]) {
            push @$stack, \@right;
        }
    }

    push @$stack, @rstack;

    return undef;
}

# Main element in the algorithm
# sub _merge($ranges, $output, $stack) {
# if (!scalar($stack->@*)) {
# # Stack is empty
#
# if (!scalar($ranges->@*)) {
# return undef; # No ranges, no stack
# }
#
# push $stack->@*, unshift($ranges->@*);
# }
#
# _output_stack($output, $stack);
# }

1;

__END__