Perl: Define variable in caller context

Question

I have created this simple subroutine.

use List::Util qw(pairmap);

sub pairGroupBy(&@) {
  my($irCode, @iaItems) = @_;

  my %laResult = ();
  pairmap {
    my $lsKey = $irCode->();
    if (!defined($lsKey)) {
      die "Trying to pairGroup by nonexisting key '$lsKey'";
    }
    push @{$laResult{$lsKey}}, $a => $b;
  } @iaItems;

  return %laResult;
}

It works well until the subroutine is used from the same file where it is defined. When I move it to some package then variables $a and $b becomes undefined inside the $irCode->() callback.

I have learned from the List::Util source code that this code do the trick:

my $caller = caller;
local(*{$caller."::a"}) = \my $a;
local(*{$caller."::b"}) = \my $b;

So I'have modified my subroutine in this way:

use List::Util qw(pairmap);

sub pairGroupBy(&@) {
  my($irCode, @iaItems) = @_;

  my $caller = caller;

  my %laResult = ();
  pairmap {

    no strict 'refs';
    local(*{$caller."::a"}) = \$a; # <---- the line 96
    local(*{$caller."::b"}) = \$b;

    my $lsKey = $irCode->();
    if (!defined($lsKey)) {
      die "Trying to pairGroup by nonexisting key '$lsKey'";
    }
    push @{$laResult{$lsKey}}, $a => $b;
  } @iaItems;

  return %laResult;
}

But I need to use the no strict 'refs'; line (the List::Util source code does not use it). Otherwise the error message appears:

Can't use string ("main::a") as a symbol ref while "strict refs" in use at /home/.../bin/SatFunc.pm line 96.

My question is: Is there some better way how to define $a and $b variables in the caller's context without using no strict 'refs';?

I want my function will be used in the same way as pairmap, pairgrep etc.

EDIT: @simbabque asked for an example, how the function is used. So this is an example:

my %laHoH = (
  aa => {
    color => 'yellow',
    item => 'sun',
    active => 1
  },
  bb => {
    color => 'blue',
    item => 'sky',
    active => 1
  },
  cc => {
    color => 'green',
    item => 'grass',
    active => 0
  },
  dd => {
    color => 'blue',
    item => 'watter',
    active => 1
  }
);


my %laGrouped = pairGroupBy {
  $b->{color}
} pairgrep {
  $b->{active}
} %laHoH;

The function then returns this structure:

{
  'yellow' => [
                'aa',
                {
                  'color' => 'yellow',
                  'item' => 'sun',
                  'active' => 1
                }
              ],
  'blue' => [
              'dd',
              {
                'active' => 1,
                'item' => 'watter',
                'color' => 'blue'
              },
              'bb',
              {
                'color' => 'blue',
                'item' => 'sky',
                'active' => 1
              }
            ]
};

Answer 1

Is there some better way how to define $a and $b variables in the caller's context without using no strict 'refs';?

You're asking us how to perform symbolic dereferences while asking Perl to prevent you from symbolic deferences. There's no reason to do that. If you want to perform symbolic dereferences, don't ask Perl to prevent you from doing it.

Even if Perl doesn't catch you doing it (i.e. if you manage to find a way to not trigger use strict qw( refs );), you'll still be using symbolic dereferences! You'd just be lying to yourself and to your readers.

Instead, it's best to document what you are doing. Use no strict qw( refs ); to signal that you are using doing something use strict qw( refs ); is suppose to block.

---

The following approach for building the same structure as your code is much less wasteful:

my %laGrouped;
for my $key (keys(%laHoH)) {
   my $rec = $laHoH{$key};
   next if !$rec->{active};
   push @{ $laGrouped{ $rec->{color} } }, $key, $rec;
}

But let's improve the structure as well. The following approach produces a structure that's easier to use:

my %laGrouped;
for my $key (keys(%laHoH)) {
   my $rec = $laHoH{$key};
   next if !$rec->{active};
   $laGrouped{ $rec->{color} }{$key} = $rec;
}

---

If you find yourself using pairGroupBy, you've probably went wrong somewhere. But here's a better implementation of it for educational purposes:

sub pairGroupBy(&@) {
   my $cb = shift;

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

   my %groups;
   while (@_) {
      *$ap = \shift;
      *$bp = \shift;
      my $group = $cb->();
      push @{ $groups{$group} }, $a, $b;
   }

   return %groups;
}

Answer 2

I'm not sure why you're seeing that problem, but I suspect you're overthinking matters. Using pairmap in void context like that seems a bad idea.

Can't you just convert your array into a hash and then iterate across that?

my %iaItemsHash = @iaItams;

while (my ($k, $v) = each %iaItemsHash) {
  my $lsKey = $irCode->();
  if (!defined($lsKey)) {
    die "Trying to pairGroup by nonexisting key '$lsKey'";
  }
  push @{$laResult{$lsKey}}, $k => $v;
}

Update: In light of your comment, I've re-read your original question and spotted that you are talking about accessing the variables with the $irCode->() call.

The problem with my solution is that $k and $v are lexical variables and, therefore, aren't available outside of their lexical scope (this is generally seen as a feature!) The solution is to resort to good programming practice and to send the values into the subroutine as parameters.