File Coverage

blib/lib/Number/Continuation.pm

Criterion	Covered	Total	%
statement	75	82	91.4
branch	45	56	80.3
condition	26	30	86.6
subroutine	7	7	100.0
pod	1	1	100.0
total	154	176	87.5

package Number::Continuation;

use strict;
use warnings;
use base qw(Exporter);

use Carp qw(croak);
use Scalar::Util qw(refaddr);

our ($VERSION, @EXPORT_OK);

$VERSION = '0.04';
@EXPORT_OK = qw(continuation);

sub continuation
{
    my $opts = pop if ref $_[-1] eq 'HASH';

    my $input = ref $_[0] eq 'ARRAY'
      ? join ' ', @{$_[0]}
      : @_ > 1
        ? join ' ', @_
        : !refaddr $_[0]
          ? $_[0]
          : croak 'continuation($set | @set | \@set [, { options } ])';

    _validate($input);

    my $wantarray = wantarray;

    $opts->{delimiter} ||= '';
    $opts->{range}     ||= '-';
    $opts->{separator} ||= ',';

    @{$opts->{delimiters}} = split //, $opts->{delimiter};

    my @nums = split /\s+/, $input;

    my (%constructed, $have_neg_continuation, @lists, $output, @output);

    my $reset = 1;

    for (my $i = 0; $i < @nums; $i++) {
        # handy variables
        my $prev_number    = $nums[$i-1] || 0;
        my $current_number = $nums[$i  ] || 0;
        my $next_number    = $nums[$i+1] || 0;

        # set if preceeded by continuation
        my $prev_continuation = 1 if $constructed{begin}
                                  && $constructed{middle}
                                  && $constructed{end};

        # set if negative continuation sensed (i.e. 3 2 1)
        $have_neg_continuation = 1 if ($prev_number - $next_number == 2);

        # previous number greater than current one
        if ($prev_number > $current_number && $i != 0 && !$have_neg_continuation) {
            # previous number *exactly* greater 1
            if ($prev_number - $current_number == 1) {
                if ($wantarray) {
                    if (@lists) {
                        push @output, [ @lists ];
                        undef @lists;
                    }
                } else {
                    $output .= "$opts->{separator} ";
                }
            # previous number greater than 1 and no previous continuation
            } else {
                if ($wantarray) {
                    if (@lists) {
                        push @output, [ @lists ];
                        undef @lists;
                    }
                } else {
                    $output .= "$opts->{separator} " unless $prev_continuation;
                }
            }
            # reset processing continuation state
            $reset = 1;
        }
        # processing new continuation
        if ($reset) {
            if ($wantarray) {
                push @lists, $nums[$i];
                push @output, [ @lists ] if $i == $#nums;
            } else {
                $output .= $opts->{delimiters}->[0] if $opts->{delimiters}->[0];
                $output .= $nums[$i];
            }
            if (($next_number - $current_number) > 1) {
                if ($wantarray) {
                    if (@lists) {
                        push @output, [ @lists ];
                        undef @lists;
                    }
                } else {
                    $output .= "$opts->{separator} ";
                }
                next;
            }
            ($have_neg_continuation, $reset) = (0,0);
            undef %constructed;

            $constructed{begin} = 1;
        # process numbers in between (skipping if scalar context)
        } elsif (defined($next_number) && (($next_number - $current_number) == 1
                                       ||  ($current_number - $next_number) == 1)) {
            if ($wantarray) {
                push @lists, $current_number;
            } else { # blissfully do nothing when scalar context
            }
            $constructed{middle} = 1;
        # end processing current continuation
        } else {
            if ($wantarray) {
                push @lists, $current_number;
                push @output, [ @lists ];
                undef @lists;
            } else {
                $output .= $opts->{range}.$current_number;
                $output .= $opts->{delimiters}->[-1] if $opts->{delimiters}->[-1];
                $output .= "$opts->{separator} "     unless $i == $#nums;
            }
            $reset = 1;
            $constructed{end} = 1;
        }
    }

    return wantarray ? @output : $output;
}

sub _validate
{
    my ($set) = @_;

    croak 'continuation(): empty set provided' unless defined $set;

    my $RE_valid = qr{(?:[\d\-]+\ ?)+};
    1 while $set =~ /\G$RE_valid/gc;
    unless ($set =~ /\G$/) {
        croak "continuation(): invalid set provided: '$set`";
    }
}

1;
__END__