Когда я должен использовать атрибуты подпрограммы?

Question

Я вообще не получаю атрибуты подпрограммы Perl.

Я никогда не видел их в реальном коде, и perldoc perlsub и perldoc attributes не работаютчтобы ответить на мои вопросы:

• Для чего нужны атрибуты?
• Что они приносят в таблицу, которой еще нет в лучших практиках Perl?
• Есть ли какие-либо CPAN-модули (хорошо известные или иные), которые используют атрибуты?

Было бы здорово, если бы кто-то смог собрать подробный пример использования атрибутов так, как они должны быть.

---

Для тех, кто столь же невежественен, как и я, атрибуты - это параметры после двоеточия в attributes SYNOPSIS примерах ниже:

sub foo : method ;
my ($x,@y,%z) : Bent = 1;
my $s = sub : method { ... };

use attributes ();  # optional, to get subroutine declarations
my @attrlist = attributes::get(\&foo);

use attributes 'get'; # import the attributes::get subroutine
my @attrlist = get \&foo;

Answer 1

Атрибуты позволяют вам аннотировать переменные для выполнения автоматической магии за кулисами. Аналогичная концепция - Java-аннотации . Вот небольшой пример, который может помочь. Он использует Attribute::Handlers для создания атрибутов loud.

use Attribute::Handlers;

sub UNIVERSAL::loud : ATTR(CODE) {
    my ( $pkg, $sym, $code ) = @_;
    no warnings 'redefine';
    *{$sym} = sub {
        return uc $code->(@_);
    };
}

sub foo : loud {
    return "this is $_[0]";
}

say foo("a spoon");
say foo("a fork");

Всякий раз, когда подпрограмма объявляется с атрибутом loud, обратный вызов UNIVERSAL::loud вызывает раскрытие метаинформации в подпрограмме. Я переопределил функцию для фактического вызова анонимной подпрограммы, которая, в свою очередь, вызывает исходную подпрограмму и передает ее uc

Это выводит:

THIS IS A SPOON
THIS IS A FORK

Теперь давайте рассмотрим пример переменной из SYNOPSIS :

my ($x,@y,%z) : Bent = 1;

Разбивая это на небольшой оператор perl, не принимая во внимание атрибуты, которые мы имеем

my $x : Bent
$x = 1;

my @y : Bent
@y = 1;

my %Z : Bent
%z = 1;

Теперь мы можем видеть, что каждой переменной кратко приписывается аннотация Bent, а также присваивается всем переменным значение 1. Вот, пожалуй, более интересный пример:

use Attribute::Handlers;
use Tie::Toggle;

sub UNIVERSAL::Toggle : ATTR(SCALAR) {
    my ($package, $symbol, $referent, $attr, $data, $phase) = @_;
    my @data = ref $data eq 'ARRAY' ? @$data : $data;
    tie $$referent, 'Tie::Toggle', @data;
}

my $x : Toggle;

say "x is ", $x;
say "x is ", $x;
say "x is ", $x;

Какие выходы:

x is 
x is 1
x is 

Вы можете использовать это для ведения журналов, создания тестовых аннотаций, добавления деталей типа к переменным, синтаксического сахара, создания ролевых композиций в стиле «лось» и многих других интересных вещей.

Также смотрите этот вопрос: Как работают атрибуты метода Perl? .

Answer 2

• Для чего нужны атрибуты?

Это способ передачи некоторой дополнительной информации (атрибута) о переменной или подпрограмме.

Вы можете поймать этоинформацию (атрибут) в виде строки (в COMPILE TIME!) и обрабатывать ее так, как вам нравится.Вы можете создать дополнительный код, изменить тайники ....Это зависит от вас.

• Что они несут за столом, которого еще нет в лучших практиках Perl?

Иногда это облегчает жизнь.См. Пример ниже.

Некоторые люди используют его.Сделай: найди.-имя * .p [мл] |xargs grep 'использовать атрибуты;'на вашем пути установки Perl, чтобы посмотреть на пакеты, используя атрибуты.Catalyst широко использует атрибуты для обработки запросов на основе заданного пути.

Пример :

Скажем, вы хотите выполнять подпрограммы в определенном порядке.И вы хотите сообщить подпрограмме, когда она должна выполняться (по номеру прогона RUNNR).Используя атрибуты, реализация может быть:

#!/usr/bin/env perl

use strict;
use warnings;

use Runner;     # immplements the attribute handling

# some subroutines to be scheduled :
# attibutes automatically filling @$Runner::schedule 
sub func_a : RUNNR(2) {return "You called func_a !"};
sub func_b : RUNNR(1) {return "You called func_b !"};
sub func_c : RUNNR(3) {return "You called func_c !"};

# run the subroutines according to the their RUNNR
sub run {
    # @$Runner::schedule holds the subroutine refs according
    # to their RUNNR
    foreach my $func (@$Runner::schedule) {
       if ( defined $func ) {
         print "Running : $func --> ", $func->(), "\n";
       }
    }
}

print "Starting ...\n\n";
run();
print "\nDone !\n";

Обработка атрибутов в пакете Runner с использованием хука MODIFY_CODE_ATTRIBUTES.

package Runner;

use strict;
use warnings;

use attributes;

BEGIN {
    use Exporter ();                                                                 
    our (@ISA, @EXPORT);       

    @ISA         = qw(Exporter);                 
    @EXPORT      = qw(&MODIFY_CODE_ATTRIBUTES);    # needed for use attributes;    
}

# we have subroutines with attributes : <type> is CODE in MODIFY_<type>_ATTRIBUTES
# MODIFY_CODE_ATTRIBUTES is executed at COMPILE TIME ! try perl -c <prog_name> to prove it :-)

sub MODIFY_CODE_ATTRIBUTES {
    # for each subroutine of a package we get
    # the code ref to it and the attribute(s) as string
    my ($pckg, $code_ref, @attr) = @_;

    # whatever you like to do with the attributes of the sub ... do it
    foreach my $attr (@attr) {
        # here we parse the attribute string(s), extract the number and 
        # save the code ref of the subroutine
        # into $Runner::schedule array ref according to the given number
        # that is how we 'compile' the RUNNR of subroutines into 
        # a schedule
        if ( $attr =~ /^RUNNR\((\d+)\)$/ ) {    
            $Runner::schedule->[$1] = $code_ref;     
        }
    }
    return(); # ERROR if returning a non empty list
}

1;

Вывод будет:

Starting ...

Running : CODE(0x129c288) --> You called func_b !
Running : CODE(0x129c2b8) --> You called func_a !
Running : CODE(0x12ed460) --> You called func_c !

Done !

Если вы действительно хотите понять, что делают атрибуты, и когда что происходит, вам нужно «атрибуты perldoc», прочитайте это шаг за шагом и поиграйте с ним.Интерфейс громоздок, но в принципе вы подключаетесь во время компиляции и обрабатываете предоставленную информацию.

Answer 3

Вы можете использовать атрибуты для tie переменной при создании. Посмотрите на глупый модуль Tie::Hash::Cannabinol, который позволяет вам:

use Tie::Hash::Cannabinol;

my %hash;
tie %hash, 'Tie::Hash::Cannabinol';

## or ##

my %hash : Stoned;

Редактировать: при более глубоком рассмотрении T :: H :: C (хе-хе) тоже использует Attribute::Handlers (как уже предлагает ответ JRideout), так что, возможно, это то место, куда стоит заглянуть.

Answer 4

Вот пример, который я запустил на Perl 5.26.1 с Carp :: Assert.Атрибуты Perl, кажется, генерируют хороший синтаксис для шаблона декоратора.Было немного неприятно реализовать MODIFY_CODE_ATTRIBUTES, хотя bc этого проклятого eval и Perl автоматически подсчитывают ссылки.

use strict;
use Carp::Assert;


# return true if `$func` is callable, false otherwise 
sub callable {
   my ($func) = @_;
   return defined(&$func);
}

# get the symbol table hash (stash) and the inverse of it the
# coderef table hash (crtash) where coderefs are keys and symbols are
# values. The return value is a pair of hashrefs ($stash, $crtash)
sub get_stash_and_crtash {
   my $stash = eval("\\%" . __PACKAGE__ . "::");
   my %coderef_to_sym;
   while (my ($k, $v) = each(%$stash)) {
      $coderef_to_sym{$v} = $k if (callable($v)); 
   }
   return ($stash, \%coderef_to_sym);
}

# return an eval string that inserts `$inner` as the first argument
# passed into the function call string `$outer`. For example, if
# `$inner` is "$foo" (the lvalue NAME, not the lvalue itself), and 
# `$outer` is "bar(1)", then the resulting eval string will be 
# "bar($foo, 1)"
sub insert_context {
   my ($inner, $outer) = @_;
   my $args_pat = qr/\((.*)\)$/;

   $outer .= '()' if ($outer !~ /\)$/);
   $outer =~ /$args_pat/;
   $1 ? 
      $outer =~ s/$args_pat/($inner, $1)/ : 
      $outer =~ s/$args_pat/($inner)/;
   return $outer;
}

# hook that gets called when appending attributes to functions.
# `$cls` is the package at the point of function declaration/definition,
# `$ref` is the coderef to the function being declared/defined,
# `@attrs` is a list to the attributes being added. Attributes are function
# call strings.
sub MODIFY_CODE_ATTRIBUTES {
   my ($cls, $ref, @attrs) = @_;

   assert($cls eq 'main');
   assert(ref($ref) eq 'CODE');
   for (@attrs) {
      assert(/^appender_d\(.*\)$/ || $_ eq 'upper_d');
   }

   my @non_decorators = grep { !/^\w+_d\b/ } @attrs;
   return @non_decorators if (@non_decorators);

   my ($stash, $crtash) = get_stash_and_crtash();

   my $sym = $crtash->{$ref};

   $stash->{$sym} = sub { 
      my $ref = $ref;
      my $curr = '$ref';

      for my $attr (@attrs) {
         $curr = insert_context($curr, $attr);
      }
      eval("${curr}->()");
   };

   return ();
}

sub appender_d {
   my ($func, $chars) = @_;
   return sub { $func->() . $chars };
}

sub upper_d {
   my ($func) = @_;
   return sub { uc($func->()) };
}

sub foo : upper_d appender_d('!') {
   return "foo";
}

sub main {
   print(foo());
}

main();