package Sub::Apply;
use 5.008008;
use strict;
use warnings;
use parent 'Exporter';
use Carp ();
our $VERSION = '0.06';
our @EXPORT_OK = qw(apply apply_if);
our $WARNING = 0;
sub apply {
my $orig = shift;
my $caller = caller;
my $proc = _find_proc( $caller, $orig );
Carp::croak "No such proc $orig" unless $proc;
$proc->(@_);
}
sub apply_if {
my $orig = shift;
my $caller = caller;
my $proc = _find_proc( $caller, $orig );
unless ( $proc ) {
Carp::carp "No such proc $orig" if $WARNING;
return;
}
$proc->(@_);
}
sub _find_proc {
my ( $caller, $proc ) = @_;
( my $package, $proc ) = $proc =~ m/^(?:(.+)::)?(.+)$/;
$package ||= $caller;
my $code = do {
no strict 'refs';
my $stash = \%{ $package . '::' };
$stash && $stash->{$proc} && *{ $stash->{$proc} }{CODE};
};
return $code;
}
1;
__END__
=head1 NAME
Sub::Apply - apply arguments to proc.
=head1 SYNOPSIS
use Sub::Apply qw(apply apply_if);
{
my $procname = 'sum';
my $sum = apply( $procname, 1, 2, 3);
}
{
my $procname = 'sum';
my $sum = apply_if( $procname, 1, 2, 3);
# not die if $procname does not exist.
}
=head1 DESCRIPTION
Sub::Apply provides function C<apply> and C<apply_if>. This function apply arguments to proc.
This module is designed for B<function call>. If you want to call B<class method> or B<instance method>, I recommend you to use C<UNIVERSAL#can>.
=head1 EXPORT_OK
apply, apply_if
=head1 FUNCTION
=head2 apply($procname, @args)
Apply @args to $procname. If you want to call function that not in current package, you do like below.
apply('Foo::sum', 1, 2)
This method looks up a function using symbol table and call it. But this function B<DOES NOT USE @ISA> to look up. This behavior is same as perl funciton call style.
=head2 apply_if($procname, @args)
Same as apply. But apply_if does not die unless $procname does not exist.
You can set C<$Sub::Apply::WARNING=1> for debugging.
=head1 WARNING
C<apply> and C<apply_if> cannot call CORE functions.
=head1 AUTHOR
Yoshihiro Sasaki, E<lt>ysasaki at cpan.org<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2011 by Yoshihiro Sasaki
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut