How to make a function that takes a block which requires $a and $b but is in different package than caller in perl?

user_1366368 0
Viewed 72

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 used an indirect call 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?

perl
2 Answers

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;
}
user_5899240

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 ); # less direct way to get package name
use B qw( svref_2object );     # more direct way to get package name
sub find(&$\@) {
  my ($pred, $find, $list) = @_;
  # get the package that &$pred belongs to
  # my ($pkg) = subname($pred) =~ /^(.+)::/;     # less direct
  my $pkg = svref_2object( $pred )->STASH->NAME; # more direct
  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
user_13663680
Related