File Coverage

blib/lib/PerlX/Range.pm

Criterion	Covered	Total	%
statement	21	69	30.4
branch	0	10	0.0
condition	0	6	0.0
subroutine	7	22	31.8
pod			n/a
total	28	107	26.1

package PerlX::Range;

use strict;
use warnings;
use 5.010;
use B::Hooks::OP::Check;
use B::Hooks::EndOfScope;

our $VERSION = '0.05';

use overload
    '@{}' => sub {
        my $self = shift;
        my @a = $self->to_a;
        return \@a;
    },
    '""' => sub {
        my $self = shift;
        return $self->{first} . ".." . $self->{last};
    };

sub new {
    my ($class, %args) = @_;
    my $self = bless {%args}, $class;
    $self->{current} = $self->min;
    $self->{by} = 1;
    return $self;
}

sub xrange {
    my ($first, $last) = @_;
    return __PACKAGE__->new(first => $first, last => $last);
}

sub items {
    my $self = shift;
    use integer;
    return ($self->{last} - $self->{first})/($self->{by}) + 1
}

sub first {
    $_[0]->{first}
}

sub last {
    $_[0]->{last}
}

*min = *from = \&first;
*max = *to   = \&last;

sub to_a {
    my $self = shift;
    my @r = ();
    $self->each(sub { push @r, $_ });
    return @r;
}

sub by {
    my ($self, $n) = @_;
    $self->{by} = $n if $n;
    return $self;
}

sub each {
    my $cb = pop;
    my $self = shift;

    my $current = $self->min;
    while('*' eq $self->max || $current <= $self->max) {
        local $_ = $current;
        my $ret = $cb->($self, $_);
        last if (defined($ret) && !$ret);
        $current += $self->{by} ? $self->{by} : 1;
    }
}

sub next {
    my $self = shift;

    if ($self->{current} > $self->max) {
        $self->{current} = $self->min;
        return;
    }
    $self->{current} += 1;
    return $self->{current}-1;
}

require XSLoader;
XSLoader::load('PerlX::Range', $VERSION);

sub import {
    return if $^H{PerlXRange};

    feature->import(':5.10');
    $^H &= 0x00020000;
    $^H{PerlXRange} = 1;

    add_flop_hook();
    on_scope_end {
        remove_flop_hook();
    };
}

sub unimport {
    remove_flop_hook();
    $^H &= ~0x00020000;
    delete $^H{PerlXRange};
}


1;
__END__