X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=625ed4eb4d07dff733e13c597efc69abcd59cbfd;hp=9fb77ae99283b294aaeb72b30b9f8e86ef8b0d4e;hb=577be3900a87552be0c16d354f2302ef7030cc2c;hpb=58fe9fb7641a3bb817b773339bc1b81a5a373e62 diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index 9fb77ae..625ed4e 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -6,6 +6,8 @@ use base 'Exporter'; our %dependencies = ( 'Scalar::Util' => { + +# VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV 'blessed' => do { do { no strict 'refs'; @@ -41,8 +43,59 @@ our %dependencies = ( 0; }, + 'reftype' => sub { + local($@, $SIG{__DIE__}, $SIG{__WARN__}); + my $r = shift; + my $t; + + 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 } + ? do { + $t = eval { + # we have a GLOB or an IO. Stringify a GLOB gives it's name + my $q = *$r; + $q =~ /^\*/ ? "GLOB" : "IO"; + } + or do { + # OK, if we don't have a GLOB what parts of + # a glob will it populate. + # NOTE: A glob always has a SCALAR + local *glob = $r; + defined *glob{ARRAY} && "ARRAY" + or defined *glob{HASH} && "HASH" + or defined *glob{CODE} && "CODE" + or length(ref(${$r})) ? "REF" : "SCALAR"; + } + } + : $t + }, + 'openhandle' => sub { + my $fh = shift; + my $rt = reftype($fh) || ''; + + return defined(fileno($fh)) ? $fh : undef + if $rt eq 'IO'; + + if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA) + $fh = \(my $tmp=$fh); + } + elsif ($rt ne 'GLOB') { + return undef; + } + + (tied(*$fh) or defined(fileno($fh))) + ? $fh : undef; + }, + weaken => { + loaded => \&Scalar::Util::weaken, + not_loaded => sub { die "Scalar::Util required for weak reference support" }, + }, +# ^^^^^ CODE TAKEN FROM SCALAR::UTIL ^^^^^ }, 'MRO::Compat' => { +# VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV 'get_linear_isa' => { loaded => \&mro::get_linear_isa, not_loaded => do { @@ -67,6 +120,7 @@ our %dependencies = ( } }, }, +# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^ }, ); @@ -100,5 +154,6 @@ for my $module_name (keys %dependencies) { } } + 1;