package X; our $PREF; sub new { bless {}, $PREF; } package A; sub foo { print __PACKAGE__; } package B; sub foo { print __PACKAGE__; } package main; $X::PREF = 'B'; my $o = X->new; $o->foo;