| Subject: | [PATCH] Pure Perl blessed() with no UNIVERSAL method. |
Attached is an implementation of pure Perl blessed() that does not
pollute UNIVERSAL. It even works when isa() and can() are broken.
| Subject: | blessed.patch |
--- Scalar-List-Utils-1.19/lib/Scalar/Util.pm 2006-12-10 08:03:45.000000000 -0800
+++ Scalar-List-Utils-1.19.new/lib/Scalar/Util.pm 2008-09-09 16:38:24.000000000 -0700
@@ -58,14 +58,10 @@
# The code beyond here is only used if the XS is not installed
-# Hope nobody defines a sub by this name
-sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }
-
sub blessed ($) {
local($@, $SIG{__DIE__}, $SIG{__WARN__});
- length(ref($_[0]))
- ? eval { $_[0]->a_sub_not_likely_to_be_here }
- : undef
+ return undef unless length(ref($_[0]));
+ return eval { UNIVERSAL::isa($_[0], "UNIVERSAL"); } ? ref($_[0]) : undef;
}
sub refaddr($) {
@@ -89,8 +85,7 @@
length($t = ref($r)) or return undef;
- # This eval will fail if the reference is not blessed
- eval { $r->a_sub_not_likely_to_be_here; 1 }
+ defined blessed($r)
? do {
$t = eval {
# we have a GLOB or an IO. Stringify a GLOB gives it's name
--- Scalar-List-Utils-1.19/t/blessed.t 2006-12-10 08:03:45.000000000 -0800
+++ Scalar-List-Utils-1.19.new/t/blessed.t 2008-09-09 16:35:15.000000000 -0700
@@ -13,7 +13,7 @@
}
}
-use Test::More tests => 8;
+use Test::More tests => 9;
use Scalar::Util qw(blessed);
use vars qw($t $x);
@@ -29,3 +29,12 @@
$x = bless {}, "DEF";
is(blessed($x), "DEF", 'blessed HASH-ref');
+
+{
+ package Broken;
+ sub isa { die };
+ sub can { die };
+
+ my $obj = bless [], __PACKAGE__;
+ ::is( ::blessed($obj), __PACKAGE__, "blessed on broken isa() and can()" );
+}