view release on metacpan or  search on metacpan

lib/Aion/Spirit.pm  view on Meta::CPAN

use Sub::Util qw//;

#@category Аспект-ориентированное программирование

# Оборачивает функции в пакете в указанную по регулярке. 
# Имя функции идёт вместе с пакетом
sub aroundsub($$;$) {
	my ($pkg, $re, $around) = @_==3? @_: (scalar caller, @_);
	my $x = \%{"${pkg}::"};

	for my $g (values %$x) {
		next if ref \$g ne "GLOB";
		my $sub = *{$g}{CODE};

		if($sub && Sub::Util::subname($sub) =~ $re) {
			*$g = wrapsub($sub => $around);
		}
	}
}

# Оборачивает функцию в другую
sub wrapsub($$) {
	my ($sub, $around) = @_;

	my $s = sub { unshift @_, $sub; goto &$around };

	my $subname = Sub::Util::subname $sub;

	Sub::Util::set_subname "${subname}__AROUND" =>
	Sub::Util::set_prototype Sub::Util::prototype($sub) => $s;

	$s
}

#@category Проверки

# assert
sub ASSERT ($$) {
	die "ASSERT: ".(ref $_[1]? $_[1]->(): $_[1])."\n" if !$_[0];
}

#@category Списки

# Ищет в списке первое совпадение и возвращает индекс найденного элемента
sub firstidx (&@) {
	my $s = shift;

	my $i = 0;
	for(@_) {
		return $i if $s->();
		$i++;
	}
	return undef;
}

1;

__END__

=encoding utf-8

=head1 NAME

Aion::Spirit - functions for controlling the program execution process

=head1 VERSION

0.0.1

=head1 SYNOPSIS

	use Aion::Spirit;
	
	package A {
	    sub x_1() { 1 }
	    sub x_2() { 2 }
	    sub y_1($) { 1+shift }
	    sub y_2($) { 2+shift }
	}
	
	aroundsub "A", qr/_2$/, sub { shift->(@_[1..$#_]) + .03 };
	
	A::x_1     # -> 1
	
	# Perl cached subroutines with prototype "()" in main:: as constant. aroundsub should be applied in a BEGIN block to avoid this:
	A::x_2         # -> 2
	(\&A::x_2)->() # -> 2.03
	
	# Functions with parameters not cached:
	A::y_1 .5  # -> 1.5
	A::y_2 .5  # -> 2.53

=head1 DESCRIPTION

A Perl program consists of packages, globals, subroutines, lists, and scalars. That is, it is simply data that, unlike a C program, can be “changed on the fly.”

Thus, this module provides convenient functions for transforming all these entities, as well as maintaining their integrity.

=head1 SUBROUTINES

=head2 aroundsub ($pkg, $re, $around)

Wraps the functions in the package in the specified regular sequence.

The package may not be specified for the current:

File N.pm:

	package N;
	
	use Aion::Spirit qw/aroundsub/;
	
	use constant z_2 => 10;
	
	aroundsub qr/_2$/, sub { shift->(@_[1..$#_]) + .03 };
	
	sub x_1() { 1 }
	sub x_2() { 2 }
	sub y_1($) { 1+shift }
	sub y_2($) { 2+shift }