Передача скалярного / списка контекста вызываемой подпрограмме

Question

Я пытаюсь написать подпрограмму, которая принимает параметр coderef. Моя подпрограмма выполняет некоторую инициализацию, вызывает coderef, затем выполняет некоторую очистку.

Мне нужно вызвать coderef, используя тот же контекст (скаляр, список, пустой контекст), в который был вызван мой sub. Единственный способ, которым я могу думать, это что-то вроде этого:

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

    # do some initialization...

    my @ret;
    my $ret;

    if (not defined wantarray) {
        $code->();
    } elsif (wantarray) {
        @ret = $code->();
    } else {
        $ret = $code->();
    }

    # do some cleanup...

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

Очевидно, что в этом коде много избыточности. Есть ли способ уменьшить или устранить любую из этих избыточностей?

EDIT Позже я понял, что мне нужно запустить $code->() в блоке eval, чтобы очистка выполнялась, даже если код умирает. Добавление поддержки eval и объединение предложений user502515 и cjm, вот что я придумал.

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->()) });
}

Это избавляет от избыточности, хотя, к сожалению, теперь контролировать поток управления немного сложнее.

Answer 1

Проверьте модуль Contextual :: Return на CPAN.Я думаю, что это позволяет вам делать то, что вы хотите (и, вероятно, намного больше).

Answer 2

Думаю, я бы сделал это так:

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

У вас все еще есть две проверки wantarray, но тогда вашей функции cleanup понадобится одна проверка для правильного возврата значения(s) он был передан. Вам не нужно беспокоиться о случае undef во второй проверке, потому что в этом случае не имеет значения, что возвращает perform.

Answer 3

Вы можете исключить случай !defined wantarray на ранней стадии, так как очистка не требуется (так как результат $code->(), если он есть, не был сохранен).Это удаляет один случай из оставшейся функции, делая его более простым.

Во-вторых, вы можете переместить очищающий материал в его собственную функцию.Нечто подобное пришло мне в голову:

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