Aion-Spirit
view release on metacpan or search on metacpan
lib/Aion/Spirit.pm view on Meta::CPAN
#@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 }
1;
use lib ".";
use N;
N::x_1 # -> 1
N::x_2 # -> 2.03
N::y_1 0.5 # -> 1.5
N::y_2 0.5 # -> 2.53
=head2 wrapsub ($sub, $around)
Wraps a function in the specified.
sub sum(@) { my $x = 0; $x += $_ for @_; $x }
BEGIN {
*avg = wrapsub \&sum, sub { my $x = shift; $x->(@_) / @_ };
}
avg 1,2,5 # -> (1+2+5) / 3
Sub::Util::subname \&avg # => main::sum__AROUND
=head2 ASSERT ($ok, $message)
This is assert. This is checker scalar by nullable.
my $ok = 0;
ASSERT $ok == 0, "Ok";
eval { ASSERT $ok, "Ok not equal 0!" }; $@ # ~> Ok not equal 0!
( run in 0.518 second using v1.01-cache-2.11-cpan-13bb782fe5a )