perl - funciones - ¿Cuándo debo usar los atributos de subrutina?

funciones en perl

Question

No creo que los atributos de subrutina Perl en absoluto.

Nunca los he visto en código real y perldoc perlsub y los perldoc attributes no responden a mis preguntas:

• ¿Para qué son útiles los atributos?
• ¿Qué aportan a la mesa que aún no está presente en las mejores prácticas de Perl?
• ¿Hay algún módulo CPAN (conocido o no) que haga uso de atributos?

Sería fantástico si alguien pudiera juntar un ejemplo detallado de los atributos que se usan de la forma en que deberían ser.

Para aquellos que son tan despistados como yo, los atributos son los parámetros después de los dos puntos en los attributes SYNOPSIS ejemplos a continuación:

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

Aquí hay un ejemplo que ejecuté en Perl 5.26.1 con Carp :: Assert. Los atributos de Perl parecen generar una buena sintaxis para el patrón decorador. Fue un poco difícil implementar MODIFY_CODE_ATTRIBUTES a través de la maldita evaluación y el conteo automático de referencias de 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();

Answer 2

Los atributos te permiten anotar variables para realizar la magia automática entre bastidores. Un concepto similar son las anotaciones java . Aquí hay un pequeño ejemplo que podría ayudar. Utiliza Attribute::Handlers para crear los atributos 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");

Cada vez que se declara un sub con el atributo de UNIVERSAL::loud retorno de llamada UNIVERSAL::loud activa la metainformación del sub. Redefiní la función para llamar a un sub anónimo, que a su vez llama al sub original y lo pasa a uc

Esto produce:

THIS IS A SPOON
THIS IS A FORK

Ahora veamos un ejemplo de la variable de la SYNOPSIS :

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

Desglosando esto en una pequeña declaración de Perl sin tener en cuenta los atributos que tenemos

my $x : Bent
$x = 1;

my @y : Bent
@y = 1;

my %Z : Bent
%z = 1;

Ahora podemos ver que a cada variable se le ha atribuido la anotación Bent de una manera concisa, al tiempo que también se le asigna el valor 1. Aquí hay un ejemplo quizás más interesante:

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;

Qué salidas:

x is 
x is 1
x is 

Puede usar esto para hacer registros, crear anotaciones de prueba, agregar detalles de tipo a las variables, azúcar sintáctica, hacer la composición del rol de alces y muchas otras cosas interesantes.

También vea esta pregunta: ¿Cómo funcionan los atributos del método Perl? .

Answer 3

Puede utilizar atributos para tie una variable en la creación. Vea el módulo tonto Tie::Hash::Cannabinol que le permite hacer:

use Tie::Hash::Cannabinol;

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

## or ##

my %hash : Stoned;

Edición: tras un examen más profundo, T :: H :: C (jeje) también usa Attribute::Handlers (como sugiere la respuesta de JRideout), por lo que quizás ese sea el lugar para buscar.

Answer 4

• ¿Para qué son útiles los atributos?

Es una forma de pasar información adicional (el atributo) sobre una variable o subrutina.

Puede capturar esta información (el atributo) como una cadena (¡en TIEMPO DE COMPILACIÓN!) Y manejarla como desee. Puedes generar código adicional, modificar stashs .... Es tu decision.

• ¿Qué aportan a la mesa que aún no está presente en las mejores prácticas de Perl?

A veces hace la vida más fácil. Vea el ejemplo a continuación.

Algunas personas lo usan. Hacer un: encontrar. -nombre * .p [ml] | xargs grep ''usa atributos''; en la ruta de instalación de Perl para ver los paquetes que utilizan atributos. Catalyst usa extensivamente atributos para manejar solicitudes basadas en la ruta dada.

Ejemplo :

Digamos que te gusta ejecutar subrutinas en un cierto orden. Y quiere decirle a la subrutina cuando tiene que ejecutarse (por un número de ejecución RUNNR). Usando atributos la implementación podría ser:

#!/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";

El manejo de atributos está en el paquete Runner usando el gancho 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;

La salida será:

Starting ...

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

Done !

Si realmente desea comprender qué hacen los atributos y cuándo sucede lo que tiene que "perldoc", léalo paso a paso y juegue con él. La interfaz es complicada, pero en principio se conecta en tiempo de compilación y maneja la información proporcionada.