X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FClass.pm;h=3dd0bb4fdc3fd12d691e9367585d571a21ecc05b;hb=9c10b5ad9c24b7d09982daa5e07cf009222049cf;hp=860509dd73b35e45316d0135baeb48e258637e31;hpb=66e08a8a24af859f9b44dde64398400cb52a5f87;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 860509d..3dd0bb4 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.16'; +our $VERSION = '0.20'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; @@ -80,12 +80,11 @@ sub new_object { my ($class, %params) = @_; my $self = $class->SUPER::new_object(%params); foreach my $attr ($class->compute_all_applicable_attributes()) { - # FIXME: - # this does not accept undefined - # values, nor does it accept false - # values to be passed into the init-arg - next unless $params{$attr->init_arg} && $attr->can('has_trigger') && $attr->has_trigger; - $attr->trigger->($self, $params{$attr->init_arg}, $attr); + if ( defined( my $init_arg = $attr->init_arg ) ) { + if ( exists($params{$init_arg}) && $attr->can('has_trigger') && $attr->has_trigger ) { + $attr->trigger->($self, $params{$init_arg}, $attr); + } + } } return $self; } @@ -158,18 +157,11 @@ sub get_method_map { sub add_attribute { my $self = shift; - my $name = shift; - if (scalar @_ == 1 && ref($_[0]) eq 'HASH') { - # NOTE: - # if it is a HASH ref, we de-ref it. - # this will usually mean that it is - # coming from a role - $self->SUPER::add_attribute($name => %{$_[0]}); - } - else { - # otherwise we just pass the args - $self->SUPER::add_attribute($name => @_); - } + $self->SUPER::add_attribute( + (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute') + ? $_[0] + : $self->_process_attribute(@_)) + ); } sub add_override_method_modifier { @@ -185,7 +177,7 @@ sub add_override_method_modifier { my @args = @_; no warnings 'redefine'; if ($Moose::SUPER_SLOT{$_super_package}) { - local *{$Moose::SUPER_SLOT{$_super_package}} = sub { $super->(@args) }; + local *{$Moose::SUPER_SLOT{$_super_package}} = sub { $super->body->(@args) }; return $method->(@args); } else { confess "Trying to call override modifier'd method without super()"; @@ -219,10 +211,10 @@ sub add_augment_method_modifier { local *{$Moose::INNER_SLOT{$_super_package}} = sub {}; $method->(@args); }; - return $super->(@args); + return $super->body->(@args); } else { - return $super->(@args); + return $super->body->(@args); } }); } @@ -278,32 +270,26 @@ sub _fix_metaclass_incompatability { 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 { - # FIXME - # we should make a Moose::Meta::Role::Composite - # which is a smaller version of Moose::Meta::Role - # which does not use any package stuff - Moose::Meta::Role->combine( - map { $_->meta } @roles - )->apply($self); - } +# NOTE: +# this was crap anyway, see +# Moose::Util::apply_all_roles +# instead +sub _apply_all_roles { + die 'DEPRECATED: use Moose::Util::apply_all_roles($meta, @roles) instead' } +my %ANON_CLASSES; + sub _process_attribute { - my ($self, $name, %options) = @_; + my $self = shift; + my $name = shift; + my %options = ((scalar @_ == 1 && ref($_[0]) eq 'HASH') ? %{$_[0]} : @_); + if ($name =~ /^\+(.*)/) { - my $new_attr = $self->_process_inherited_attribute($1, %options); - $self->add_attribute($new_attr); + return $self->_process_inherited_attribute($1, %options); } else { + my $attr_metaclass_name; if ($options{metaclass}) { my $metaclass_name = $options{metaclass}; eval { @@ -316,11 +302,47 @@ sub _process_attribute { if ($@) { Class::MOP::load_class($metaclass_name); } - $self->add_attribute($metaclass_name->new($name, %options)); + $attr_metaclass_name = $metaclass_name; } else { - $self->add_attribute($name, %options); + $attr_metaclass_name = $self->attribute_metaclass; } + + if ($options{traits}) { + + my $anon_role_key = join "|" => @{$options{traits}}; + + my $class; + if (exists $ANON_CLASSES{$anon_role_key} && defined $ANON_CLASSES{$anon_role_key}) { + $class = $ANON_CLASSES{$anon_role_key}; + } + else { + $class = Moose::Meta::Class->create_anon_class( + superclasses => [ $attr_metaclass_name ] + ); + $ANON_CLASSES{$anon_role_key} = $class; + + my @traits; + foreach my $trait (@{$options{traits}}) { + eval { + my $possible_full_name = 'Moose::Meta::Attribute::Custom::Trait::' . $trait; + Class::MOP::load_class($possible_full_name); + push @traits => $possible_full_name->can('register_implementation') + ? $possible_full_name->register_implementation + : $possible_full_name; + }; + if ($@) { + push @traits => $trait; + } + } + + Moose::Util::apply_all_roles($class, @traits); + } + + $attr_metaclass_name = $class->name; + } + + return $attr_metaclass_name->new($name, %options); } } @@ -329,18 +351,14 @@ sub _process_inherited_attribute { 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); + return $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 $inherited_attr->Moose::Meta::Attribute::clone_and_inherit_options(%options); } - return $new_attr; } ## ------------------------------------------------- @@ -498,7 +516,7 @@ Stevan Little Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE -Copyright 2006, 2007 by Infinity Interactive, Inc. +Copyright 2006-2008 by Infinity Interactive, Inc. L