X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FClass.pm;h=e2eb4bf7b2c1e0d58b2ffa820c3829cea1e80074;hb=df7e47294bc932e837f0548f61125e84fe56eb94;hp=8747788ee58d5c0cdb99d7014bcf4272c874e5a2;hpb=6cd9dfb6937859d76137cf492b4d2b8c3797c050;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 8747788..e2eb4bf 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -209,9 +209,13 @@ sub add_attribute { weaken( $attr->{associated_class} = $self ); - $self->{attributes}{$attr->name} = $attr; + # install accessors first $attr->install_accessors(); + # then register the attribute to the metaclass + $attr->{insertion_order} = keys %{ $self->{attributes} }; + $self->{attributes}{$attr->name} = $attr; + if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){ Carp::carp(qq{Attribute ($name) of class }.$self->name .qq{ has no associated methods (did you mean to provide an "is" argument?)}); @@ -228,20 +232,8 @@ sub compute_all_applicable_attributes { # DEPRECATED sub linearized_isa; sub new_object; +sub clone_object; -sub clone_object { - my $class = shift; - my $object = shift; - my $args = $object->Mouse::Object::BUILDARGS(@_); - - (blessed($object) && $object->isa($class->name)) - || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($object)"); - - my $cloned = bless { %$object }, ref $object; - $class->_initialize_object($cloned, $args, 1); - - return $cloned; -} sub clone_instance { # DEPRECATED my ($class, $instance, %params) = @_; @@ -270,8 +262,6 @@ sub make_immutable { $self->{is_immutable}++; - $self->{strict_constructor} = $args{strict_constructor}; - if ($args{inline_constructor}) { $self->add_method($args{constructor_name} => Mouse::Util::load_class($self->constructor_class) @@ -367,10 +357,10 @@ sub _install_modifier_pp{ sub _install_modifier { my ( $self, $type, $name, $code ) = @_; - # load Class::Method::Modifiers first + # load Data::Util first my $no_cmm_fast = do{ local $@; - eval q{ use Class::Method::Modifiers::Fast 0.041 () }; + eval q{ use Data::Util 0.55 () }; $@; }; @@ -379,13 +369,27 @@ sub _install_modifier { $impl = \&_install_modifier_pp; } else{ - my $install_modifier = Class::Method::Modifiers::Fast->can('install_modifier'); $impl = sub { my ( $self, $type, $name, $code ) = @_; my $into = $self->name; - $install_modifier->($into, $type, $name, $code); - $self->add_method($name => Mouse::Util::get_code_ref($into, $name)); + my $method = Mouse::Util::get_code_ref( $into, $name ); + + if ( !$method || !Data::Util::subroutine_modifier($method) ) { + unless ($method) { + $method = $into->can($name) + or Carp::confess("The method '$name' is not found in the inheritance hierarchy for class $into"); + } + $method = Data::Util::modify_subroutine( $method, + $type => [$code] ); + + $self->add_method($name => $method); + } + else { + Data::Util::subroutine_modifier( $method, $type => $code ); + $self->add_method($name => Mouse::Util::get_code_ref($into, $name)); + } + return; }; } @@ -486,7 +490,7 @@ Mouse::Meta::Class - The Mouse class metaclass =head1 VERSION -This document describes Mouse version 0.53 +This document describes Mouse version 0.63 =head1 METHODS