File Coverage

blib/lib/Parse/Range.pm

Criterion	Covered	Total	%
statement	44	44	100.0
branch	24	24	100.0
condition	10	12	83.3
subroutine	7	7	100.0
pod	1	1	100.0
total	86	88	97.7

package Parse::Range;

our $VERSION = 0.96;

use strict;
use warnings;
use List::MoreUtils qw(uniq first_index);

use base qw(Exporter);

our @EXPORT_OK = qw(parse_range);

sub parse_range {
	my $in = join(',', @_);
	my $level = 0;
	my @range = ('');
	foreach my $char (split('', $in)) {
		$level++ if($char eq '(');
		$range[-1] .= $char if($char !~ /,/ || $char =~ /[\(\),]/ && $level != 0);
		$level-- if($char eq ')');
		push(@range, '') if($level == 0 && $char eq ',');
	}
	if($level != 0) {
		return $level < 0 ? parse_range(('(' x -$level) . $in) : parse_range($in . ')' x $level);
	}
	my @out = ();
	foreach my $range (@range) {
		$range =~ s/\s//gsm;
		my @except = ();
		if($range =~ /^\^(.*)$/) {
			push(@except, _parse_range($1));
		} else {
			push(@out, _parse_range($range));
		}
		@out = uniq(@out);
		foreach my $e (@except) {
		 my $idx = first_index { $_ eq $e } @out;
		splice(@out, $idx, 1) if($idx != -1);
		}
	}
	return @out;
}

sub _parse_range {
	my $range = shift;
	if($range =~ /^(-?\d+)\-(-?\d+)$/ || $range =~ /^(-?\d+)\)?\-\((-\d+)\)?$/) {
		my($from, $to) = ($1, $2);
		($to, $from) = ($from, $to) if($from > $to);
		return eval $from.'..'.$to;
	} elsif($range =~ /^(-?\d+)$/) {
		return $1;
	} elsif($range =~ /^\((.*)\)$/) {
		return parse_range($1);
	} else { warn 'non-numeric range: \'' . $range. '\''; return () }
}

1;

__END__