some minor tweaks

[gitmo/Moose.git] / lib / Moose / Meta / Class.pm

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index af5c401..3f927f5 100644 (file)
--- 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.18';
 our $AUTHORITY = 'cpan:STEVAN';
 
 use Moose::Meta::Method::Overriden;
@@ -110,7 +110,7 @@ sub get_method_map {
     my $self = shift;
 
     if (defined $self->{'$!_package_cache_flag'} &&
-                $self->{'$!_package_cache_flag'} == Class::MOP::check_package_cache_flag(blessed $self)) {
+                $self->{'$!_package_cache_flag'} == Class::MOP::check_package_cache_flag($self->meta->name)) {
         return $self->{'%!methods'};
     }
 
@@ -158,18 +158,7 @@ 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($self->_process_attribute(@_));
 }
 
 sub add_override_method_modifier {
@@ -185,7 +174,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 +208,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 +267,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 +299,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 +348,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 +513,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>