La Implantación de Singletons

El método singleton_method crea una clase para el objeto que hace la invocación - si no fué creada anteriormente - y hace que esta nueva clase herede de la clase del objeto. El algoritmo garantiza que objetos distintos tendrán clases distintas.

lhp@nereida:~/Lperl/src/advanced_perl_programming2$ sed -ne '9,23p' `perldoc -l Class::SingletonMethod` | cat -n
 1  package UNIVERSAL;
 2
 3  no warnings; no strict; # no guarantee
 4
 5  sub singleton_method {
 6      my ($object, $method, $subref) = @_;
 7
 8      my $parent_class = ref $object;
 9      my $new_class = "_Singletons::".(0+$object);
10      *{$new_class."::".$method} = $subref;
11      if ($new_class ne $parent_class) {
12          @{$new_class."::ISA"} = ($parent_class);
13          bless $object, $new_class;
14      }
15  }