Hook::Heckle - create pre and post hooks

Hook-Heckle documentation Contained in the Hook-Heckle distribution.

Index

Code Index:

NAME

Top

Hook::Heckle - create pre and post hooks

SYNOPSIS

Top

  use Hook::Heckle;

	my $notify = sub 
	{ 			
		my $this = shift;

		printf "Model is informing observers because '%s' change\n", $this->victim and $_[0]->notify_observers( 'update' ) if $_[1]; 

		@_;			
	};

	Hook::Heckle->new( context => 'InputField::String', victim => 'max', pre => sub { $_[0]->{aaa} = 1; }, post => $notify );

	Hook::Heckle->new( context => 'InputField::String', victim => 'text', post => $notify );

DESCRIPTION

Top

Creating hooks to subroutines is issued by many other cpan modules. See

But this didnt kept me from writing a new one. It is a base class and can be inherited.

CLASSES

Hook::Heckle

PROPERTIES

Any property has a method and parameter to new counterpart.

victim

The method or subroutine to hook at.

context (default: main)

Package name of the method or subroutine.

pre( $this, @_ )

Reference to sub which will be called before execution of the victim. First argument will be the Hook::Heckel object and second the original arguments of the victim.

post( $this, @_ )

Reference to sub which will be called after execution of the victim. First argument will be the Hook::Heckel object and second the original arguments of the victim.

result

Array of the result from the victim.

METHODS

None.

EXPORT

None by default.

AUTHOR

Top

Murat Uenalan, <muenalan@cpan.org>

SEE ALSO

Top

Class::Hook, Hook::Scope, Hook::WrapSub, Hook::LexWrap, Hook::PrePostCall and Class::Maker.

Hook-Heckle documentation Contained in the Hook-Heckle distribution. 
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__