fix minor indentation nit in Constructor.pm

[gitmo/Moo.git] / lib / Moo / Role.pm

diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index 5145edc..628258d 100644 (file)
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -10,14 +10,21 @@ BEGIN { *INFO = \%Role::Tiny::INFO }
 
 our %INFO;
 
+sub _install_tracked {
+  my ($target, $name, $code) = @_;
+  $INFO{$target}{exports}{$name} = $code;
+  _install_coderef "${target}::${name}" => "Moo::Role::${name}" => $code;
+}
+
 sub import {
   my $target = caller;
   my ($me) = @_;
   strictures->import;
   return if $INFO{$target}; # already exported into this package
+  $INFO{$target} = {};
   # get symbol table reference
   my $stash = do { no strict 'refs'; \%{"${target}::"} };
-  _install_coderef "${target}::has" => "Moo::Role::has" => sub {
+  _install_tracked $target => has => sub {
     my ($name, %spec) = @_;
     ($INFO{$target}{accessor_maker} ||= do {
       require Method::Generate::Accessor;
@@ -28,17 +35,17 @@ sub import {
   };
   # install before/after/around subs
   foreach my $type (qw(before after around)) {
-    *{_getglob "${target}::${type}"} = sub {
+    _install_tracked $target => $type => sub {
       require Class::Method::Modifiers;
       push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
       $me->_maybe_reset_handlemoose($target);
     };
   }
-  *{_getglob "${target}::requires"} = sub {
+  _install_tracked $target => requires => sub {
     push @{$INFO{$target}{requires}||=[]}, @_;
     $me->_maybe_reset_handlemoose($target);
   };
-  *{_getglob "${target}::with"} = sub {
+  _install_tracked $target => with => sub {
     $me->apply_roles_to_package($target, @_);
     $me->_maybe_reset_handlemoose($target);
   };
@@ -56,6 +63,11 @@ sub import {
   }
 }
 
+sub unimport {
+  my $target = caller;
+  _unimport_coderefs($target, $INFO{$target});
+}
+
 sub _maybe_reset_handlemoose {
   my ($class, $target) = @_;
   if ($INC{"Moo/HandleMoose.pm"}) {
@@ -87,7 +99,36 @@ sub _inhale_if_moose {
     };
     $INFO{$role}{requires} = [ $meta->get_required_method_list ];
     $INFO{$role}{attributes} = [
-      map +($_ => $meta->get_attribute($_)), $meta->get_attribute_list
+      map +($_ => do {
+        my $spec = { %{$meta->get_attribute($_)} };
+
+        if ($spec->{isa}) {
+
+          my $get_constraint = do {
+            my $pkg = $meta->isa('Mouse::Meta::Role')
+                        ? 'Mouse::Util::TypeConstraints'
+                        : 'Moose::Util::TypeConstraints';
+            _load_module($pkg);
+            $pkg->can('find_or_create_isa_type_constraint');
+          };
+
+          my $tc = $get_constraint->($spec->{isa});
+          my $check = $tc->_compiled_type_constraint;
+
+          $spec->{isa} = sub {
+            &$check or die "Type constraint failed for $_[0]"
+          };
+
+          if ($spec->{coerce}) {
+
+             # Mouse has _compiled_type_coercion straight on the TC object
+             $spec->{coerce} = $tc->${\(
+               $tc->can('coercion')||sub { $_[0] }
+             )}->_compiled_type_coercion;
+          }
+        }
+        $spec;
+      }), $meta->get_attribute_list
     ];
     my $mods = $INFO{$role}{modifiers} = [];
     foreach my $type (qw(before after around)) {
@@ -245,7 +286,7 @@ Moo::Role - Minimal Object Orientation support for Roles
 
  1;
 
-else where
+And elsewhere:
 
  package Some::Class;