File Coverage

blib/lib/Hook/Heckle.pm

Criterion	Covered	Total	%
statement	41	43	95.3
branch	2	4	50.0
condition			n/a
subroutine	11	13	84.6
pod			n/a
total	54	60	90.0

package Hook::Heckle;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.01.01';

our $DEBUG = 0;

use Class::Maker;

	Class::Maker::class
	{
		public =>
		{
			string => [qw( victim context )],

			ref => [qw( pre post )],

			array => [qw( result )],
		}
	};

	sub __pre
	{
		my $this = shift;
	}

	sub __post
	{
		my $this = shift;
	}

	sub _preinit : method
	{
		my $this = shift;

			$this->context( 'main' );

			$this->pre( sub { } );

			$this->post( sub { } );
	}

	sub _postinit : method
	{
		my $this = shift;

			my $method = sprintf '%s::%s', $this->context, $this->victim;

			die "$this victim param is a must" unless $method;

			printf "%s postinit called for '%s'\n", ref $this, $method if $DEBUG;

			no strict 'refs';
			no warnings;

			my $orig = *{ $method }{CODE};

			*{ $method } = sub {

				my $this = $this;

				__pre( $this, @_ );

					$this->pre->( $this, @_ );

						my @result = $orig->( @_ );

						$this->result( @result );

					$this->post->( $this, @_ );

				__post( $this, @_ );

				return @result;
			};

	return $this;
	}

1;
__END__