getting this up to speed with Class::MOP 0.35
Stevan Little [Fri, 15 Sep 2006 21:45:18 +0000 (21:45 +0000)]
Build.PL
Changes
README
lib/Moose.pm
lib/Moose/Meta/Attribute.pm
lib/Moose/Meta/Class.pm
lib/Moose/Meta/Role.pm
t/001_recipe.t
t/040_meta_role.t
t/041_role.t

index 3dea010..d47c50e 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -11,7 +11,7 @@ my $build = Module::Build->new(
     requires => {
         'Scalar::Util'       => $win32 ? '1.17' : '1.18',
         'Carp'               => '0',
-        'Class::MOP'         => '0.34',
+        'Class::MOP'         => '0.35',
         'Sub::Name'          => '0.02',
         'Sub::Exporter'      => '0.954',
         'Sub::Install'       => '0.92',   
diff --git a/Changes b/Changes
index 1f8e02f..94a6e63 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,9 +1,18 @@
 Revision history for Perl extension Moose
 
 0.13
+    ++ NOTE ++
+    This version of Moose *must* have Class::MOP 0.35 in order 
+    to work correctly. A number of small internal tweaks have 
+    been made in order to be compatible with that release.
+
     * Moose
       - Removed the use of UNIVERSAL::require to be a better
-        symbol table citizen and remove a dependency.
+        symbol table citizen and remove a dependency 
+        (thanks Adam Kennedy)
+      - unimport now returns a true value, this should allow
+        'no Moose' to be used instead of 1; at the end of a 
+        module.
 
     * Moose::Cookbook
       - added a FAQ and WTF files to document frequently 
@@ -21,6 +30,7 @@ Revision history for Perl extension Moose
     * Build.PL
       - Scalar::Util 1.18 is bad on Win32, so temporarily
         only require version 1.17 for Win32 and cygwin.
+        (thanks Adam Kennedy)        
 
 0.12 Sat. Sept. 1, 2006
     * Moose::Cookbook
diff --git a/README b/README
index f94b90c..914c6bf 100644 (file)
--- a/README
+++ b/README
@@ -20,7 +20,6 @@ This module requires these other modules and libraries:
        Scalar::Util
        Carp
        Sub::Name
-       UNIVERSAL::require
        Sub::Exporter
        B
 
index 89b9e61..8c9517b 100644 (file)
@@ -1,4 +1,6 @@
 
+use lib '/Users/stevan/Projects/Moose/Moose/Class-MOP/trunk/lib';
+
 package Moose;
 
 use strict;
index 1d304a8..5feaf85 100644 (file)
@@ -455,8 +455,8 @@ sub _get_delegate_method_list {
     my $self = shift;
     my $meta = $self->_find_delegate_metaclass;
     if ($meta->isa('Class::MOP::Class')) {
-        return map  { $_->{name}                     } 
-               grep { $_->{class} ne 'Moose::Object' } 
+        return map  { $_->{name}                     }  # NOTE: !never! delegate &meta
+               grep { $_->{class} ne 'Moose::Object' && $_->{name} ne 'meta' } 
                     $meta->compute_all_applicable_methods;
     }
     elsif ($meta->isa('Moose::Meta::Role')) {
index 88e9b55..5ea4b61 100644 (file)
@@ -94,24 +94,63 @@ 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'}; 
     
-    # FIXME:
-    # this should use the ::Package code
-    # and not turn off strict refs
-    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);    
+    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->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);
+    }
+    
+    return $map;
 }
 
+#sub find_method_by_name {
+#    my ($self, $method_name) = @_;
+#    (defined $method_name && $method_name)
+#        || confess "You must define a method name to find";    
+#    # keep a record of what we have seen
+#    # here, this will handle all the 
+#    # inheritence issues because we are 
+#    # using the &class_precedence_list
+#    my %seen_class;
+#    foreach my $class ($self->class_precedence_list()) {
+#        next if $seen_class{$class};
+#        $seen_class{$class}++;
+#        # fetch the meta-class ...
+#        my $meta = $self->initialize($class);
+#        return $meta->get_method($method_name) 
+#            if $meta->has_method($method_name);
+#    }
+#}
+
+### ---------------------------------------------
+
 sub add_attribute {
     my $self = shift;
     my $name = shift;
@@ -137,13 +176,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 {
@@ -322,7 +361,7 @@ 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 accommodates Moose::Meta::Role::Method instances, which are 
 aliased, instead of added, but still need to be counted as valid 
index 51628ac..628f12d 100644 (file)
@@ -149,26 +149,29 @@ sub _clean_up_required_methods {
 ## methods
 
 # FIXME:
+# this is an UGLY hack
+sub get_method_map {    
+    my $self = shift;
+    $self->{'%:methods'} ||= {}; 
+    $self->Moose::Meta::Class::get_method_map() 
+}
+
+# FIXME:
 # Yes, this is a really really UGLY hack
 # but it works, and until I can figure 
 # out a better way, this is gonna be it. 
 
 sub get_method          { (shift)->Moose::Meta::Class::get_method(@_)          }
-sub find_method_by_name { (shift)->Moose::Meta::Class::find_method_by_name(@_) }
 sub has_method          { (shift)->Moose::Meta::Class::has_method(@_)          }
 sub alias_method        { (shift)->Moose::Meta::Class::alias_method(@_)        }
-sub get_method_list { 
-    my ($self) = @_;
-    grep { 
-        # NOTE:
-        # this is a kludge for now,... these functions 
-        # should not be showing up in the list at all, 
-        # but they do, so we need to switch Moose::Role
-        # and Moose to use Sub::Exporter to prevent this
-        !/^(meta|has|extends|blessed|confess|augment|inner|override|super|before|after|around|with|requires)$/ 
-    } $self->Moose::Meta::Class::get_method_list;
+sub get_method_list     { 
+    grep {
+        !/meta/
+    } (shift)->Moose::Meta::Class::get_method_list(@_)     
 }
 
+sub find_method_by_name { (shift)->has_method(@_) }
+
 # ... however the items in statis (attributes & method modifiers)
 # can be removed and added to through this API
 
@@ -376,7 +379,7 @@ sub _apply_methods {
         # it if it has one already
         if ($other->has_method($method_name) &&
             # and if they are not the same thing ...
-            $other->get_method($method_name) != $self->get_method($method_name)) {
+            $other->get_method($method_name)->body != $self->get_method($method_name)->body) {
             # see if we are composing into a role
             if ($other->isa('Moose::Meta::Role')) { 
                 # method conflicts between roles result 
@@ -625,6 +628,8 @@ probably not that much really).
 
 =item B<get_method_list>
 
+=item B<get_method_map>
+
 =back
 
 =over 4
index bb493b9..7cc3550 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 55;
+use Test::More tests => 56;
 use Test::Exception;
 
 BEGIN {
@@ -125,7 +125,7 @@ is_deeply(
        [ 'Moose::Object' ],
        '... Point got the automagic base class');
 
-my @Point_methods = qw(x y clear);
+my @Point_methods = qw(meta x y clear);
 my @Point_attrs   = ('x', 'y');
 
 is_deeply(
index dfab71b..181a604 100644 (file)
@@ -28,7 +28,7 @@ is($foo_role->version, '0.01', '... got the right version of FooRole');
 # methods ...
 
 ok($foo_role->has_method('foo'), '... FooRole has the foo method');
-is($foo_role->get_method('foo'), \&FooRole::foo, '... FooRole got the foo method');
+is($foo_role->get_method('foo')->body, \&FooRole::foo, '... FooRole got the foo method');
 
 isa_ok($foo_role->get_method('foo'), 'Moose::Meta::Role::Method');
 
index 2758332..875db47 100644 (file)
@@ -57,12 +57,12 @@ is($foo_role->version, '0.01', '... got the right version of FooRole');
 # methods ...
 
 ok($foo_role->has_method('foo'), '... FooRole has the foo method');
-is($foo_role->get_method('foo'), \&FooRole::foo, '... FooRole got the foo method');
+is($foo_role->get_method('foo')->body, \&FooRole::foo, '... FooRole got the foo method');
 
 isa_ok($foo_role->get_method('foo'), 'Moose::Meta::Role::Method');
 
 ok($foo_role->has_method('boo'), '... FooRole has the boo method');
-is($foo_role->get_method('boo'), \&FooRole::boo, '... FooRole got the boo method');
+is($foo_role->get_method('boo')->body, \&FooRole::boo, '... FooRole got the boo method');
 
 isa_ok($foo_role->get_method('boo'), 'Moose::Meta::Role::Method');