File Coverage

blib/lib/Perl6/Take.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	5	6	83.3
condition			n/a
subroutine	7	7	100.0
pod	2	2	100.0
total	41	42	97.6

package Perl6::Take;

use warnings;
use strict;

use Carp;

our $VERSION = '0.04';

our @GATHER;

sub gather (&) {
    # We used to push and pop ourselves, but local's easier for cleanup
    # purposes, and since the gather stack only contains references to the
    # takelists, copying it isn't expensive. Unless you have like a couple
    # thousand nested gathers, in which case you're beyond my help.
    local @GATHER = (@GATHER, []);

    # Here needs to come some trick to see the code didn't explicitly say
    # "return". But that's presumed impossible in pure Perl 5.
    shift->();

    return @{ $GATHER[-1] };
}

sub take (@) {
    Carp::croak("take with no gather") unless @GATHER;
    Carp::confess("internal error: gather cell not a listref") unless
            ref $GATHER[-1] eq 'ARRAY';
    Carp::croak('take with no args, did you mean "take $_"?') unless @_;

    push @{ $GATHER[-1] }, @_;
    return @_; # for possible en passant assignment
}

sub import {
    my $caller = caller;
    no strict;
    *{"$caller\::gather"} = \&gather;
    *{"$caller\::take"}   = \&take;
}

1;

__END__