From: Stevan Little Date: Sun, 18 Jun 2006 13:53:47 +0000 (+0000) Subject: foo X-Git-Tag: 0_09_03~5 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1341f10cabeaf78b14c1801317b0f105595ed635;p=gitmo%2FMoose.git foo --- diff --git a/Changes b/Changes index b60ee8d..c606b35 100644 --- a/Changes +++ b/Changes @@ -6,12 +6,18 @@ Revision history for Perl extension Moose needed in Moose classes, Moose itself will turn them on for you. - added tests for this + - moved code from exported subs to private methods + in Moose::Meta::Class * Moose::Role - as with Moose, strict and warnings are automatically turned on for you. - added tests for this + * Moose::Meta::Class + - now handles some moose-specific options in + &create + 0.09_02 Tues. May 16, 2006 * Moose - added prototypes to the exported subs diff --git a/README b/README index dd88170..555e005 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Moose version 0.09_02 +Moose version 0.09_03 =========================== See the individual module documentation for more information diff --git a/lib/Moose.pm b/lib/Moose.pm index c0f882d..ecb95a7 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -71,37 +71,10 @@ use Moose::Util::TypeConstraints; return subname 'Moose::extends' => sub (@) { confess "Must derive at least one class" unless @_; _load_all_classes(@_); - my $meta = $class->meta; - foreach my $super (@_) { - # don't bother if it does not have a meta. - next unless $super->can('meta'); - # if it's meta is a vanilla Moose, - # then we can safely ignore it. - next if blessed($super->meta) eq 'Moose::Meta::Class'; - # but if we have anything else, - # we need to check it out ... - unless (# see if of our metaclass is incompatible - ($meta->isa(blessed($super->meta)) && - # and see if our instance metaclass is incompatible - $meta->instance_metaclass->isa($super->meta->instance_metaclass)) && - # ... and if we are just a vanilla Moose - $meta->isa('Moose::Meta::Class')) { - # re-initialize the meta ... - my $super_meta = $super->meta; - # NOTE: - # We might want to consider actually - # transfering any attributes from the - # original meta into this one, but in - # general you should not have any there - # at this point anyway, so it's very - # much an obscure edge case anyway - $meta = $super_meta->reinitialize($class => ( - ':attribute_metaclass' => $super_meta->attribute_metaclass, - ':method_metaclass' => $super_meta->method_metaclass, - ':instance_metaclass' => $super_meta->instance_metaclass, - )); - } - } + # this checks the metaclass to make sure + # it is correct, sometimes it can get out + # of sync when the classes are being built + my $meta = $class->meta->_fix_metaclass_incompatability(@_); $meta->superclasses(@_); }; }, @@ -111,50 +84,14 @@ use Moose::Util::TypeConstraints; my (@roles) = @_; confess "Must specify at least one role" unless @roles; _load_all_classes(@roles); - ($_->can('meta') && $_->meta->isa('Moose::Meta::Role')) - || confess "You can only consume roles, $_ is not a Moose role" - foreach @roles; - if (scalar @roles == 1) { - $roles[0]->meta->apply($class->meta); - } - else { - Moose::Meta::Role->combine( - map { $_->meta } @roles - )->apply($class->meta); - } + $class->meta->_apply_all_roles(@roles); }; }, has => sub { my $class = $CALLER; return subname 'Moose::has' => sub ($;%) { my ($name, %options) = @_; - my $meta = $class->meta; - if ($name =~ /^\+(.*)/) { - my $inherited_attr = $meta->find_attribute_by_name($1); - (defined $inherited_attr) - || confess "Could not find an attribute by the name of '$1' to inherit from"; - my $new_attr; - if ($inherited_attr->isa('Moose::Meta::Attribute')) { - $new_attr = $inherited_attr->clone_and_inherit_options(%options); - } - else { - # NOTE: - # kind of a kludge to handle Class::MOP::Attributes - $new_attr = Moose::Meta::Attribute::clone_and_inherit_options( - $inherited_attr, %options - ); - } - $meta->add_attribute($new_attr); - } - else { - if ($options{metaclass}) { - _load_all_classes($options{metaclass}); - $meta->add_attribute($options{metaclass}->new($name, %options)); - } - else { - $meta->add_attribute($name, %options); - } - } + $class->meta->_process_attribute($name, %options); }; }, before => sub { diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 5a6500d..133678c 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -9,7 +9,7 @@ use Class::MOP; use Carp 'confess'; use Scalar::Util 'weaken', 'blessed', 'reftype'; -our $VERSION = '0.06'; +our $VERSION = '0.07'; use base 'Class::MOP::Class'; @@ -25,7 +25,7 @@ sub initialize { ':attribute_metaclass' => 'Moose::Meta::Attribute', ':instance_metaclass' => 'Moose::Meta::Instance', @_); -} +} sub add_role { my ($self, $role) = @_; @@ -160,6 +160,8 @@ sub add_augment_method_modifier { }); } +## Private Utility methods ... + sub _find_next_method_by_name_which_is_not_overridden { my ($self, $name) = @_; my @methods = $self->find_all_methods_by_name($name); @@ -170,6 +172,92 @@ sub _find_next_method_by_name_which_is_not_overridden { return undef; } +sub _fix_metaclass_incompatability { + my ($self, @superclasses) = @_; + foreach my $super (@superclasses) { + # don't bother if it does not have a meta. + next unless $super->can('meta'); + # if it's meta is a vanilla Moose, + # then we can safely ignore it. + next if blessed($super->meta) eq 'Moose::Meta::Class'; + # but if we have anything else, + # we need to check it out ... + unless (# see if of our metaclass is incompatible + ($self->isa(blessed($super->meta)) && + # and see if our instance metaclass is incompatible + $self->instance_metaclass->isa($super->meta->instance_metaclass)) && + # ... and if we are just a vanilla Moose + $self->isa('Moose::Meta::Class')) { + # re-initialize the meta ... + my $super_meta = $super->meta; + # NOTE: + # We might want to consider actually + # transfering any attributes from the + # original meta into this one, but in + # general you should not have any there + # at this point anyway, so it's very + # much an obscure edge case anyway + $self = $super_meta->reinitialize($self->name => ( + ':attribute_metaclass' => $super_meta->attribute_metaclass, + ':method_metaclass' => $super_meta->method_metaclass, + ':instance_metaclass' => $super_meta->instance_metaclass, + )); + } + } + return $self; +} + +sub _apply_all_roles { + my ($self, @roles) = @_; + ($_->can('meta') && $_->meta->isa('Moose::Meta::Role')) + || confess "You can only consume roles, $_ is not a Moose role" + foreach @roles; + if (scalar @roles == 1) { + $roles[0]->meta->apply($self); + } + else { + Moose::Meta::Role->combine( + map { $_->meta } @roles + )->apply($self); + } +} + +sub _process_attribute { + my ($self, $name, %options) = @_; + if ($name =~ /^\+(.*)/) { + my $new_attr = $self->_process_inherited_attribute($1, %options); + $self->add_attribute($new_attr); + } + else { + if ($options{metaclass}) { + Moose::_load_all_classes($options{metaclass}); + $self->add_attribute($options{metaclass}->new($name, %options)); + } + else { + $self->add_attribute($name, %options); + } + } +} + +sub _process_inherited_attribute { + my ($self, $attr_name, %options) = @_; + my $inherited_attr = $self->find_attribute_by_name($attr_name); + (defined $inherited_attr) + || confess "Could not find an attribute by the name of '$attr_name' to inherit from"; + my $new_attr; + if ($inherited_attr->isa('Moose::Meta::Attribute')) { + $new_attr = $inherited_attr->clone_and_inherit_options(%options); + } + else { + # NOTE: + # kind of a kludge to handle Class::MOP::Attributes + $new_attr = Moose::Meta::Attribute::clone_and_inherit_options( + $inherited_attr, %options + ); + } + return $new_attr; +} + package Moose::Meta::Method::Overriden; use strict;