Fukurama::Class::Attributes::OOStandard::Decorator - Helper-class to decorate subroutines

Fukurama-Class documentation

Contained in the Fukurama-Class distribution.

Index

NAME
VERSION
SYNOPSIS
DESCRIPTION
EXPORT
METHODS
- decorate( method_identifier:STRING, actual_code_reference:\CODE, definition_checker:CLASS) return:VOID
- remove_decoration( method_identifier:STRING, actual_code_reference:\CODE ) return:VOID
AUTHOR, BUGS, SUPPORT, ACKNOWLEDGEMENTS, COPYRIGHT & LICENSE

Code Index:

package Fukurama::Class::Attributes::OOStandard::Decorator
- decorate
- remove_decoration
EOF

NAME

Fukurama::Class::Attributes::OOStandard::Decorator - Helper-class to decorate subroutines

VERSION

Version 0.02 (beta)

SYNOPSIS

 package MyClass;
 use Fukurama::Class::Attributes::OOStandard::Decorator();
 my $helper = 'Fukurama::Class::Attributes::OOStandard::DefinitionCheck';

 Fukurama::Class::Attributes::OOStandard::Decorator->decorate('CGI::param', \&CGI::param, $helper);

DESCRIPTION

A Helper class for Fukurama::Class::Attributes::OOStandard::DefinitionCheck to decorate subroutines with a subroutine to check parameters and return values and remove the decoration.

EXPORT

-

METHODS

decorate( method_identifier:STRING, actual_code_reference:\CODE, definition_checker:CLASS) return:VOID: Decorates the given method with some parameter and return value checks.
remove_decoration( method_identifier:STRING, actual_code_reference:\CODE ) return:VOID: Remove existing decorations for parameter and return value checks.

AUTHOR, BUGS, SUPPORT, ACKNOWLEDGEMENTS, COPYRIGHT & LICENSE

see perldoc of Fukurama::Class

Fukurama-Class documentation

Contained in the Fukurama-Class distribution.

package Fukurama::Class::Attributes::OOStandard::Decorator;
use Fukurama::Class::Version(0.02);
use Fukurama::Class::Rigid;

use Fukurama::Class::HideCaller;
Fukurama::Class::HideCaller->register_class(__PACKAGE__);

# STATIC void
sub decorate {
	my $class = $_[0];
	my $identifier = $_[1];
	my $old = $_[2];
	my $helper = $_[3];
	
	no strict 'refs';
	no warnings 'redefine';
		
	*{$identifier} = sub {
		$helper->try_check_call($identifier, $_[0]);
		$helper->try_check_access($identifier);
		$helper->try_check_abstract($identifier);
		$helper->try_check_parameter($identifier, [@_[1..$#_]]);
			
		my $context = wantarray();
		if($context) {
			my @result = &$old;
			$helper->try_check_result($identifier, \@result, $context);
			return @result;
		} elsif(defined($context)) {
			my $result = &$old;
			$helper->try_check_result($identifier, [$result], $context);
			return $result;
		} else {
			goto &$old;
		}
	};
	return;
}
# STATIC void
sub remove_decoration {
	my $class = $_[0];
	my $identifier = $_[1];
	my $old = $_[2];
	
	no strict 'refs';
	no warnings 'redefine';
	
	*{$identifier} = $old;
	return;
}
1;