Storing the return value from a perl subroutine "as is"

Question

I need to wrap a sub so that it can trigger before/after events before returning its original return value. Everything works except if the coderef returns an array it will be cast to an arrayref. Sometimes I do want an arrayref so I can't just check the ref type and recast to an array. I've also tried using wantarray which is still returning an arrayref.

I'm currently trying to go about it like this

$owner->methods->each(sub { # Methods is a hash container where each entry is a mapping of a method name to its implementation (as a coderef)
    my ($key, $val) = @_;

    return if $key eq 'trigger' || $key eq 'triggerBefore' || $key eq 'before' || $key eq 'on'; # Ignore decorating keys that would cause infinite callbacks
    $owner->methods->set($key, sub { # Replace the original sub with a version that calls before and after events
      my ($obj, @args) = @_;

      $owner->triggerBefore($key, @args);
      my $return = $val->(@args); # Return could be anything...
      $owner->trigger($key, $return);
      return $return;
    });
  });

I've also tried replacing the return with the following to no avail:

return (wantarray && ref $return eq 'ARRAY') ? @$return : $return;

Everything works fine if I don't store the return value and instead return $val->(@args); (but then I lose the "after" trigger). Is there a way to store the return value "as is" rather than storing it in a scalar?

Contextual::Return might be worth a look

Sobrique
– Sobrique

2015-03-12 09:51:16 +00:00
Commented Mar 12, 2015 at 9:51 — Sobrique
– Sobrique, Commented Mar 12, 2015 at 9:51

pilcrow · Accepted Answer · 2015-03-12 13:13:11Z

If I understand correctly, your original subroutine returns an array when called in a list context, and an arrayref when called in a scalar context.

You need to invoke the wrapped sub in the same calling context as the caller provides, and store and later return its returned value as appropriate. This has the added advantage of letting a context-aware sub skip lengthy calculations when, for example, invoked in a void context.

This complicates the wrapping a bit. You probably also want to pass in @_, in case the sub makes any modifications there, too:

sub {
  ...
  my $wa = wantarray;
  my @ret;

  ... trigger_before() ...

  unless (defined($wa)) {           # void
    $original_sub->(@_);
  } elsif (not $wa) {               # scalar
    $ret[0] = $original_sub->(@_);
  } else {                          # list
    @ret = $original_sub->(@_);
  }

  ... trigger_after() ...

  return unless defined($wa);
  return $wa ? @ret : $ret[0];
}

Collectives™ on Stack Overflow

Storing the return value from a perl subroutine "as is"

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related