foo

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

diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm
index 14073d9..d040693 100644 (file)
--- a/lib/Moose/Meta/Class.pm
+++ b/lib/Moose/Meta/Class.pm
@@ -9,7 +9,9 @@ use Class::MOP;
 use Carp         'confess';
 use Scalar::Util 'weaken', 'blessed', 'reftype';
 
-our $VERSION = '0.07';
+our $VERSION = '0.09';
+
+use Moose::Meta::Method::Overriden;
 
 use base 'Class::MOP::Class';
 
@@ -23,6 +25,7 @@ sub initialize {
     my $pkg   = shift;
     $class->SUPER::initialize($pkg,
         ':attribute_metaclass' => 'Moose::Meta::Attribute', 
+        ':method_metaclass'    => 'Moose::Meta::Method',
         ':instance_metaclass'  => 'Moose::Meta::Instance', 
         @_);
 }  
@@ -94,21 +97,44 @@ sub construct_instance {
     return $instance;
 }
 
-sub has_method {
-    my ($self, $method_name) = @_;
-    (defined $method_name && $method_name)
-        || confess "You must define a method name";    
 
-    my $sub_name = ($self->name . '::' . $method_name);   
+# FIXME:
+# This is ugly
+sub get_method_map {    
+    my $self = shift;
+    my $map  = $self->{'%:methods'}; 
+    
+    my $class_name       = $self->name;
+    my $method_metaclass = $self->method_metaclass;
+    
+    foreach my $symbol ($self->list_all_package_symbols('CODE')) {
+        
+        my $code = $self->get_package_symbol('&' . $symbol);
+        
+        next if exists  $map->{$symbol} && 
+                defined $map->{$symbol} && 
+                        $map->{$symbol}->body == $code;        
+        
+        my $gv = B::svref_2object($code)->GV;
+        
+        my $pkg = $gv->STASH->NAME;
+        if ($pkg->can('meta') && $pkg->meta && $pkg->meta->isa('Moose::Meta::Role')) {
+            #my $role = $pkg->meta->name;
+            #next unless $self->does_role($role);
+        }
+        else {
+            next if ($gv->STASH->NAME || '') ne $class_name &&
+                    ($gv->NAME        || '') ne '__ANON__';                
+        }
+   
+        $map->{$symbol} = $method_metaclass->wrap($code);
+    }
     
-    no strict 'refs';
-    return 0 if !defined(&{$sub_name});        
-       my $method = \&{$sub_name};
-       
-       return 1 if blessed($method) && $method->isa('Moose::Meta::Role::Method');
-    return $self->SUPER::has_method($method_name);    
+    return $map;
 }
 
+### ---------------------------------------------
+
 sub add_attribute {
     my $self = shift;
     my $name = shift;
@@ -134,13 +160,13 @@ sub add_override_method_modifier {
     my $super = $self->find_next_method_by_name($name);
     (defined $super)
         || confess "You cannot override '$name' because it has no super method";    
-    $self->add_method($name => bless sub {
+    $self->add_method($name => Moose::Meta::Method::Overriden->wrap(sub {
         my @args = @_;
         no strict   'refs';
         no warnings 'redefine';
         local *{$_super_package . '::super'} = sub { $super->(@args) };
         return $method->(@args);
-    } => 'Moose::Meta::Method::Overriden');
+    }));
 }
 
 sub add_augment_method_modifier {
@@ -174,8 +200,7 @@ sub add_augment_method_modifier {
 
 sub _find_next_method_by_name_which_is_not_overridden {
     my ($self, $name) = @_;
-    my @methods = $self->find_all_methods_by_name($name);
-    foreach my $method (@methods) {
+    foreach my $method ($self->find_all_methods_by_name($name)) {
         return $method->{code} 
             if blessed($method->{code}) && !$method->{code}->isa('Moose::Meta::Method::Overriden');
     }
@@ -226,6 +251,10 @@ sub _apply_all_roles {
         $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);
@@ -268,15 +297,6 @@ sub _process_inherited_attribute {
     return $new_attr;
 }
 
-package Moose::Meta::Method::Overriden;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.01';
-
-use base 'Class::MOP::Method';
-
 1;
 
 __END__
@@ -316,9 +336,9 @@ you are doing.
 This method makes sure to handle the moose weak-ref, type-constraint
 and type coercion features. 
 
-=item B<has_method ($name)>
+=item B<get_method_map>
 
-This accomidates Moose::Meta::Role::Method instances, which are 
+This accommodates Moose::Meta::Role::Method instances, which are 
 aliased, instead of added, but still need to be counted as valid 
 methods.
 
@@ -332,6 +352,8 @@ it in the package.
 This will create an C<augment> method modifier for you, and install 
 it in the package.
 
+=item B<calculate_all_roles>
+
 =item B<roles>
 
 This will return an array of C<Moose::Meta::Role> instances which are