From: Stevan Little Date: Fri, 15 Sep 2006 21:45:18 +0000 (+0000) Subject: getting this up to speed with Class::MOP 0.35 X-Git-Tag: 0_14~9 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=093b12c2fa259436d60be95e4d540085c529cced;p=gitmo%2FMoose.git getting this up to speed with Class::MOP 0.35 --- diff --git a/Build.PL b/Build.PL index 3dea010..d47c50e 100644 --- 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 --- 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 --- 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 diff --git a/lib/Moose.pm b/lib/Moose.pm index 89b9e61..8c9517b 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -1,4 +1,6 @@ +use lib '/Users/stevan/Projects/Moose/Moose/Class-MOP/trunk/lib'; + package Moose; use strict; diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 1d304a8..5feaf85 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -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')) { diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 88e9b55..5ea4b61 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -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 +=item B This accommodates Moose::Meta::Role::Method instances, which are aliased, instead of added, but still need to be counted as valid diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index 51628ac..628f12d 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -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 +=item B + =back =over 4 diff --git a/t/001_recipe.t b/t/001_recipe.t index bb493b9..7cc3550 100644 --- a/t/001_recipe.t +++ b/t/001_recipe.t @@ -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( diff --git a/t/040_meta_role.t b/t/040_meta_role.t index dfab71b..181a604 100644 --- a/t/040_meta_role.t +++ b/t/040_meta_role.t @@ -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'); diff --git a/t/041_role.t b/t/041_role.t index 2758332..875db47 100644 --- a/t/041_role.t +++ b/t/041_role.t @@ -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');