That can be done easily with an object that takes charge of the reblessing and which reverts what it did at destruction time. Your illustration code would look like:

package boo;

sub to_s { "a boo" };

package bar;

sub to_s { "a bar" };

package main;

sub doit {
  my $boo = shift;

  my $reblesser = Reblesser->new;

  $reblesser->rebless($boo, "bar"); 
  print "within: ", $boo->to_s, "\n"; # "a bar"

  # here the scope of the reblesser ends and so the reblessing it did
}

my $obj = bless {}, 'boo';
print "before: ", $obj->to_s, "\n"; # "a boo"
doit($obj);
print "after: ", $obj->to_s, "\n"; # "a boo" again
[download]

$ perl reblesser.pl
before: a boo
[DEBUG] reblessing boo=HASH(0x102efcf8) to bar
within: a bar
[DEBUG] reverting blessing on bar=HASH(0x102efcf8): back to boo
after: a boo
[download]

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;
    }
}
[download]

Most excellent! Doh - I never thought of using scope on a separate object and invoking the $priest->DESTROY to unbless!

Just to confirm - Is DESTROY actually and reliably called when leaving scope, rather than later in a garbage sweep? Wouldn't want the blessing to be too sticky!

Thanks,

Jeff

Yes, perl does not have a background thread for its garbage collector.

Brilliant!

sub doit {
  ...
  Database::Special->doSomethingSpecial($db);
  # no need to rebless, you haven't tampered with $db
}
[download]

  sub doSomethingSpecial {
    my ($self) = @_;
    ...
  }
[download]

  sub doSomethingSpecial {
    my ($class, $object) = @_;
    ...
  }
[download]

Thanks for the comment.

Background is that we have a Database class, with generally (everyday) used SQL, and additional specialised sub-classes containing domain specific SQL - i.e. SQL specific to some rarely used nook. Database instantiation is handled a long way off, and $db is passed around (a little like a baby needing burping!). It has lots of stuff built in like which server to connect to for a database, a pool of connection handles, whether to allow remote connections, other bits of context etc.

Suggestion 1: is kind-of what we had - but we stored $db on $self during instantiation. The problem is that other processing is going on, and we want various contexts to be able to interchangably use $db / $special_db / $even_more_special_db as database objects. This would mean that we would have to implement all the methods of $db (or use autoload)

Suggestion 2: is not a runner, as the $db instance is created a long way off, and many moons before we get passed it. Also, this doesnt work when in one context we want colour_specials and in another we want to switch to garden_specials which are orthogonal. (ie Database specials are siblings - they cant/dont inherit from each other)

In the end, we dug up our Head First Design Patterns, and implemented a Decorator, using AUTOLOAD to despatch methods not found on the specialised class. We end up with this sort of thing:

  # each Database::XXX class decorates the database
  # arg passed during instantiation, and any methods it
  # doesnt recognise are passed through to the decorated 
  # database. 
  # All done by making the Database:XXX classes inherit
  # from our Decorator class.
  # This code illustrates how this looks to users
  # of the database classes.
 
  my $db = Database->new( database => 'sussex' );
  
  # add colour managment sprocs to database
  my $colour_db = Database::Colour->new( db => $db );

  # Database::Colour knows hues hue (implements Rainbows)
  $colour_db->generateRainbow();
  ... 
  checkFlowerColours( db => $colour_db );
 
  sub checkFlowerColours {
    my %arg = @_;

    # in this context, we need to add some
    # garden compost to the colour enabled database
    my $garden_db = Database::Garden->new( db => $arg{db} );

    # sameColour is from Database::Colour
    if ( $garden_db->sameColour( $garden_db->getLawnColour(), 'brown' 
+) {
      # action is from Database::Garden
      # but hosePipeBan is from Database('sussex')
      $garden_db->waterPlants()
        unless $garden_db->hasHosePipeBan();
    }
  }
[download]

Yeah, I know its a skanky example, but you get the Decorator like pattern idea. And the decorated $db just has special funcs for the scope of the block where it is created. I will post a cut-down Decorator class if anyone is interested?