X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil.pm;h=34f6eeebd57cf726f9fcbfbd2478aff2d713dcbb;hb=ba153b332782dce8bf44fcc78ebb7230002b950c;hp=5f3df61f50c9486bc60d0fd00cb3c54514522bc4;hpb=6a97bbdad44391f2a587165cb81fcf8aedc642ac;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index 5f3df61..34f6eee 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -1,31 +1,35 @@ package Mouse::Util; use Mouse::Exporter; # enables strict and warnings +sub get_linear_isa($;$); # must be here + BEGIN{ # Because Mouse::Util is loaded first in all the Mouse sub-modules, # XS loader is placed here, not in Mouse.pm. - our $VERSION = '0.40_04'; + our $VERSION = '0.40_06'; - my $need_pp = !!$ENV{MOUSE_PUREPERL}; + my $xs = !(exists $INC{'Mouse/PurePerl.pm'} || $ENV{MOUSE_PUREPERL}); - if(!$need_pp && !exists $INC{'Mouse/PurePerl.pm'}){ + if($xs){ local $@; # XXX: XSLoader tries to get the object path from caller's file name # $hack_mouse_file fools its mechanism (my $hack_mouse_file = __FILE__) =~ s/.Util//; # .../Mouse/Util.pm -> .../Mouse.pm - $need_pp = !eval sprintf("#line %d %s\n", __LINE__, $hack_mouse_file) . q{ + $xs = eval sprintf("#line %d %s\n", __LINE__, $hack_mouse_file) . q{ require XSLoader; XSLoader::load('Mouse', $VERSION); }; #warn $@ if $@; } - if($need_pp){ + if(!$xs){ require 'Mouse/PurePerl.pm'; # we don't want to create its namespace } + + *_MOUSE_XS = sub(){ $xs }; } @@ -99,10 +103,10 @@ sub does_role{ } BEGIN { - my $impl; + my $get_linear_isa; if ($] >= 5.009_005) { require mro; - $impl = \&mro::get_linear_isa; + $get_linear_isa = \&mro::get_linear_isa; } else { my $e = do { local $@; @@ -110,11 +114,11 @@ BEGIN { $@; }; if (!$e) { - $impl = \&mro::get_linear_isa; + $get_linear_isa = \&mro::get_linear_isa; } else { # VVVVV CODE TAKEN FROM MRO::COMPAT VVVVV my $_get_linear_isa_dfs; # this recurses so it isn't pretty - $_get_linear_isa_dfs = sub { + $_get_linear_isa_dfs = sub ($;$){ no strict 'refs'; my $classname = shift; @@ -132,13 +136,11 @@ BEGIN { return \@lin; }; # ^^^^^ CODE TAKEN FROM MRO::COMPAT ^^^^^ - $impl = $_get_linear_isa_dfs; + $get_linear_isa = $_get_linear_isa_dfs; } } - - no warnings 'once'; - *get_linear_isa = $impl; + *get_linear_isa = $get_linear_isa; } @@ -181,7 +183,7 @@ sub is_valid_class_name { return 0 if ref($class); return 0 unless defined($class); - return 1 if $class =~ /^\w+(?:::\w+)*$/; + return 1 if $class =~ /\A \w+ (?: :: \w+ )* \z/xms; return 0; } @@ -334,7 +336,7 @@ Mouse::Util - Features, with or without their dependencies =head1 VERSION -This document describes Mouse version 0.40_04 +This document describes Mouse version 0.40_06 =head1 IMPLEMENTATIONS FOR