Checking in changes prior to tagging of version 0.40_06. Changelog diff is:

[gitmo/Mouse.git] / lib / Mouse / Util.pm

diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm
index 948aa16..4d15fb2 100644 (file)
--- a/lib/Mouse/Util.pm
+++ b/lib/Mouse/Util.pm
@@ -5,32 +5,34 @@ 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_01';
+    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 };
 }
 
 
-use Carp qw(confess);
-use Scalar::Util qw(blessed);
+use Carp         ();
+use Scalar::Util ();
 
 use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};
 
@@ -73,8 +75,14 @@ BEGIN {
     *get_metaclass_by_name       = \&Mouse::Meta::Module::get_metaclass_by_name;
     *get_all_metaclass_instances = \&Mouse::Meta::Module::get_all_metaclass_instances;
     *get_all_metaclass_names     = \&Mouse::Meta::Module::get_all_metaclass_names;
+
+    # is-a predicates
+    generate_isa_predicate_for('Mouse::Meta::TypeConstraint' => 'is_a_type_constraint');
+    generate_isa_predicate_for('Mouse::Meta::Class'          => 'is_a_metaclass');
+    generate_isa_predicate_for('Mouse::Meta::Role'           => 'is_a_metarole');
 }
 
+
 # Moose::Util compatible utilities
 
 sub find_meta{
@@ -93,10 +101,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 $@;
@@ -104,7 +112,7 @@ 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
@@ -126,13 +134,13 @@ 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;
 }
 
 
@@ -198,7 +206,7 @@ sub load_first_existing_class {
     }
 
     # not found
-    confess join(
+    Carp::confess join(
         "\n",
         map {
             sprintf( "Could not load class (%s) because : %s",
@@ -214,7 +222,7 @@ sub _try_load_one_class {
 
     unless ( is_valid_class_name($class) ) {
         my $display = defined($class) ? $class : 'undef';
-        confess "Invalid class name ($display)";
+        Carp::confess "Invalid class name ($display)";
     }
 
     return undef if $is_class_loaded_cache{$class} ||= is_class_loaded($class);
@@ -233,7 +241,7 @@ sub _try_load_one_class {
 sub load_class {
     my $class = shift;
     my $e = _try_load_one_class($class);
-    confess "Could not load class ($class) because : $e" if $e;
+    Carp::confess "Could not load class ($class) because : $e" if $e;
 
     return 1;
 }
@@ -242,7 +250,9 @@ sub is_class_loaded;
 
 
 sub apply_all_roles {
-    my $applicant = blessed($_[0]) ? shift : Mouse::Meta::Class->initialize(shift);
+    my $applicant = Scalar::Util::blessed($_[0])
+        ?                                shift   # instance
+        : Mouse::Meta::Class->initialize(shift); # class or role name
 
     my @roles;
 
@@ -257,7 +267,7 @@ sub apply_all_roles {
         my $role_name = $roles[-1][0];
         load_class($role_name);
 
-        Mouse::Util::TypeConstraints::_is_a_metarole( get_metaclass_by_name($role_name) )
+        is_a_metarole( get_metaclass_by_name($role_name) )
             || $applicant->meta->throw_error("You can only consume roles, $role_name(".$role_name->meta.") is not a Mouse role");
     }
 
@@ -326,7 +336,7 @@ Mouse::Util - Features, with or without their dependencies
 
 =head1 VERSION
 
-This document describes Mouse version 0.40_01
+This document describes Mouse version 0.40_06
 
 =head1 IMPLEMENTATIONS FOR