File Coverage

blib/lib/Getopt/EX/Numbers.pm

Criterion	Covered	Total	%
statement	77	82	93.9
branch	27	34	79.4
condition	14	20	70.0
subroutine	14	14	100.0
pod	4	4	100.0
total	136	154	88.3

package Getopt::EX::Numbers;
use version; our $VERSION = version->declare("2.1.4");

use v5.14;
use warnings;

use Carp;
use List::Util qw();
use Hash::Util qw(lock_keys);
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

use Exporter qw(import);
our @EXPORT_OK = qw();

sub _default {
    return {
	min    => 0,
	max    => undef,
	start  => '',
	end    => '',
	step   => '',
	length => '',
	_spec  => undef,
    };
}

sub new {
    my $class = shift;
    my $obj = bless _default(), $class;
    lock_keys %{$obj};
    @_ % 2 and croak "invalid number of parameters";
    while (my($key, $value) = splice(@_, 0, 2)) {
	croak "$key: invalid parameter" if not exists $obj->{$key};
	$obj->{$key} = $value;
    }
    $obj;
}

sub parse {
    my $obj = shift;
    local $_ = shift;
    if (m{
	^
	(? -\d+ | \d* )
	(?:
	  (?: \.\. | : ) (? [-+]\d+ | \d* )
	  (?:
	    : (? \d* )
	      (?:
	        : (? \d* )
	      )?
	  )?
	)?
	$
	}x) {
	$obj->{start}  = $+{start};
	$obj->{end}    = $+{end};
	$obj->{step}   = $+{step};
	$obj->{length} = $+{length};
    }
    else {
	carp "$_: format error";
	return undef;
    }
    $obj->{_spec} = $_;
    $obj;
}

sub range {
    my $obj = shift;
    my $max = $obj->{max};
    my $min = $obj->{min};

    my $start  = $obj->{start};
    my $end    = $obj->{end};
    my $step   = $obj->{step};
    my $length = $obj->{length};

    if (not defined $max) {
	if ($start =~ /^-\d+$/ or
	    (defined $end and $end =~ /^-\d+$/)) {
	    carp "$_: max required";
	    return ();
	}
    }

    if ($start =~ /\d/ and defined $max and $start > $max) {
	return ();
    }
    if ($start eq '') {
	$start = $min;
    }
    elsif ($start =~ /^-\d+$/) {
	$start = List::Util::max($min, $start + $max);
    }

    if (not defined $end) {
	$end = $start;
    }
    elsif ($end eq '') {
	$end = defined $max ? $max : $start;
    }
    elsif ($end =~ /^-/) {
	$end = List::Util::max(0, $end + $max);
    }
    elsif ($end =~ s/^\+//) {
	$end += $start;
    }
    $end = $max if defined $max and $end > $max;

    $length ||= 1;
    $step ||= $length;

    my @l;
    if ($step == 1) {
	@l = ( [$start, $end] );
    } else {
	for (my $from = $start; $from <= $end; $from += $step) {
	    my $to = $from + $length - 1;
	    $to = List::Util::min($max, $to) if defined $max;
	    push @l, [$from, $to];
	}
    }

    return @l;
}

sub sequence {
    my $obj = shift;
    map { ref $_ eq 'ARRAY' ? ($_->[0] .. $_->[1]) : $_ } $obj->range;
}

1;

__END__