develooper Front page | perl.perl5.porters | Postings from October 2003

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

From:
Michael.Jacob
Date:
October 29, 2003 02:14
Subject:
Antwort: [perl #24338] perlbug AutoReply: Attribute::Handlers will trash UNIVERSAL
Message ID:
OF5B456E75.807868F4-ONC1256DCE.002D1426@schering.de

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;






nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About