Acme::Voodoo - Do bad stuff to your objects

    use Acme::Voodoo;
    my $voodoo = Acme::Voodoo->new( 'CGI' );

    print ref( $voodoo );	## prints Acme::Voodoo::Doll_1
    print $voodoo->header();	## same as calling CGI::header()

    @pins = $voodoo->pins();	## get a list of methods you can call

    $voodoo->zombie();		## make our program sleep for a while
				## the next time a method is called

    $voodoo->kill();		## or make our program die the next 
				## time it is called 

    use Acme::Voodoo;
    my $doll = Acme::Voodoo->new( 'CGI' );
    print $doll->header();

    my @pins = $doll->pins();

    $doll->kill();
    $doll->method();	    ## arrrrrggggghhhh!! 

package Acme::Voodoo;

use strict;
use warnings;
use Carp qw( croak );

our $VERSION = 0.3;

my %dolls = ();
my %deads = ();
my %zombies = ();
my $dreamTime = 0;

sub new {

    ## uhoh, voodoo 
    no strict;

    ## figure out what class we are targeting
    my ( $voodooClass, $targetClass, @args ) = @_; 
    eval "use $targetClass";
    croak "I can't find $targetClass to put a spell on" if !$targetClass or $@; 

    ## if the class doesn't have a new constructor we can't cast our spell 
    croak "curses, $targetClass is resilient to my spell" 
	if ! exists( ${ "${targetClass}::" }{ 'new' } );

    ## determine a new namespace for our voodoo doll
    my $dollNum = scalar( keys( %dolls ) );
    my $dollClass = "Acme::Voodoo::Doll_$dollNum";

    ## go through our target namespace and copy non subroutines
    ## into our Acme::Voodoo::Doll_X namespace
    while  ( ($k,$v) = each %{ "${targetClass}::" } ) {
	if ( !defined(&{$v}) ) { ${ "${dollClass}::" }{ $k } = $v; }
    }

    ## create an instance of our target class, and stash it away
    my $instance = &{ "${targetClass}::new" }( @args );
    $dolls{ $dollClass } = $instance;

    ## create the appropriate type of reference
    my $ref;
    if ( $instance =~ /HASH/ ) { $ref = {}; }
    elsif ( $instance =~ /ARRAY/ ) { $ref = []; }
    elsif ( $instance =~ /GLOB/ ) { 
	croak "glob objects are currently resistant to our voodoo spells!"; 
    }
    $doll = bless $ref, $dollClass;

    ## make our voodoo doll namespace inherit the AUTLOADER
    ## from the Acme::Voodoo namespace so we can trap method calls
    push( @{ "${dollClass}::ISA" }, 'Acme::Voodoo' );

    return( $doll );

}

sub pins {
    my $doll = shift;
    my $dollClass = ref( $dolls{ ref($doll) } );
    my @methods = ();
    return( () ) if !$dollClass;

    no strict;
    while ( my($k,$v) = each( %{ "${dollClass}::" } ) ) {
	push( @methods, $k ) if defined &{ $v };
    }

    return( @methods );
}

sub zombie {
    my ( $self, $sleep ) = @_;
    $zombies{ ref($self) } = 1;
    $dreamTime = $sleep if $sleep;
    return(1);
}

sub kill {
    my $self = shift;
    $deads{ ref($self) } = 1;
    return( 1 );
}

sub AUTOLOAD { 

    my ($doll,@args) = @_;
    our $AUTOLOAD;

    ## if we're dead, then we're gonna die
    croak( "arrrghgghg, an evil curse has struck me down!\n" )
	if $deads{ ref($doll) };

    ## if we are a zombie, go to sleep for a random amount of time
    ## and then wake up remembering nothing
    if ( $zombies{ ref($doll) } ) {
	print STDERR "I feel as if I'm walking into a strange dream\n";
	sleep( $dreamTime || int( rand(100) ) * 10 );
	$zombies{ ref($doll) } = undef;
    }

    ## strip namespace off of method
    my ($method) = ( $AUTOLOAD =~ /.*::(.*)$/ );

    ## our real object
    my $object = $dolls{ ref($doll) };
    my $class = ref( $object );
    
    no strict;
    return( undef ) if $method eq 'DESTROY';

    ## call the method on the real object, with the right args
    ## note: we will return the return value of our method call
    &{ "${class}::${method}" }( $object, @args );

}

## no more voodoo

1;