[Cascavel-pm] O código mais bizonho que eu já fiz na minha vida (v. 2.0)

[Daniel Ruoso]

Em Qua, 2004-06-16 às 13:51, Flavio S. Glock escreveu:
> Daniel:
> 
> Isso não poderia ser feito utilizando o Class::ClassDecorator ?
> O Class::ClassDecorator parece que poderia ser uma maneira de fazer
> "plugins" para classes, embora eu acho que não resolve completamente
> o problema.

Hmmm... não conheço o Class::ClassDecorator, mas vou dar uma olhada.

> Colocando de outra forma, se eu tenho uma hierarquia de classes:
>   Classe::A
>   Classe::B isa Classe::A
>   Classe::C isa Classe::B
> Eu queria uma maneira de poder alterar a Classe::B, de forma que a
> Classe::C pudesse herdar estas alterações ...

Seus problemas se acabaram-se... :) é exatamente isso que o código que
eu mandei faz...

Agora que eu estou com um pouco mais de tempo, vou explicar o meu
código...

Vou começar de baixo para cima, pra ficar mais fácil...

*** ATENÇÃO ***
*** Perigoso, pode causar danos mentais severos, prossiga por sua
própria conta e risco *** :)

package main;
# primeiro eu crio um objeto da classe A1
my $a = bless {}, "A1";

# Então eu vou chamar o método doit do objeto $a
# neste caso vai acontecer o esperado (o método A1::doit ser executado)
print "---- primeira chamada ---\n";
$a->doit;

# Agora eu vou personalizar a classe A1 com a classe
# A2, método doit.
print "---- segunda chamada ---\n";
customize A1 with A2 qw(doit);
# reescrevendo
# A1::customize("A1",Customizer::with("A2","doit"))
# ou ainda...
# my @methods = qw(doit)
# my $source = "A2";
# my @customize_data = Customizer::with($source, em methods)
# A1::customize(@customize_data)
# E agora, a surpresa... ele vai chamar o A2::doit, mesmo
# chamando através do objeto $a que é da classe A1.
$a->doit;

# o método Customizer::with
package Customizer;
sub with {
	# recebe o nome da classe customizadora,
	# no caso A2
        my $customizer = shift;

	# e o nome dos métodos a serem personalizados
        my @methods = @_;

        my @ret;
        push @ret, $customizer;
       if (@methods) {
		# se o usuário já disse quais são os métodos,
		# apenas retorna
                @ret = (@ret, em methods);
        } else {
		# senão, vou descobrir todos os métodos de A2,
		# exceto o próprio with
                no strict 'refs';

		# varrendo a symboltable de A2
                foreach my $symname (%{$customizer."::"}) {
			# pulando o método with
                        next if $symname eq "with";
			# atribui ao typeglob local sym o 
			# símbolo em questao
                        local *sym = *{$customizer."::".$symname};
			# e vê se o método desse símbolo está definido
                        if (defined &sym) {
				# se tiver, adiciona seu nome ao retorno
                                push @ret, $symname;
                        }
                }
        }
	# retorna o nome do customizer e o nome dos métodos
        return @ret;
}

# e o customize espera exatamente o retorno do with
sub customize {
	# A classe a ser personalizada (A1), 
        my $target = shift;

	# que pode ser ou um objeto ou o nome da classe
        $target = ref $target || $target;

        # O segundo parâmetro é a classe de origem (A2)
        my $source = shift;

	# que também pode ser objeto ou nome de classe
        $source = ref $source || $source;

        # o nome dos metodos a serem customizados 
	# sao passados como lista (doit)
        my @methods = @_; 

	# Para cada método
        foreach my $m (@methods) {

		# dizer para o perl que eu estou fazendo algo
		# meio fora do normal
                no strict 'refs';

		# supondo o método A1::doit, se A1::ORIG::doit
		# jah estiver definido, vou personalizar o
		# A1::ORIG::doit usando o A1::doit, deixando o
		# A1::ORIG::doit disponível de novo, que permite
		# que depois eu personalize o A1 com o A3, fazendo com
		# que o A1::ORIG::doit seja movido para
		# A1::ORIG::ORIG::doit e o A1::doit seja movido para
		# A1::ORIG::doit
                defined *{$target."::ORIG::".$m}
		  && customize($target."::ORIG",$target,$m);

		# Mexendo no symbol table, eu copio o metodo a
		# ser personalizado para dentro de ORIG, por exemplo
		# A1::doit é copiado para A1::ORIG::doit
                *{$target."::ORIG::".$m} = *{$target."::".$m};

		# Agora eu sobrescrevo o A1::doit com o A2::doit
                *{$target."::".$m} = *{$source."::".$m};

		# Preciso garantir que as variáveis
		# A1::doit::ORIG e a A2::doit::ORIG
		# sejam as mesmas, isso é necessário porque
		# aqui eu não sei o nome dos personalizadores
		# anteriores, mas ao executar $self->ORIG::doit
		# eu não tenho como saber se é A1::ORIG::doit,
		# A1::ORIG::ORIG::doit, sei apenas que é A2::doit
		# ou A3::doit
                *{$target."::".$m."::ORIG"} 
			= *{$source."::".$m."::ORIG"};

		# para então definir que o A1::doit::ORIG
		# e o A2::doit::ORIG sejam A1::ORIG::doit
		# isso é fundamental para permitir duas
		# customizações no mesmo método. e para 
		# eu poder chamar o método original através de
		# $self->ORIG::doit();
                $ {$source."::".$m."::ORIG"} = $target."::ORIG::".$m;
        }
}

# Esse é o método de teste do A1...
sub doit {
        print "Definido no A1.\n";
}

# esse é o método de teste do A2, que chama o ORIGinal
package A2;
@A2::ISA="Customizer";
sub doit {
        my $self = shift;
        $self->ORIG::doit;
        print "Definido no A2.\n";
        
}

# para tornar o $self->ORIG::doit possível, é só uma
# questão de definir o pacote e usar AUTOLOAD
package ORIG;
sub AUTOLOAD {
	# $self
        my $obj = shift;
	# ORIG::doit
        my $name = $ORIG::AUTOLOAD;
	# possiveis parametros
        my @params = @_;
	# retiro o ORIG:: do ORIG::doit
        $name =~ s/^ORIG:://;
	# A2
        my $pack  = caller();
        no strict 'refs';
	# lembra do A2::doit::ORIG?, é aqui que eu uso ele.
        my $orig = $ {$pack."::".$name."::ORIG"};
	# A1::ORIG::doit($obj, em params)
        &{$orig}($obj, em params);
}



e aí?