X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=967b784b60a683f78e2635fba2e3b480dde35bf8;hb=4d02abfd8675caf8cf09e5c29223ac7bcf24aaa3;hp=aeaaf3f6c0556ffc1f1c7bc9bf284ccbb475444e;hpb=626cd940635e34f4a742f69de6354ecd83333e66;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index aeaaf3f..967b784 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -6,21 +6,20 @@ use base 'Exporter'; our %dependencies = ( 'Scalar::Util' => { + +# VVVVV CODE TAKEN FROM SCALAR::UTIL VVVVV 'blessed' => do { - do { - no strict 'refs'; - *UNIVERSAL::a_sub_not_likely_to_be_here = sub { - my $ref = ref($_[0]); - - # deviation from Scalar::Util - # XS returns undef, PP returns GLOB. - # let's make that more consistent by having PP return - # undef if it's a GLOB. :/ - - # \*STDOUT would be allowed as an object in PP blessed - # but not XS - return $ref eq 'GLOB' ? undef : $ref; - }; + *UNIVERSAL::a_sub_not_likely_to_be_here = sub { + my $ref = ref($_[0]); + + # deviation from Scalar::Util + # XS returns undef, PP returns GLOB. + # let's make that more consistent by having PP return + # undef if it's a GLOB. :/ + + # \*STDOUT would be allowed as an object in PP blessed + # but not XS + return $ref eq 'GLOB' ? undef : $ref; }; sub { @@ -86,8 +85,14 @@ our %dependencies = ( (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 { @@ -112,17 +117,16 @@ our %dependencies = ( } }, }, +# ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^ }, ); our @EXPORT_OK = map { keys %$_ } values %dependencies; for my $module_name (keys %dependencies) { - (my $file = "$module_name.pm") =~ s{::}{/}g; - my $loaded = do { local $SIG{__DIE__} = 'DEFAULT'; - eval "require '$file'; 1"; + eval "require $module_name; 1"; }; for my $method_name (keys %{ $dependencies{ $module_name } }) { @@ -145,11 +149,34 @@ for my $module_name (keys %dependencies) { } } -push @EXPORT_OK, qw(weaken); -sub weaken { - require Scalar::Util; - goto \&Scalar::Util::weaken; -} - 1; +__END__ + +=head1 NAME + +Mouse::Util - features, with or without their dependencies + +=head1 IMPLEMENTATIONS FOR + +=head2 L + +=head3 get_linear_isa + +=head2 L + +=head3 blessed + +=head3 looks_like_number + +=head3 reftype + +=head3 openhandle + +=head3 weaken + +C I be implemented in XS. If the user tries to use C +without L, an error is thrown. + +=cut +