view release on metacpan or  search on metacpan

lib/Closure/Explicit.pm  view on Meta::CPAN

Runs checks on the given coderef. This is used internally and not exported,
but if you just want to get a list of potential problems for a coderef,
call this:

 my @errors = lint($code, allowed => [qw($x)]);

It's unlikely that the C<weaken> parameter will work when calling this
function directly - this may be fixed in a future version.

=cut

sub lint {
	my ($code, %spec) = @_;
	my $cv = B::svref_2object($code);
	my $details = sprintf '%s(%s:%d)', $cv->STASH->NAME, $cv->FILE, $cv->GV->LINE;

	my %closed = %{closed_over($code)};
	my %closed_by_value = map {
		ref($closed{$_}) eq 'REF'
		? (${$closed{$_}} => $_)
		: ()
	} keys %closed;

	# This is everything we declare in the sub
	my @lexicals = grep !exists $closed{$_}, keys %{ peek_sub $code };

	if($spec{weaken}) {
#		warn "weaken request: " . join ',', @{$spec{weaken}};
		my $scope = peek_my(2);
		my $real_code = $code;
		my @extra = map ${ $scope->{$_} }, @{$spec{weaken}};
		Scalar::Util::weaken($_) for @extra;
		$code = $_[0] = sub { $real_code->(@extra, @_) };
		shift;
	}

	# That's it for the data collection, now run the tests
	my @errors;
	foreach my $var (@{$spec{declares}}) {
		push @errors, "no $var declared in padlist" unless grep $_ eq $var, @lexicals;
	}
#	say " * We are capturing $_" for sort keys %closed;
	my %allowed = map { $_ => 1 } @{$spec{allowed}};
	push @errors, "$_ captured in closure, recommend checking for cycles" for sort grep !exists $allowed{$_}, keys %closed;

	foreach my $var (@{$spec{captures}}) {
		push @errors, "$var captured in closure, recommend checking for cycles" if grep $_ eq $var, keys %closed;
	}
	push @errors, "blacklisted value found in closure: $_ ($closed_by_value{$_})" for grep exists $closed_by_value{$_}, @{$spec{values}};
	return map "$details - $_", @errors;
}

1;

__END__

=head1 SEE ALSO

=over 4

=item * L<curry> - provides a convenient interface for creating callbacks

=item * L<PadWalker> - does most of the real work behind this module

=item * L<Test::RefCount> - convenient testing for reference counts, makes
cycles easier to detect in test code

=item * L<Devel::Cycle> - reports whether cycles exist and provides useful
diagnostics when any are found

=back

=head1 AUTHOR

Tom Molesworth <cpan@entitymodel.com>

=head1 LICENSE

Copyright Tom Molesworth 2012-2013. Licensed under the same terms as Perl itself.