X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=382763605db3f38328e7c52bd96ec1ea813f85ce;hp=ea36a4beed88297d2f8fa19959af62805b24e10f;hb=b06ce1f502945c13a52c503f1a651fe92c91c773;hpb=8d59c7239b90bb75b0187decbed09c6952e2b4a5 diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index ea36a4b..3827636 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -38,17 +38,28 @@ sub create_anon_class{ return $self->create(undef, @_); } -sub is_anon_class{ - return exists $_[0]->{anon_serial_id}; -} +sub is_anon_class; + +sub roles; -sub roles { $_[0]->{roles} } +sub calculate_all_roles { + my $self = shift; + my %seen; + return grep { !$seen{ $_->name }++ } + map { $_->calculate_all_roles } @{ $self->roles }; +} sub superclasses { my $self = shift; if (@_) { - Mouse::load_class($_) for @_; + foreach my $super(@_){ + Mouse::Util::load_class($super); + my $meta = Mouse::Util::get_metaclass_by_name($super); + if($meta && $meta->isa('Mouse::Meta::Role')){ + $self->throw_error("You cannot inherit from a Mouse Role ($super)"); + } + } @{ $self->{superclasses} } = @_; } @@ -59,6 +70,7 @@ sub find_method_by_name{ my($self, $method_name) = @_; defined($method_name) or $self->throw_error('You must define a method name to find'); + foreach my $class( $self->linearized_isa ){ my $method = $self->initialize($class)->get_method($method_name); return $method if defined $method; @@ -137,7 +149,8 @@ sub add_attribute { } sub compute_all_applicable_attributes { - Carp::cluck('compute_all_applicable_attributes() has been deprecated'); + Carp::cluck('compute_all_applicable_attributes() has been deprecated') + if _MOUSE_VERBOSE; return shift->get_all_attributes(@_) } @@ -158,7 +171,7 @@ sub get_all_attributes { return @attr; } -sub linearized_isa { @{ get_linear_isa($_[0]->name) } } +sub linearized_isa; sub new_object { my $self = shift; @@ -180,7 +193,7 @@ sub _initialize_object{ my $key = $attribute->name; if (defined($from) && exists($args->{$from})) { - $object->{$key} = $attribute->_coerce_and_verify($args->{$from}); + $object->{$key} = $attribute->_coerce_and_verify($args->{$from}, $object); weaken($object->{$key}) if ref($object->{$key}) && $attribute->is_weak_ref; @@ -198,8 +211,7 @@ sub _initialize_object{ : ref($default) eq 'CODE' ? $object->$default() : $default; - # XXX: we cannot use $attribute->set_value() because it invokes triggers. - $object->{$key} = $attribute->_coerce_and_verify($value, $object);; + $object->{$key} = $attribute->_coerce_and_verify($value, $object); weaken($object->{$key}) if ref($object->{$key}) && $attribute->is_weak_ref; @@ -363,12 +375,8 @@ sub _install_modifier { $impl = sub { my ( $self, $type, $name, $code ) = @_; my $into = $self->name; - $install_modifier->( - $into, - $type, - $name, - $code - ); + $install_modifier->($into, $type, $name, $code); + $self->add_method($name => do{ no strict 'refs'; \&{ $into . '::' . $name }; @@ -450,8 +458,8 @@ sub does_role { || $self->throw_error("You must supply a role name to look for"); for my $class ($self->linearized_isa) { - my $meta = Mouse::Util::get_metaclass_by_name($class); - next unless $meta && $meta->can('roles'); + my $meta = Mouse::Util::get_metaclass_by_name($class) + or next; for my $role (@{ $meta->roles }) { @@ -463,13 +471,16 @@ sub does_role { } 1; - __END__ =head1 NAME Mouse::Meta::Class - The Mouse class metaclass +=head1 VERSION + +This document describes Mouse version 0.40_01 + =head1 METHODS =head2 C<< initialize(ClassName) -> Mouse::Meta::Class >>