-=cut
-
-sub _check_name {
- my $name = $_[0];
- croak 'No subroutine specified' unless $name;
- my $proto;
- my $r = ref $name;
- if (!$r) {
- $proto = prototype $name;
- } elsif ($r eq 'HASH') {
- croak 'Forced prototype hash reference must contain exactly one key/value pair' unless keys %$name == 1;
- ($name, $proto) = %$name;
- } else {
- croak 'Unhandled ' . $r . ' reference as first argument';
- }
- $name =~ s/^\s+//;
- $name =~ s/[\s\$\@\%\*\&;].*//;
- return $name, $proto;
-}
-
-sub recall {
- my ($name, $proto) = _check_name shift;
- my $call = $name . '(';
- my @cr;
- if (defined $proto) {
- my $i = 0;
- while ($proto =~ /(\\?)(\[[^\]]+\]|[^\];])/g) {
- my $p = $2;
- if ($1) {
- my $r = _check_ref $_[$i], $p;
- $call .= $sigils{$r} . '{$_[' . $i . ']},';
- } elsif ($p =~ /[\@\%]/) {
- $call .= '@_[' . $i . '..' . (@_ - 1) . ']';
- last;
- } elsif ($p =~ /\&/) {
- push @cr, $_[$i];
- $call .= 'sub{&{$cr[' . $#cr . ']}},';
- } elsif ($p eq '_' && $i >= @_) {
- $call .= '$_,';
- } else {
- $call .= '$_[' . $i . '],';
- }
- ++$i;
- }
- $call =~ s/,$//;
- } else {
- $call .= join ',', map '$_[' . $_ . ']', 0 .. @_ - 1;
- }
- $call .= ');';
- my @ret = eval $call;
- croak $@ if $@;
- return @ret;
-}
-
-=head2 C<wrap $name, %opts>
-
-Generates a wrapper that does the same thing as L</recall>, but specialized for a given function. This wrapper can be compiled once for all to avoid calling C<eval> at each run (like L</recall> does). You can still force the prototype by passing C<< { $name => $proto } >> as the first argument. Others arguments are seen as key / value pairs and tune the code generated by L</wrap>. Valid keys are :