Mocking about with DESTROY 4 eelkonio

Bar.pm

package Bar;

use strict;

sub new {
  my $class = ref($_[0]) || $_[0]; shift;

  return bless({}, $class);
}

sub me {
  print "Me bar!\n";
}

sub DESTROY {
  my $self = shift;

  print "Destroying Bar -- " . ref($self) . "\n";
}

1;

Foo.pm

package Foo;

use strict;
no strict 'refs';

sub new {
  my $class = ref($_[0]) || $_[0]; shift;
  my $self = bless({}, $class);

  my $other       = shift;
  my $other_class = ref($other);

  # check if a destroy is already there and move it somewhere else
  my $oldDestroy;
  if ( defined &{ $other_class . "::DESTROY" } ) {
    *{ $other_class . "::OLD_DESTROY" } = &{ $other_class . "::DESTROY" };
    $oldDestroy = "true";
  }

  # copy me into the other;
  $other->{copy_of_foo} = $self;

  # create a DESTROY method inside the other method
  *{ $other_class . "::DESTROY" } = sub {
    my $self = shift || return;

    print "Now destroying stuff!\n";

    $self->me;
    $self->{copy_of_foo}->me;

    $self->OLD_DESTROY if $oldDestroy;
  };
}

sub me {
  print "Me foo!\n";
}

sub DESTROY {
  my $self = shift;

  print "Destroying Foo -- " . ref($self) . "\n";
}

1;

test.pl

#!/usr/bin/perl

BEGIN {
  unshift @INC, "./lib";
}

use strict;

use Foo;
use Bar;

my $b = Bar->new();
my $f = Foo->new( $b );

# now go away and get destroying