Antwort: [perl #24338] perlbug AutoReply: Attribute::Handlers will trash UNIVERSAL

Oops, my suggested code was buggy. I think I had some recursion in mind...

Corrected:

 my $realcan = \&UNIVERSAL::can;
 sub mycan {
   goto &$realcan if $_[0] eq __PACKAGE__ or $_[1] eq 'can';  # <==
   my $UV_code = &$realcan(@_);
   my $MY_code = &$realcan(__PACKAGE__, $_[1]);
   return $UV_code ne $MY_code ? $UV_code : undef;
 }
 *UNIVERSAL::can = \&mycan;

* Shortcut for lookups in the "parent of UNIVERSAL" module
* Shortcut for lookups of "can"
=> Both because the following logic would fail:
* A module can something if it has not inhereted it via UNIVERSAL from us.

mmmh. This would even be safer:

 my $realcan = \&UNIVERSAL::can;
 sub mycan {
   goto &$realcan if $_[0] eq __PACKAGE__ or $_[1] eq 'can';
   my $UV_code = &$realcan('UNIVERSAL', $_[1]);
   my $MO_code = &$realcan(@_);
   return $MO_code unless $UV_code and $MO_code eq $UV_code;
   my $MY_code = &$realcan(__PACKAGE__, $_[1]);
   return $UV_code ne $MY_code ? $MO_code : undef;
 }
 *UNIVERSAL::can = \&mycan;

* real can() is right if UNIVERSAL can()not.
* real can() is right if the module does not inherit it from UNIVERSAL
* real can() is right if the code in UNIVERSAL is not from us
* else: The code is injected by us, deny its existance

With cache:

 my $realcan = \&UNIVERSAL::can;
 my $UVcache = {};
 sub mycan {
   goto &$realcan if $_[0] eq __PACKAGE__ or $_[1] eq 'can';
   my $UV_code = exists($UVcache->{$_[1]}) ? $UVcache->{$_[1]} : $UVcache->
{$_[1]}= &$realcan('UNIVERSAL', $_[1]);
   my $MO_code = &$realcan(@_);
   return $MO_code unless $UV_code and $MO_code eq $UV_code;
   my $MY_code = &$realcan(__PACKAGE__, $_[1]);
   return $UV_code ne $MY_code ? $MO_code : undef;
 }
 *UNIVERSAL::can = \&mycan;

• Antwort: [perl #24338] perlbug AutoReply: Attribute::Handlers will trash UNIVERSAL by Michael.Jacob