in reply to messing with @ISA - unblessing
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}
|
---|
Replies are listed 'Best First'. | |
---|---|
Re^2: messing with @ISA - unblessing
by FunkyMonk (Chancellor) on Aug 03, 2008 at 13:04 UTC | |
by Boldra (Curate) on Aug 03, 2008 at 18:24 UTC | |
Re^2: messing with @ISA - unblessing
by shmem (Chancellor) on Aug 03, 2008 at 12:20 UTC |