Sub::Clone - Clone subroutine refs for garbage collection/blessing purposes


Sub-Clone documentation Contained in the Sub-Clone distribution.

Index


Code Index:

NAME

Top

Sub::Clone - Clone subroutine refs for garbage collection/blessing purposes

SYNOPSIS

Top

	use Sub::Clone;

DESCRIPTION

Top

A surprising fact about Perl is that anonymous subroutines that do not close over variables are actually shared, and do not garbage collect until global destruction:

	sub get_callback {
		return sub { "hi!" };
	}

	my $first = get_callback();
	my $second = get_callback();

	warn "$first == $second"; # prints the same refaddr

This means that blessing such a sub would change all other copies (since they are, in fact, not copies at all), and that DESTROY will never be called.

EXPORTS

Top

Sub::Clone uses Sub::Exporter so its import has all the implied goodness (renaming, etc).

is_cloned $sub

Returns true if CVf_CLONED is true (meaning that this subroutine is a clone of a proto sub and being refcounted).

clone_sub $sub

Returns a clone of the sub, that is guaranteed to be refcounted, and can be safely blessed.

clone_if_immortal $sub

Clones the sub if it's not is_cloned.

PURE PERL VS XS

Top

This module is implemented in both XS and pure Perl, and the reference counting behavior of the two is slightly different.

The XS implementation of clone_sub uses cv_clone internally, the function that captures closure state into a clone of the code ref struct (sharing the optree etc), which means that it's a real clone (the prototype's reference count does not go up), whereas the pure Perl version must wrap the proto.

This means that in the pure Perl version DESTROY might not be called as early for the cloned sub as the XS version.

VERSION CONTROL

Top

This module is maintained using Darcs. You can get the latest version from http://nothingmuch.woobling.org/code, and use darcs send to commit changes.

AUTHOR

Top

Yuval Kogman <nothingmuch@woobling.org>

COPYRIGHT

Top


Sub-Clone documentation Contained in the Sub-Clone distribution.

#!/usr/bin/perl

package Sub::Clone;

use strict;
use warnings;

BEGIN {
	our $VERSION = '0.03';

	my $e = do {
		local $@;

		eval {
			require XSLoader;
			__PACKAGE__->XSLoader::load($VERSION);
		};
		   
		$@;
	};

	if ( $e && $e !~ /object version|loadable object/ ) {
		warn $e;
		require DynaLoader;
		push our @ISA, 'DynaLoader';
		__PACKAGE__->bootstrap($VERSION);
	}
}

use Sub::Exporter -setup => {
	exports => [qw(is_cloned clone_sub clone_if_immortal)],
	groups  => { default => [qw(is_cloned clone_sub)] },
};

# Pure Perl implementation:
unless ( defined &is_cloned ) {
	eval '
use B qw(svref_2object CVf_CLONED);
use Scalar::Util qw(blessed);

sub is_cloned ($) {
		my $sub = shift;
		svref_2object($sub)->CvFLAGS & CVf_CLONED;
}

sub clone_sub ($) {
		my $sub = shift;
		my $clone = sub { goto $sub };

		if ( defined( my $class = blessed($sub) ) ) {
				bless $clone, $class;
		}

		return $clone;
}

sub clone_if_immortal ($) {
		my $sub = shift;
		is_cloned($sub) ? $sub : clone_sub($sub)
}
';
}

__PACKAGE__

__END__