I hope I haven't muddied the waters too much with my package names; 'curse' is not the opposite of 'bless', it's actually a package that an object (player) can be blessed into, and then unblessed back out of.#!/usr/bin/perl -w use strict; use warnings; use Test::More tests => 7; my $player = new Player; $player->name('Tim'); is( $player->name, 'Tim', 'name' ); $player->age( 10 ); is( $player->age, 10, 'age set' ); my $curse = new Curse::Older( $player ); is( $player->name, 'Tim (cursed)', 'name cursed' ); is( $player->age, 20, 'cursed age' ); $player->age( 20 ); is( $player->age, 40, 'age set while cursed' ); $curse->lift; #can_ok( $player, 'name', 'player has name method'); #why does this fa +il? is( $player->name, 'Tim', 'name back to normal' ); is( $player->age, 20, 'age learnt while cursed' ); #--------------------------------------------------------------------- +---------- package Player; use strict; use warnings; sub new { bless {}, $_[0] } sub age { $_[1] and $_[0]->{age} = $_[1]; return $_[0]->{age} } sub name { $_[1] and $_[0]->{name} = $_[1]; return $_[0]->{name} } #--------------------------------------------------------------------- +---------- package Curse; use strict; use warnings; use base 'Player'; use Class::ISA; sub new { my $class = shift; my $player = shift; return bless $player, $class; } sub name { $_[0]->SUPER::name . ' (cursed)' } sub lift { my $curse = shift; my $pkg = __PACKAGE__; my $old_class = ( grep { $_ !~ /^$pkg/ } ( Class::ISA::super_path( ref( $curse ) ) ) )[0]; bless $curse, $old_class; } #--------------------------------------------------------------------- +---------- package Curse::Older; use base 'Curse'; sub age { $_[0]->SUPER::age( $_[1] ) * 2}
In reply to Re: messing with @ISA - unblessing
by Boldra
in thread messing with @ISA - unblessing
by Boldra
For: | Use: | ||
& | & | ||
< | < | ||
> | > | ||
[ | [ | ||
] | ] |