[Rio-pm] atributos

[breno]

2008/12/19 Pedro Henrique <phikeda em gmail.com>:
> Amigos,
>
> estou aprendendo a usar atributos em Perl mas estou com problemas. Meu
> código, a partir da documentação do 'attributes', é esse:
>
> <code>
> use strict;
> use warnings;
> use attributes;
>
> sub MODIFY_CODE_ATTRIBUTES {
>     my ($class, $code, @attrs) = @_;
>
>     my $allowed = 'bar';
>     my @bad = grep { $_ ne $allowed } @attrs;
>
>     return @bad;
> }
>
> print "atributos de 'foo':\n";
> my @attrlist = attributes::get(\&foo);
> for (@attrlist) {
>     print "   atributo: $_ \n";
> }
> print "fim da lista.\n";
>
> sub foo :bar {
>     print "alo, mundo";
> }
> </code>
>
> Mas, ao contrário do que esperava, não consigo obter atributo algum:
>
> $ perl atributos.pl
> atributos de 'foo':
> fim da lista.
> $
>
>
> Alguém pode me dar uma luz? O que estou fazendo de errado?
>

PH, acho que alguns conceitos do uso de atributos não estão muito
firmes. É um tópico avançado e bastante complicado, que a própria
documentação pede cuidado. Mas vamos lá:

- quando usamos um atributo, o perl (note a caixa baixa) carrega
automaticamente o pragma "attributes", de modo que vc não precisa
chamá-lo explicitamente, a menos que vá usar o 'get'.

- o módulo attributes, até onde eu sei (e posso estar redondamente
enganado aqui) costuma ser usado apenas para tratar os atributos
built-in ("locked", "method" e "lvalue" para subrotinas, e "unique"
para variáveis globais). Assim, as rotinas embutidas de identificação
e retorno de atributos ("get") só funcionam para eles:

-------------------8<--------------------
use attributes;

my @attrlist = attributes::get \&foo;

print "atributos: @attrlist\n";

sub foo :locked {
    print "alo, mundo";
}
-------------------8<--------------------

[garu em bebop]$  perl atributos.pl
atributos: locked


- quando vc define seus próprios atributos para um módulo (em vez de
usar os built-ins), precisa definir também sua própria rotina de
identificação de atributos válidos/inválidos, e isso é feito a partir
da sub MODIFY_<TIPO>_ATTRIBUTES. No seu caso, como são atributos de
subrotinas, vc usou MODIFY_CODE_ATTRIBUTES, que está correto (outros
valores são SCALAR, ARRAY e HASH). Mas talvez o objetivo dessa sub não
tenha ficado claro, já que vc parece ter simplesmente colado da
documentação que, de fato, está confusa. O propósito dela é retornar
uma lista de atributos proibidos para o tipo especificado, mas ela é
chamada em tempo de compilação e vc pode ver os atributos de cada sub
diretamente a partir dela:

-------------------8<--------------------
sub MODIFY_CODE_ATTRIBUTES {
    my ($class, $code, @attrs) = @_;

    print <<"EOT";
        no pacote $class
        a sub referenciada em $code
        recebeu os atributos: @attrs.
EOT
    return (); # qualquer atributo eh valido
}

sub bla :attr1 :attr2 :attr3 {
   print "alo, mundo\n";
}
-------------------8<--------------------

[garu em bebop]$ perl attrs.pl
        no pacote main
        a sub referenciada em CODE(0x9931048)
        recebeu os atributos: attr1 attr2 attr3.


- no entanto, o "get" não obtém os atributos definidos por você (isto
é, atributos que não são built-in), e para isso vc precisa definir a
função FETCH_<TIPO>_ATTRIBUTES, que recebe o pacote (ou classe) e o
coderef, e deve retornar os atributos existentes. Abaixo, um pequeno
exemplo do que vc provavelmente quer fazer:

-------------------8<--------------------
use strict;
use attributes;

BEGIN {

    # definimos aqui os atributos validos
    my %__ATTR__ = map {$_ => 1 } qw(attr1 attr2 attr3);

    # e aqui os atributos contidos em cada pacote
    my %__PKGS__ = ();

sub MODIFY_CODE_ATTRIBUTES {
    my ($class, $code_ref, @attrs) = @_;

    my @desconhecidos = ();

    foreach my $attr (@attrs) {

        # consideramos apenas os atributos validos
        if (not exists $__ATTR__{$attr}) {
            push @desconhecidos, $attr;
            next;
        }

        # armazena o atributo
        push @{$__PKGS__{$class}->{$code_ref}}, $attr;
    }

    # retorna lista de atributos desconhecidos
    return @desconhecidos;
}

# retorna os atributos da sub em questão
sub FETCH_CODE_ATTRIBUTES {
    my ($class, $code_ref) = @_;
    return @{$__PKGS__{$class}->{$code_ref}};
}

} # fim do bloco BEGIN()

# dai abaixo seria o seu programa em si:

sub bla :attr1 :attr2 :attr3 {
   print "alo, mundo\n";
}

my @atributos = attributes::get \&bla;
print "bla() tem os atributos: @atributos\n";
-------------------8<--------------------

[garu em bebop]$ perl attrs.pl
bla() tem os atributos: attr1 attr2 attr3


Espero que isso tenha esclarecido a questão dos atributos em Perl. De
fato, o módulo Attribute::Handlers dá muito mais poder, facilidade e
flexibilidade à utilização de atributos e, curiosamente, não usa nada
disso diretamente (exceto, talvez, o MODIFY). Mas é um módulo do core
do perl, então pode ficar tranquilo quanto ao seu uso.


[]s

-b