package Reblesser; use strict; use warnings; use base qw(Class::Accessor); __PACKAGE__->mk_accessors(qw(reblessed)); use Scalar::Util qw(blessed); # reblessed holds pairs [ (object => original_package) ] sub new { my $self = shift; return $self->SUPER::new({ reblessed => [] }); } sub rebless { my $self = shift; my $obj = shift; my $package = shift; die "not blessed" unless blessed $obj; push @{$self->reblessed}, [ $obj, blessed $obj ]; warn "[DEBUG] reblessing $obj to $package\n"; return bless $obj, $package } sub DESTROY { my $self = shift; for (@{$self->reblessed}) { my ($obj, $pkg) = @$_; warn "[DEBUG] reverting blessing on $obj: back to $pkg\n"; bless $obj, $pkg; } }