File Coverage

blib/lib/Perl6/Gather.pm

Criterion	Covered	Total	%
statement	70	83	84.3
branch	8	18	44.4
condition	4	19	21.0
subroutine	19	23	82.6
pod	0	4	0.0
total	101	147	68.7

package Perl6::Gather;
use Perl6::Export;
use Carp;

our $VERSION = '0.42';

my %gatherers;

sub gather(&) is export(:DEFAULT) {
	croak "Useless use of 'gather' in void context" unless defined wantarray;
	my ($code) = @_;
	my $caller = caller;
	local @_;
	push @{$gatherers{$caller}}, bless \@_, 'Perl6::Gather::MagicArrayRef';
	die $@
		if !eval{ &$code } && $@ && !UNIVERSAL::isa($@, Perl6::Gather::Break);
	return @{pop @{$gatherers{$caller}}} if wantarray;
	return   pop @{$gatherers{$caller}}  if defined wantarray;
}

sub gathered() is export(:DEFAULT) {
	my $caller = caller;
	croak "Call to gathered not inside a gather" unless @{$gatherers{$caller}};
	return $gatherers{$caller}[-1];
}

sub take(@) is export(:DEFAULT) {
	@_ = $_ unless @_;
	my $caller = caller;
	croak "Call to take not inside a gather block"
		unless ((caller 3)[3]||"") eq 'Perl6::Gather::gather';
	push @{$gatherers{$caller}[-1]}, @_;
	return 0+@_;
}

my $breaker = bless [], 'Perl6::Gather::Break';

sub break() is export(:DEFAULT) {
	die $breaker;
}

package Perl6::Gather::MagicArrayRef;

use overload
	'bool' => sub { @{$_[0]} > 0      },
	'0+'   => sub { @{$_[0]} + 0      },
	'""'   => sub { join "", @{$_[0]} },
	'~'    => sub { join "", @{$_[0]} },
	fallback => 1;
;

1;
__END__