Pass scalar/list context to called subroutine

I'm trying to write a sub that takes a coderef parameter. My sub does some initialization, calls the coderef, then does some cleanup.

I need to call the coderef using the same context (scalar, list, void context) that my sub was called in. The only way I can think of is something like this:

sub perform {
    my ($self, $code) = @_;

    # do some initialization...

    my @ret;
    my $ret;

    if (not defined wantarray) {
        $code->();
    } elsif (wantarray) {
        @ret = $code->();
    } else {
        $ret = $code->();
    }开发者_JAVA百科

    # do some cleanup...

    if (not defined wantarray) {
        return;
    } elsif (wantarray) {
        return @ret;
    } else {
        return $ret;
    }
}

Obviously there's a good deal of redundancy in this code. Is there any way to reduce or eliminate any of this redundancy?

EDIT   I later realized that I need to run $code->() in an eval block so that the cleanup runs even if the code dies. Adding eval support, and combining the suggestions of user502515 and cjm, here's what I've come up with.

sub perform {
    my ($self, $code) = @_;

    # do some initialization...

    my $w = wantarray;
    return sub {
        my $error = $@;

        # do some cleanup...

        die $error if $error;   # propagate exception
        return $w ? @_ : $_[0];
    }->(eval { $w ? $code->() : scalar($code->()) });
}

This gets rid of the redundancy, though unfortunately now the control flow is a little harder to follow.

---

Check out the Contextual::Return module on CPAN. I think it allows you to do what you want (and probably a whole lot more).

---

You can exclude the !defined wantarray case early, because there is no cleanup to do (since $code->()'s result, if any, wasn't stored). That removes one case from the remaining function, making it simpler.

Second, you can move the cleanup stuff into its own function. Something like this came to my mind:

sub perform
{
    my($self, $code) = @_;
    if (!defined(wantarray)) {
            $code->();
            return;
    }
    return wantarray ? &cleanup($code->()) : &cleanup(scalar($code->()));
}

---

I think I'd do it like this:

sub perform {
    my ($self, $code) = @_;

    # do some initialization...

    my @ret;
    if (not defined wantarray) {
        $code->();
    } else {
        @ret = wantarray ? $code->() : scalar $code->();
    }

    # do some cleanup...

    return wantarray ? @ret : $ret[0];
}

You still have two wantarray checks, but then your cleanup function was going to need one in order to correctly return the value(s) it was passed in. You don't need to worry about the undef case in the second check, because in that case it doesn't matter what perform returns.