File Coverage

blib/lib/Callback/Cleanup.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

#!/usr/bin/perl

package Callback::Cleanup;

use strict;
use warnings;

use Sub::Clone qw(clone_if_immortal);

use Hash::Util::FieldHash::Compat qw(idhash);

use Sub::Exporter -setup => {
	exports => [qw(cleanup callback)],
	groups  => { default => [":all"] },
};

our $VERSION = "0.03";

sub cleanup (&;$) {
	my ( $cleanup, $sub ) = @_;
	$sub ? __PACKAGE__->new( $sub, $cleanup ) : $cleanup;
}

sub callback (&;$) {
	my ( $sub, $cleanup ) = @_;
	$cleanup ? __PACKAGE__->new( $sub, $cleanup ) : $sub;
}

idhash my %cleanups;

sub new {
	my ( $class, $body, $cleanup ) = @_;

	my $refcounted = clone_if_immortal($body);

	$cleanups{$refcounted} = $cleanup;

	bless $refcounted, $class;
}

sub DESTROY { delete($cleanups{$_[0]})->() }

__PACKAGE__;

__END__