File Coverage

blib/lib/NumSeq/Iter.pm

Criterion	Covered	Total	%
statement	76	85	89.4
branch	42	56	75.0
condition	23	24	95.8
subroutine	7	8	87.5
pod	2	2	100.0
total	150	175	85.7

package NumSeq::Iter;

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-01-21'; # DATE
our $DIST = 'NumSeq-Iter'; # DIST
our $VERSION = '0.005'; # VERSION

our @EXPORT_OK = qw(numseq_iter numseq_parse);

my $re_num = qr/(?:[+-]?[0-9]+(?:\.[0-9]+)?)/;

sub _numseq_parse_or_iter {
    my $which = shift;
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    my $numseq = shift;

    my @nums;
    while ($numseq =~ s/\A(\s*,\s*)?($re_num)//) {
        die "Number sequence must not start with comma" if $1 && !@nums;
        push @nums, $2;
    }
    die "Please specify one or more number in number sequence: '$numseq'" unless @nums;

    my $has_ellipsis = 0;
    if ($numseq =~ s/\A\s*,\s*\.\.\.//) {
        die "Please specify at least three number in number sequence before ellipsis" unless @nums >= 3;
        $has_ellipsis++;
    }

    my $last_num;
    if ($numseq =~ s/\A\s*,\s*($re_num|[+-]?Inf)//) {
        $last_num = $1;
    }
    die "Extraneous token in number sequence: $numseq, please only use 'a,b,c, ...' or 'a,b,c,...,z'" if length $numseq;

    my ($is_arithmetic, $is_geometric, $inc);
  CHECK_SEQ_TYPE: {
        last unless $has_ellipsis;

      CHECK_ARITHMETIC: {
            my $inc0;
            for (1..$#nums) {
                if ($_ == 1) { $inc0 = $nums[1] - $nums[0] }
                elsif ($inc0 != ($nums[$_] - $nums[$_-1])) {
                    last CHECK_ARITHMETIC;
                }
            }
            $is_arithmetic++;
            $inc = $inc0;
            last CHECK_SEQ_TYPE;
        }

      CHECK_GEOMETRIC: {
            last if $nums[0] == 0;
            my $inc0;
            for (1..$#nums) {
                if ($_ == 1) { $inc0 = $nums[1] / $nums[0] }
                else {
                    last CHECK_GEOMETRIC if $nums[$_-1] == 0;
                    if ($inc0 != ($nums[$_] / $nums[$_-1])) {
                        last CHECK_GEOMETRIC;
                    }
                }
            }
            $is_geometric++;
            $inc = $inc0;
            last CHECK_SEQ_TYPE;
        }

        die "Can't determine the pattern from number sequence: ".join(", ", @nums);
    }

    if ($which eq 'parse') {
        return {
            numbers => \@nums,
            has_ellipsis => $has_ellipsis,
            ($has_ellipsis ? (last_number => $last_num) : ()),
            type => $is_arithmetic ? 'arithmetic' : ($is_geometric ? 'geometric' : 'itemized'),
            inc => $inc,
        };
    }

    my $i = 0;
    my $cur;
    my $ends;
    return sub {
        return undef if $ends; ## no critic: Subroutines::ProhibitExplicitReturnUndef
        return $nums[$i++] if $i <= $#nums;
        if (!$has_ellipsis) { $ends++; return undef } ## no critic: Subroutines::ProhibitExplicitReturnUndef

        $cur //= $nums[-1];
        if ($is_arithmetic) {
            $cur += $inc;
            if (defined $last_num) {
                if ($inc >= 0 && $cur > $last_num || $inc < 0 && $cur < $last_num) {
                    $ends++;
                    return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
                }
            }
            return $cur;
        } elsif ($is_geometric) {
            $cur *= $inc;
            if (defined $last_num) {
                if ($inc >= 1 && $cur > $last_num || $inc < 1 && $cur < $last_num) {
                    $ends++;
                    return undef; ## no critic: Subroutines::ProhibitExplicitReturnUndef
                }
            }
            return $cur;
        }
    };
}

sub numseq_iter {
    _numseq_parse_or_iter('iter', @_);
}

sub numseq_parse {
    my $res;
    eval {
        $res = _numseq_parse_or_iter('parse', @_);
    };
    if ($@) {
        my $errmsg = $@;
        $errmsg =~ s/(.+) at .+/$1/s; # ux: remove file+line number information from error message
        return [400, "Parse fail: $errmsg"];
    }
    [200, "OK", $res];
}

1;
# ABSTRACT: Generate a coderef iterator from a number sequence specification (e.g. '1,3,5,...,101')

__END__