I said I wouldn't show it, but I suppose I will since you're sharing...

sub UNIVERSAL::new {
  my $class = caller() . "::" . shift;
  $class->new(@_);
}
[download]

It works by catching calls to new() on a package that doesn't have a new() defined. We're expecting this to mean the package doesn't really exist, and is instead the suffix of the full package name. We get the beginning of the package name from the package we called it in (caller()) and join it with the suffix (the first argument to new()), and use that as the package name. Example:

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)
[download]

I'll take my 20 lashes now.

(Double update: merlyn pointed out in a reply that my code is still an infinite loop, so I've readjusted it.) Update: to prevent infinite loops, I changed the code to:

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

Gawrsh, now it's lookin' purty.