view release on metacpan or  search on metacpan

lib/threads/lite.pm  view on Meta::CPAN

		return;
	}
	else {
		my $ret = @mailbox ? shift @mailbox : _receive_nb;
		return $ret ? _return_elements($ret) : $ret;
	}
}

## no critic (Subroutines::RequireArgUnpacking,Subroutines::ProhibitSubroutinePrototypes)

sub receive(&) {
	my $receive = shift;

	my @save;
	my $i = 0;
	MESSAGE:
	while (1) {
		my $message;
		if ($i < @mailbox) {
			$message = splice @mailbox, $i, 1, @save;
			$i += @save;

lib/threads/lite.pm  view on Meta::CPAN

			$receive->();
			@save = ($message);
			next MESSAGE;
		}
		continue {
			return _return_elements($message);
		}
	}
}

sub receive_nb(&) {
	my $receive = shift;
	my @save;

	my $i = 0;
	MESSAGE:
	while (1) {
		my $message;
		if ($i < @mailbox) {
			$message = splice @mailbox, $i, 1, @save;
			$i += @save;

lib/threads/lite/list.pm  view on Meta::CPAN

	my @ret;
	for my $i (0..$#args) {
		push @ret, $args[$i] if $values[$i];
	}
	return @ret;
}

## no critic (Subroutines::ProhibitSubroutinePrototypes)

sub parallel_map(&@) {
	my ($code, $options, @args) = @_;
	my $object = __PACKAGE__->new(($options ? %{$options} : ()), code => $code);
	return $object->map(@args);
}

sub parallel_grep(&@) {
	my ($code, $options, @args) = @_;
	my $object = __PACKAGE__->new(($options ? %{$options} : ()), code => $code);
	return $object->grep(@args);
}

sub DESTROY {
	my $self = shift;
	for my $thread (values %{$self}) {
		$thread->send('kill');
		receiveq('exit', qr//, $thread->id, undef);