Use throw_error() instead of confess()
[gitmo/Mouse.git] / lib / Mouse / Meta / Role.pm
index 403b781..b9f6b38 100644 (file)
@@ -1,32 +1,10 @@
 package Mouse::Meta::Role;
 use strict;
 use warnings;
-use Carp 'confess';
 
+use Mouse::Util qw(not_supported);
 use base qw(Mouse::Meta::Module);
 
-do {
-    my %METACLASS_CACHE;
-
-    # because Mouse doesn't introspect existing classes, we're forced to
-    # only pay attention to other Mouse classes
-    sub _metaclass_cache {
-        my $class = shift;
-        my $name  = shift;
-        return $METACLASS_CACHE{$name};
-    }
-
-    sub initialize {
-        my($class, $package_name, @args) = @_;
-
-        ($package_name && !ref($package_name))\r
-            || confess("You must pass a package name and it cannot be blessed");\r
-
-        return $METACLASS_CACHE{$package_name}
-            ||= $class->_new(package => $package_name, @args);
-    }
-};
-
 sub _new {
     my $class = shift;
     my %args  = @_;
@@ -55,10 +33,6 @@ sub add_attribute {
     $self->{attributes}->{$name} = $spec;
 }
 
-sub has_attribute { exists $_[0]->{attributes}->{$_[1]}  }
-sub get_attribute_list { keys %{ $_[0]->{attributes} } }
-sub get_attribute { $_[0]->{attributes}->{$_[1]} }
-
 sub _check_required_methods{
     my($role, $class, $args, @other_roles) = @_;
 
@@ -77,7 +51,7 @@ sub _check_required_methods{
                     }
                 }
                 
-                confess "'$role_name' requires the method '$method_name' to be implemented by '$class_name'"
+                $role->throw_error("'$role_name' requires the method '$method_name' to be implemented by '$class_name'")
                     unless $has_method;
             }
         }
@@ -185,7 +159,7 @@ sub apply {
     my($self, $class, %args) = @_;
 
     if ($class->isa('Mouse::Object')) {
-        Carp::croak('Mouse does not support Application::ToInstance yet');
+        not_supported 'Application::ToInstance';
     }
 
     $self->_check_required_methods($class, \%args);
@@ -222,6 +196,11 @@ for my $modifier_type (qw/before after around override/) {
         push @{ $self->{$modifier}->{$method_name} ||= [] }, $method;
         return;
     };
+    my $has_method_modifiers = sub{
+        my($self, $method_name) = @_;
+        my $m = $self->{$modifier}->{$method_name};
+        return $m && @{$m} != 0;
+    };
     my $get_method_modifiers = sub {
         my ($self, $method_name) = @_;
         return @{ $self->{$modifier}->{$method_name} ||= [] }
@@ -229,6 +208,7 @@ for my $modifier_type (qw/before after around override/) {
 
     no strict 'refs';
     *{ 'add_' . $modifier_type . '_method_modifier'  } = $add_method_modifier;
+    *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers;
     *{ 'get_' . $modifier_type . '_method_modifiers' } = $get_method_modifiers;
 }
 
@@ -237,7 +217,7 @@ sub does_role {
     my ($self, $role_name) = @_;
 
     (defined $role_name)
-        || confess "You must supply a role name to look for";
+        || $self->throw_error("You must supply a role name to look for");
 
     # if we are it,.. then return true
     return 1 if $role_name eq $self->name;