view release on metacpan or  search on metacpan

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

package Closure::Explicit;
# ABSTRACT: check coderefs for unintended lexical capture
use strict;
use warnings;
use B;
use PadWalker qw(closed_over peek_sub peek_my);
use Scalar::Util ();

our $VERSION = '0.002';

=head1 NAME

Closure::Explicit - check coderefs for variable capture

=head1 VERSION

version 0.002

=head1 SYNOPSIS

 use Closure::Explicit qw(callback);

 {
   package Example;
   sub new { my $class = shift; bless {}, $class }
   sub method { my $self = shift; print "In method\n" }
 }
 my $self = Example->new;
 # This will raise an exception due to the reference to $self
 eval {
   my $code = callback {
     $self->method;
   };
 };
 # This will not raise the exception because $self is whitelisted
 my $code = callback {
   $self->method;
 } [qw($self)];
 # This will wrap the coderef so we can pass a weakened copy of $self
 my $code = callback {
   my $self = shift;
   $self->method;
 } weaken => [qw($self)];

=head1 DESCRIPTION

Attempts to provide some very basic protection against unintentional
capturing of lexicals in a closure.

For example, code such as the following risks creating cycles which
mean the top-level object is never freed:

 sub some_method {
   my $self = shift;
   $self->{callback} = sub { $self->other_method }
 }

and this can in turn lead to memory leaks.

=head1 API STABILITY

The main L</callback> function is not expected to change in future versions,
so as long as you use this:

 use Closure::Explicit qw(callback);

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

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.