sub UNIVERSAL::new {
my $class = caller() . "::" . shift;
$class->new(@_);
}
####
package A::B::C;
sub new { print "A::B::C new @_\n" }
package A::B;
C->new(10);
# C->new calls UNIVERSAL::new('C', 10)
# caller() returns 'A::B' (the package we were in)
# UNIVERSAL::new calls A::B::C->new(10)
####
sub UNIVERSAL::new {
my $pkg = shift;
my ($class, $file, $line) = caller;
my $class = "${class}::$pkg";
my $new = $class->can('new');
return $class->$new(@_) if $new != \&UNIVERSAL::new;
die qq{Can't locate object method "new" via packages $pkg or $class at $file line $line.\n};