X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FClass.pm;h=b79d02ca6f3252351b1f81ee1766418aa1b89a03;hb=7e0492d32ce0338c6feba7710d00cb8b72e794a8;hp=8908dfa08485d0ae20182310bc63b6fadf0bebf4;hpb=a6556c221ffe6bd5e85e4b33b5553f65510565fb;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 8908dfa..b79d02c 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -11,7 +11,7 @@ use List::Util qw( first ); use List::MoreUtils qw( any all uniq first_index ); use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.81'; +our $VERSION = '0.93'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -68,6 +68,32 @@ sub initialize { ); } +sub reinitialize { + my $self = shift; + my $pkg = shift; + + my $meta = blessed $pkg ? $pkg : Class::MOP::class_of($pkg); + + my %existing_classes; + if ($meta) { + %existing_classes = map { $_ => $meta->$_() } qw( + attribute_metaclass + method_metaclass + wrapped_method_metaclass + instance_metaclass + constructor_class + destructor_class + error_class + ); + } + + return $self->SUPER::reinitialize( + $pkg, + %existing_classes, + @_, + ); +} + sub _immutable_options { my ( $self, @args ) = @_; @@ -233,7 +259,7 @@ sub superclasses { foreach my $super (@supers) { Class::MOP::load_class($super); my $meta = Class::MOP::class_of($super); - Moose->throw_error("You cannot inherit from a Moose Role ($super)") + $self->throw_error("You cannot inherit from a Moose Role ($super)") if $meta && $meta->isa('Moose::Meta::Role') } return $self->SUPER::superclasses(@supers); @@ -243,11 +269,17 @@ sub superclasses { sub add_attribute { my $self = shift; - $self->SUPER::add_attribute( + my $attr = (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute') ? $_[0] - : $self->_process_attribute(@_)) - ); + : $self->_process_attribute(@_)); + $self->SUPER::add_attribute($attr); + # it may be a Class::MOP::Attribute, theoretically, which doesn't have + # 'bare' and doesn't implement this method + if ($attr->can('_check_associated_methods')) { + $attr->_check_associated_methods; + } + return $attr; } sub add_override_method_modifier { @@ -290,29 +322,8 @@ sub _find_next_method_by_name_which_is_not_overridden { sub _fix_metaclass_incompatibility { my ($self, @superclasses) = @_; - foreach my $super (@superclasses) { - my $meta = Class::MOP::Class->initialize($super); - - my @all_supers = $meta->linearized_isa; - shift @all_supers; - - my @super_metas_to_fix = ($meta); - - # We need to check & fix the immediate superclass. If its @ISA - # contains a class without a metaclass instance, followed by a - # class _with_ a metaclass instance, init a metaclass instance - # for classes without one and fix compat up to and including - # the class which was already initialized. - my $idx = first_index { Class::MOP::class_of($_) } @all_supers; - - push @super_metas_to_fix, - map { Class::MOP::Class->initialize($_) } @all_supers[ 0 .. $idx ] - if $idx >= 0; - - foreach my $super_meta (@super_metas_to_fix) { - $self->_fix_one_incompatible_metaclass($super_meta); - } - } + $self->_fix_one_incompatible_metaclass($_) + for map { Moose::Meta::Class->initialize($_) } @superclasses; } sub _fix_one_incompatible_metaclass { @@ -337,7 +348,7 @@ sub _superclass_meta_is_compatible { my $super_meta_name = $super_meta->is_immutable - ? $super_meta->get_mutable_metaclass_name + ? $super_meta->_get_mutable_metaclass_name : ref($super_meta); return 1 @@ -361,7 +372,7 @@ sub _reconcile_with_superclass_meta { my $super_meta_name = $super_meta->is_immutable - ? $super_meta->get_mutable_metaclass_name + ? $super_meta->_get_mutable_metaclass_name : ref($super_meta); my $self_metaclass = ref $self; @@ -666,8 +677,9 @@ These all default to the appropriate Moose class. =item B<< Moose::Meta::Class->create($package_name, %options) >> This overrides the parent's method in order to accept a C -option. This should be an array reference containing one more roles -that the class does. +option. This should be an array reference containing roles +that the class does, each optionally followed by a hashref of options +(C<-excludes> and C<-alias>). my $metaclass = Moose::Meta::Class->create( 'New::Class', roles => [...] ); @@ -779,7 +791,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006-2009 by Infinity Interactive, Inc. +Copyright 2006-2010 by Infinity Interactive, Inc. L