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 = @_;
$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) = @_;
}
}
- 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;
}
}
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);
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} ||= [] }
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;
}
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;