Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=433905&view=findpost&p=3888650 Mon, 27 Mar 2023 10:30:29 +0000 Атрибуты для подпрограмм. Пре- и пост-вычисления https://forum.sources.ru/index.php?showtopic=433905&view=findpost&p=3888650
    use Attribute::Handlers ;
     
    sub decorator( $\*&\@\@$$$ ):ATTR {
        my ( undef( ) , $symbol, $referent , undef( ) , $data ) = @_ ;
        my ( $before , $after ) = @$data ;
     
        *$symbol = sub {
            $after->( $referent->( $before->( @_ ) ) )
        }
    }
     
    sub c( $$ ):decorator(
        # before
        sub( $$ ) {
            warn 'before' ;
     
            pop( @_ ) + 111
        } ,
        # after
        sub( $ ) {
            warn 'after' ;
     
            pop( @_ ) + 1
        }
    ) {
        warn 'middle' ;
     
        pop( @_ ) + 1
    }
     
    print( __PACKAGE__->c( 123 ) ) ;


А то предлагали страшный-страшный код. Если присмотреться, то понятный, но выше ж гораздо читаемей и без доп.пакета:
    use Attribute::Handlers;
    use Sub::Name qw( subname );
     
    sub Wrap :ATTR(CODE) {
       my ( $pkg, $sym, $old_sub, $attr, $data, $phase, $fn, $ln ) = @_;
       my ( $before, $after ) = @$data;
     
       my $name = *{ $sym }{ NAME };
     
       my $new_sub = subname "wrapped_$name", sub {
          $before->( \@_ );
          my @rv = wantarray ? $old_sub->( @_ ) : scalar( $old_sub->( @_ ) );
          return $after->( \@_, @rv );
       };
     
       no warnings qw( redefine );
       *$sym = $new_sub;
    }
]]> Tishaishii Perl https://forum.sources.ru/index.php?showtopic=433905&view=findpost&p=3888633 Mon, 27 Mar 2023 06:48:29 +0000 Атрибуты для подпрограмм. Пре- и пост-вычисления https://forum.sources.ru/index.php?showtopic=433905&view=findpost&p=3888633
    use Attribute::Handlers ;
     
    sub decorator( $\*&\@\@$$$ ):ATTR {
        my ( $package , $symbol, $referent, $attr , $data, $phase, $filename, $linenum ) = @_ ;
        my ( $before , $after ) = @$data ;
     
        # before processing
        $before->( @_ ) ;
     
        # decorated sub
        my $result = $referent->( ) ;
     
        # after processing
        $after->( $result )
    }
     
    sub c( $$ ):decorator(
        # before
        sub( $\*&\@\@$$$ ) {
            warn 'before' ;
        } ,
        # after
        sub( $ ) {
            warn 'after' ;
     
            shift( @_ ) + 1
        }
    ) {
        warn 'middle' ;
     
        pop( @_ ) + 1
    }
     
    print( __PACKAGE__->c( 123 ) ) ;


Хочется создать декоратор для метода `main::c` с препроцессингом и постпроцессингом. Что-то идёт не так.
Ожидался вывод:
```
before
middle
after
125
```

Получаю:
```
before
middle
after
middle
124
```

А нужна обёртка вокруг `middle`.
Как это решается?]]> Tishaishii Perl