#! /usr/intel/pkgs/perl/5.12.2/bin/perl
use strict;
use warnings;

package Foo;
use Moose;

package FakeFoo;
use Moose;

package main;

no warnings 'redefine';
*Foo::real_new = \&Foo::new;
*Foo::new = sub {
    if (caller() eq 'Bar') {
        print "Returning real Foo.\n";
        return Foo->real_new;
    }
    print "Returning fake Foo.\n";
    return FakeFoo->new;
};

my $obj = Foo->new;
print STDERR __PACKAGE__.": FOO IS (".ref($obj).")\n";

package Bar;

$obj = Foo->new;
print STDERR __PACKAGE__.": FOO IS (".ref($obj).")\n";

package Other;

$obj = Foo->new;
print STDERR __PACKAGE__.": FOO IS (".ref($obj).")\n";