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 annotations。这是一个可能有用的小例子。它使用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属性声明sub时，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

您可以使用它来进行记录，创建测试注释，向变量添加类型详细信息，语法糖，做驼鹿角色组合以及许多其他很酷的事情。

另请参阅此问题：How do Perl method attributes work?。

Answer 2

哪些属性有用？

这是一种传递一些额外信息的方法（属性）关于变量或子程序。

您可以将此信息（属性）作为字符串捕获（在COMPILE TIME！）并按照你喜欢的方式处理它。您可以生成其他代码，修改藏匿......这取决于你。

他们为Perl最佳实践中尚未提供的表格带来了什么？

有时它会让生活更轻松。见下面的例子。

有些人使用它。做一个：找到。 -name * .p [ml] | 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";

属性处理使用MODIFY_CODE_ATTRIBUTES在包Runner中钩。

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

这是我使用Carp :: Assert在perl 5.26.1上运行的示例。 Perl属性似乎为装饰器模式生成了不错的语法。通过b.c实施MODIFY_CODE_ATTRIBUTES有点痛苦该死的评估和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();

我什么时候应该使用子程序属性？

4 个答案: