How to make a function that takes a block which requires $a and $b but is in different package than-CodePudding

So I was generating a subroutine that takes a predicate which implicitly creates the $a and $b variables to be used in that predicate. Unfortunately, when I started to use classes and an indirection to that subroutine, things didn't go according to plan.

I determined that the reason was that the predicate was generated in a different package from the indirect subroutine call, so the caller was not the same package as the predicate's package scope.

Here is an example of what I am referring to:

use strict;
use warnings;

sub find(&$\@) {
  my ($pred, $find, $list) = @_;
  my $caller = caller;
  no strict q"refs";
  local *{ "${caller}::a" } = \$find;
  for my $i (0..$#$list) {
    local *{ "${caller}::b" } = \$list->[$i];
    return $i if $pred->();
  }
  return -1;
}

sub indirectFind(&$\@) {
  my ($pred, $find, $list) = @_;
  return find(\&$pred, $find, @$list);
}

package foo;
sub new {
  my ($class) = @_;
  my $self = [ 1, 2, 3 ];
  bless $self, $class;
  return $self;
}
sub find {
  my ($self, $find) = @_;
  return main::find { $a == $b } $find, @$self;
}
sub indirectFind {
  my ($self, $find) = @_;
  return main::indirectFind { $a == $b } $find, @$self;
}

package main;
my $foo = foo->new;
print find { $a == $b } 1, @$foo; # works
print "\n";
print $foo->find(1)."\n";         # works
print $foo->indirectFind(1)."\n"; # does not work

How do I get this to work properly, regardless if the call is indirect or not?

CodePudding user response：

The trick is to get the package name of the function that is being called so that the variables $a and $b can be injected into that package.

Replacing the original find subroutine:

use Sub::Util qw(subname);
sub find(&$\@) {
  my ($pred, $find, $list) = @_;
  # get the package that &$pred belongs to
  my ($pkg) = subname($pred) =~ /^([^:] )/;
  no strict q"refs";
  local *{ "${pkg}::a" } = \$find;
  for my $i (0..$#$list) {
    local *{ "${pkg}::b" } = \$list->[$i];
    return $i if $pred->();
  }
  return -1;
}

The calls will now all work.

package main;
my $foo = foo->new;
print find { $a == $b } 1, @$foo; # works
print "\n";
print $foo->find(1)."\n";         # works
print $foo->indirectFind(1)."\n"; # works

CodePudding user response：

You can get the package associated using a code ref using

use B qw( svref_2object );

my $pkg = svref_2object( $pred )->STASH->NAME;

So,

use B qw( svref_2object );

sub find(&$@) {
   my $pred = shift;
   my $find = shift;

   my $pkg = svref_2object( $pred )->STASH->NAME;

   my $ap = do { no strict 'refs'; \*{$pkg.'::a'} };  local *$ap = \$find;
   my $bp = do { no strict 'refs'; \*{$pkg.'::b'} };  local *$bp;

   for my $i ( 0 .. $#_ ) {
      *$bp = \( $_[ $i ] );
      return $i if $pred->();
   }

   return -1;
}