# NOTE: we need to do this in order
# for the instance meta-object to
# not fall into meta-circular death
- 'name' => sub { (shift)->{'$:package'} }
+ #
+ # we just alias the original method
+ # rather than re-produce it here
+ 'name' => \&Class::MOP::Package::name
},
init_arg => ':package',
))
Class::MOP::Attribute->new('%:namespace' => (
reader => {
# NOTE:
- # because of issues with the Perl API
- # to the typeglob in some versions, we
- # need to just always grab a new
- # reference to the hash here. Ideally
- # we could just store a ref and it would
- # Just Work, but oh well :\
- 'namespace' => sub {
- no strict 'refs';
- \%{$_[0]->name . '::'}
- }
+ # we just alias the original method
+ # rather than re-produce it here
+ 'namespace' => \&Class::MOP::Package::namespace
},
# NOTE:
# protect this from silliness
Class::MOP::Module->meta->add_attribute(
Class::MOP::Attribute->new('$:version' => (
reader => {
- 'version' => sub {
- my $self = shift;
- ${$self->get_package_symbol('$VERSION')};
- }
+ # NOTE:
+ # we just alias the original method
+ # rather than re-produce it here
+ 'version' => \&Class::MOP::Module::version
},
# NOTE:
# protect this from silliness
Class::MOP::Module->meta->add_attribute(
Class::MOP::Attribute->new('$:authority' => (
reader => {
- 'authority' => sub {
- my $self = shift;
- ${$self->get_package_symbol('$AUTHORITY')};
- }
+ # NOTE:
+ # we just alias the original method
+ # rather than re-produce it here
+ 'authority' => \&Class::MOP::Module::authority
},
# NOTE:
# protect this from silliness
reader => {
# NOTE: we need to do this in order
# for the instance meta-object to
- # not fall into meta-circular death
- 'get_attribute_map' => sub { (shift)->{'%:attributes'} }
+ # not fall into meta-circular death
+ #
+ # we just alias the original method
+ # rather than re-produce it here
+ 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map
},
init_arg => ':attributes',
default => sub { {} }
Class::MOP::Attribute->new('%:methods' => (
reader => {
# NOTE:
- # as with the $VERSION and $AUTHORITY above
- # sometimes we don't/can't store directly
- # inside the instance, so we need the accessor
- # to just DWIM
- 'get_method_map' => sub {
- my $self = shift;
- # FIXME:
- # there is a faster/better way
- # to do this, I am sure :)
- return +{
- map {
- $_ => $self->get_method($_)
- } grep {
- $self->has_method($_)
- } $self->list_all_package_symbols
- };
- }
+ # we just alias the original method
+ # rather than re-produce it here
+ 'get_method_map' => \&Class::MOP::Class::get_method_map
},
- init_arg => '!............( DO NOT DO THIS )............!',
- default => sub { \undef }
+ default => sub { {} }
))
);
reader => {
# NOTE: we need to do this in order
# for the instance meta-object to
- # not fall into meta-circular death
- 'instance_metaclass' => sub { (shift)->{'$:instance_metaclass'} }
+ # not fall into meta-circular death
+ #
+ # we just alias the original method
+ # rather than re-produce it here
+ 'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
},
init_arg => ':instance_metaclass',
default => 'Class::MOP::Instance',
reader => {
# NOTE: we need to do this in order
# for the instance meta-object to
- # not fall into meta-circular death
- 'name' => sub { (shift)->{name} }
+ # not fall into meta-circular death
+ #
+ # we just alias the original method
+ # rather than re-produce it here
+ 'name' => \&Class::MOP::Attribute::name
}
))
);
reader => {
# NOTE: we need to do this in order
# for the instance meta-object to
- # not fall into meta-circular death
- 'associated_class' => sub { (shift)->{associated_class} }
+ # not fall into meta-circular death
+ #
+ # we just alias the original method
+ # rather than re-produce it here
+ 'associated_class' => \&Class::MOP::Attribute::associated_class
}
))
);
});
## --------------------------------------------------------
+## Class::MOP::Method
+
+Class::MOP::Method->meta->add_attribute(
+ Class::MOP::Attribute->new('body' => (
+ reader => 'body'
+ ))
+);
+
+## --------------------------------------------------------
+## Class::MOP::Method::Wrapped
+
+# NOTE:
+# the way this item is initialized, this
+# really does not follow the standard
+# practices of attributes, but we put
+# it here for completeness
+Class::MOP::Method::Wrapped->meta->add_attribute(
+ Class::MOP::Attribute->new('modifier_table')
+);
+
+## --------------------------------------------------------
## Now close all the Class::MOP::* classes
Class::MOP::Package ->meta->make_immutable(inline_constructor => 0);
Class::MOP::Instance ->meta->make_immutable(inline_constructor => 0);
Class::MOP::Object ->meta->make_immutable(inline_constructor => 0);
+# Class::MOP::Method subclasses
+Class::MOP::Attribute::Accessor->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Method::Wrapped ->meta->make_immutable(inline_constructor => 0);
+
1;
__END__
use Class::MOP::Method;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
-our @ISA = ('Class::MOP::Method');
+use base 'Class::MOP::Method';
1;
'$:version' => \undef,
'$:authority' => \undef,
# defined in Class::MOP::Class
- '%:methods' => \undef,
+ '%:methods' => {},
'%:attributes' => {},
'$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
'$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method',
sub method_metaclass { $_[0]->{'$:method_metaclass'} }
sub instance_metaclass { $_[0]->{'$:instance_metaclass'} }
-sub get_method_map {
+# FIXME:
+# this is a prime canidate for conversion to XS
+sub get_method_map {
my $self = shift;
- # FIXME:
- # there is a faster/better way
- # to do this, I am sure :)
- return +{
- map {
- $_ => $self->get_method($_)
- } grep {
- $self->has_method($_)
- } $self->list_all_package_symbols
- };
+ 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} && $map->{$symbol}->body == $code;
+
+ my $gv = svref_2object($code)->GV;
+ next if ($gv->STASH->NAME || '') ne $class_name &&
+ ($gv->NAME || '') ne '__ANON__';
+
+ $map->{$symbol} = $method_metaclass->wrap($code);
+ }
+
+ return $map;
}
# Instance Construction & Cloning
my ($self, $method_name, $method) = @_;
(defined $method_name && $method_name)
|| confess "You must define a method name";
- # use reftype here to allow for blessed subs ...
- ('CODE' eq (reftype($method) || ''))
- || confess "Your code block must be a CODE reference";
- my $full_method_name = ($self->name . '::' . $method_name);
-
- # FIXME:
- # dont bless subs, its bad mkay
- $method = $self->method_metaclass->wrap($method) unless blessed($method);
- $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
+ my $body;
+ if (blessed($method)) {
+ $body = $method->body;
+ }
+ else {
+ $body = $method;
+ ('CODE' eq (reftype($body) || ''))
+ || confess "Your code block must be a CODE reference";
+ $method = $self->method_metaclass->wrap($body);
+ }
+ $self->get_method_map->{$method_name} = $method;
+
+ my $full_method_name = ($self->name . '::' . $method_name);
+ $self->add_package_symbol("&${method_name}" => subname $full_method_name => $body);
}
{
my ($self, $method_name, $method) = @_;
(defined $method_name && $method_name)
|| confess "You must define a method name";
- # use reftype here to allow for blessed subs ...
- ('CODE' eq (reftype($method) || ''))
- || confess "Your code block must be a CODE reference";
- # FIXME:
- # dont bless subs, its bad mkay
- $method = $self->method_metaclass->wrap($method) unless blessed($method);
+ my $body = (blessed($method) ? $method->body : $method);
+ ('CODE' eq (reftype($body) || ''))
+ || confess "Your code block must be a CODE reference";
- $self->add_package_symbol("&${method_name}" => $method);
-}
-
-sub find_method_by_name {
- my ($self, $method_name) = @_;
- return $self->name->can($method_name);
+ $self->add_package_symbol("&${method_name}" => $body);
}
sub has_method {
(defined $method_name && $method_name)
|| confess "You must define a method name";
- return 0 if !$self->has_package_symbol("&${method_name}");
- my $method = $self->get_package_symbol("&${method_name}");
- return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name &&
- (svref_2object($method)->GV->NAME || '') ne '__ANON__';
-
- # FIXME:
- # dont bless subs, its bad mkay
- $self->method_metaclass->wrap($method) unless blessed($method);
-
+ return 0 unless exists $self->get_method_map->{$method_name};
return 1;
}
my ($self, $method_name) = @_;
(defined $method_name && $method_name)
|| confess "You must define a method name";
-
- return unless $self->has_method($method_name);
+
+ # NOTE:
+ # I don't really need this here, because
+ # if the method_map is missing a key it
+ # will just return undef for me now
+ # return unless $self->has_method($method_name);
- return $self->get_package_symbol("&${method_name}");
+ return $self->get_method_map->{$method_name};
}
sub remove_method {
my $removed_method = $self->get_method($method_name);
- $self->remove_package_symbol("&${method_name}")
- if defined $removed_method;
+ do {
+ $self->remove_package_symbol("&${method_name}");
+ delete $self->get_method_map->{$method_name};
+ } if defined $removed_method;
return $removed_method;
}
sub get_method_list {
my $self = shift;
- grep { $self->has_method($_) } $self->list_all_package_symbols;
+ keys %{$self->get_method_map};
+}
+
+sub find_method_by_name {
+ my ($self, $method_name) = @_;
+ # FIXME
+ return $self->name->can($method_name);
}
sub compute_all_applicable_methods {
sub add_package_symbol { confess 'Cannot call method "add_package_symbol" on an immutable instance' }
sub remove_package_symbol { confess 'Cannot call method "remove_package_symbol" on an immutable instance' }
+sub get_package_symbol {
+ my ($self, $variable) = @_;
+ my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable);
+ return *{$self->namespace->{$name}}{$type}
+ if exists $self->namespace->{$name};
+ # NOTE:
+ # we have to do this here in order to preserve
+ # perl's autovivification of variables. However
+ # we do cut off direct access to add_package_symbol
+ # as shown above.
+ $self->Class::MOP::Package::add_package_symbol($variable);
+}
+
# NOTE:
# superclasses is an accessor, so
# it just cannot be changed
)
);
}
+
+ # now cache the method map ...
+ $metaclass->{'___method_map'} = $metaclass->get_method_map;
bless $metaclass => $class;
}
sub class_precedence_list { @{(shift)->{'___class_precedence_list'}} }
sub compute_all_applicable_attributes { @{(shift)->{'___compute_all_applicable_attributes'}} }
sub get_mutable_metaclass_name { (shift)->{'___original_class'} }
+sub get_method_map { (shift)->{'___method_map'} }
1;
=item B<remove_package_symbol>
+=back
+
+=head2 Methods which work slightly differently.
+
+=over 4
+
=item B<superclasses>
+This method becomes read-only in an immutable class.
+
+=item B<get_package_symbol>
+
+This method must handle package variable autovivification
+correctly, while still disallowing C<add_package_symbol>.
+
=back
=head2 Cached methods
=item B<get_meta_instance>
+=item B<get_method_map>
+
=back
=head1 AUTHORS
our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
+# NOTE:
+# if poked in the right way,
+# they should act like CODE refs.
+use overload '&{}' => sub { $_[0]->{body} }, fallback => 1;
+
# introspection
sub meta {
my $code = shift;
('CODE' eq (reftype($code) || ''))
|| confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
- bless $code => blessed($class) || $class;
+ bless {
+ body => $code
+ } => blessed($class) || $class;
}
+## accessors
+
+sub body { (shift)->{body} }
+
# informational
+# NOTE:
+# this may not be the same name
+# as the class you got it from
+# This gets the package stash name
+# associated with the actual CODE-ref
sub package_name {
- my $code = shift;
- (blessed($code))
- || confess "Can only ask the package name of a blessed CODE";
+ my $code = (shift)->{body};
svref_2object($code)->GV->STASH->NAME;
}
+# NOTE:
+# this may not be the same name
+# as the method name it is stored
+# with. This gets the name associated
+# with the actual CODE-ref
sub name {
- my $code = shift;
- (blessed($code))
- || confess "Can only ask the package name of a blessed CODE";
+ my $code = (shift)->{body};
svref_2object($code)->GV->NAME;
}
sub fully_qualified_name {
my $code = shift;
- (blessed($code))
- || confess "Can only ask the package name of a blessed CODE";
$code->package_name . '::' . $code->name;
}
use Scalar::Util 'reftype', 'blessed';
use Sub::Name 'subname';
-our $VERSION = '0.01';
+our $VERSION = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
-our @ISA = ('Class::MOP::Method');
+use base 'Class::MOP::Method';
# NOTE:
# this ugly beast is the result of trying
}
};
-my %MODIFIERS;
-
sub wrap {
my $class = shift;
my $code = shift;
(blessed($code) && $code->isa('Class::MOP::Method'))
- || confess "Can only wrap blessed CODE";
+ || confess "Can only wrap blessed CODE";
my $modifier_table = {
cache => undef,
orig => $code,
before => [],
after => [],
around => {
- cache => $code,
+ cache => $code->body,
methods => [],
},
};
$_build_wrapped_method->($modifier_table);
my $method = $class->SUPER::wrap(sub { $modifier_table->{cache}->(@_) });
- $MODIFIERS{$method} = $modifier_table;
+ $method->{modifier_table} = $modifier_table;
$method;
}
sub get_original_method {
my $code = shift;
- $MODIFIERS{$code}->{orig}
- if exists $MODIFIERS{$code};
+ $code->{modifier_table}->{orig};
}
sub add_before_modifier {
my $code = shift;
my $modifier = shift;
- (exists $MODIFIERS{$code})
- || confess "You must first wrap your method before adding a modifier";
- (blessed($code))
- || confess "Can only ask the package name of a blessed CODE";
- ('CODE' eq (reftype($code) || ''))
- || confess "You must supply a CODE reference for a modifier";
- unshift @{$MODIFIERS{$code}->{before}} => $modifier;
- $_build_wrapped_method->($MODIFIERS{$code});
+ unshift @{$code->{modifier_table}->{before}} => $modifier;
+ $_build_wrapped_method->($code->{modifier_table});
}
sub add_after_modifier {
my $code = shift;
my $modifier = shift;
- (exists $MODIFIERS{$code})
- || confess "You must first wrap your method before adding a modifier";
- (blessed($code))
- || confess "Can only ask the package name of a blessed CODE";
- ('CODE' eq (reftype($code) || ''))
- || confess "You must supply a CODE reference for a modifier";
- push @{$MODIFIERS{$code}->{after}} => $modifier;
- $_build_wrapped_method->($MODIFIERS{$code});
+ push @{$code->{modifier_table}->{after}} => $modifier;
+ $_build_wrapped_method->($code->{modifier_table});
}
{
sub add_around_modifier {
my $code = shift;
my $modifier = shift;
- (exists $MODIFIERS{$code})
- || confess "You must first wrap your method before adding a modifier";
- (blessed($code))
- || confess "Can only ask the package name of a blessed CODE";
- ('CODE' eq (reftype($code) || ''))
- || confess "You must supply a CODE reference for a modifier";
- unshift @{$MODIFIERS{$code}->{around}->{methods}} => $modifier;
- $MODIFIERS{$code}->{around}->{cache} = $compile_around_method->(
- @{$MODIFIERS{$code}->{around}->{methods}},
- $MODIFIERS{$code}->{orig}
+ unshift @{$code->{modifier_table}->{around}->{methods}} => $modifier;
+ $code->{modifier_table}->{around}->{cache} = $compile_around_method->(
+ @{$code->{modifier_table}->{around}->{methods}},
+ $code->{modifier_table}->{orig}->body
);
- $_build_wrapped_method->($MODIFIERS{$code});
+ $_build_wrapped_method->($code->{modifier_table});
}
}
=over 4
+=item B<body>
+
=item B<name>
=item B<package_name>
}
sub list_all_package_symbols {
- my ($self) = @_;
- return keys %{$self->namespace};
+ my ($self, $type_filter) = @_;
+ return keys %{$self->namespace} unless defined $type_filter;
+ # NOTE:
+ # or we can filter based on
+ # type (SCALAR|ARRAY|HASH|CODE)
+ my $namespace = $self->namespace;
+ return grep {
+ defined(*{$namespace->{$_}}{$type_filter})
+ } keys %{$namespace};
}
1;
This will attempt to remove the entire typeglob associated with
C<$glob_name> from the package.
-=item B<list_all_package_symbols>
+=item B<list_all_package_symbols (?$type_filter)>
This will list all the glob names associated with the current package.
By inspecting the globs returned you can discern all the variables in
the package.
+By passing a C<$type_filter>, you can limit the list to only those
+which match the filter (either SCALAR, ARRAY, HASH or CODE).
+
=back
=head1 AUTHORS
use strict;
use warnings;
-use Test::More tests => 17;
+use Test::More tests => 19;
BEGIN {
use_ok('Class::MOP');
# make sure we are tracking metaclasses correctly
my %METAS = (
- 'Class::MOP::Attribute' => Class::MOP::Attribute->meta,
- 'Class::MOP::Package' => Class::MOP::Package->meta,
- 'Class::MOP::Module' => Class::MOP::Module->meta,
- 'Class::MOP::Class' => Class::MOP::Class->meta,
- 'Class::MOP::Method' => Class::MOP::Method->meta,
- 'Class::MOP::Instance' => Class::MOP::Instance->meta,
- 'Class::MOP::Object' => Class::MOP::Object->meta,
+ 'Class::MOP::Attribute' => Class::MOP::Attribute->meta,
+ 'Class::MOP::Attribute::Accessor' => Class::MOP::Attribute::Accessor->meta,
+ 'Class::MOP::Package' => Class::MOP::Package->meta,
+ 'Class::MOP::Module' => Class::MOP::Module->meta,
+ 'Class::MOP::Class' => Class::MOP::Class->meta,
+ 'Class::MOP::Method' => Class::MOP::Method->meta,
+ 'Class::MOP::Method::Wrapped' => Class::MOP::Method::Wrapped->meta,
+ 'Class::MOP::Instance' => Class::MOP::Instance->meta,
+ 'Class::MOP::Object' => Class::MOP::Object->meta,
);
ok($_->is_immutable(), '... ' . $_->name . ' is immutable') for values %METAS;
is_deeply(
[ sort { $a->name cmp $b->name } Class::MOP::get_all_metaclass_instances ],
[
- Class::MOP::Attribute->meta,
+ Class::MOP::Attribute->meta,
+ Class::MOP::Attribute::Accessor->meta,
Class::MOP::Class->meta,
Class::MOP::Instance->meta,
Class::MOP::Method->meta,
+ Class::MOP::Method::Wrapped->meta,
Class::MOP::Module->meta,
Class::MOP::Object->meta,
Class::MOP::Package->meta,
is_deeply(
[ sort { $a cmp $b } Class::MOP::get_all_metaclass_names() ],
[ qw/
- Class::MOP::Attribute
+ Class::MOP::Attribute
+ Class::MOP::Attribute::Accessor
Class::MOP::Class
Class::MOP::Instance
Class::MOP::Method
+ Class::MOP::Method::Wrapped
Class::MOP::Module
Class::MOP::Object
Class::MOP::Package
/ ],
- '... got all the metaclass names');
-
-is_deeply(
- [ map { $_->meta->identifier } sort { $a cmp $b } Class::MOP::get_all_metaclass_names() ],
- [
- "Class::MOP::Attribute-" . $Class::MOP::Attribute::VERSION . "-cpan:STEVAN",
- "Class::MOP::Class-" . $Class::MOP::Class::VERSION . "-cpan:STEVAN",
- "Class::MOP::Instance-" . $Class::MOP::Instance::VERSION . "-cpan:STEVAN",
- "Class::MOP::Method-" . $Class::MOP::Method::VERSION . "-cpan:STEVAN",
- "Class::MOP::Module-" . $Class::MOP::Module::VERSION . "-cpan:STEVAN",
- "Class::MOP::Object-" . $Class::MOP::Object::VERSION . "-cpan:STEVAN",
- "Class::MOP::Package-" . $Class::MOP::Package::VERSION . "-cpan:STEVAN",
- ],
- '... got all the metaclass identifiers');
-
-
\ No newline at end of file
use strict;
use warnings;
-use Test::More tests => 56;
+use Test::More tests => 64;
use Test::Exception;
use Scalar::Util qw/reftype/;
$Foo->add_method('foo' => $foo);
} '... we added the method successfully';
-isa_ok($foo, 'Class::MOP::Method');
+my $foo_method = $Foo->get_method('foo');
-is($foo->name, 'foo', '... got the right name for the method');
-is($foo->package_name, 'Foo', '... got the right package name for the method');
+isa_ok($foo_method, 'Class::MOP::Method');
+
+is($foo_method->name, 'foo', '... got the right name for the method');
+is($foo_method->package_name, 'Foo', '... got the right package name for the method');
ok($Foo->has_method('foo'), '... Foo->has_method(foo) (defined with Sub::Name)');
-is($Foo->get_method('foo'), $foo, '... Foo->get_method(foo) == \&foo');
+is($Foo->get_method('foo')->body, $foo, '... Foo->get_method(foo) == \&foo');
is(Foo->foo(), 'Foo::foo', '... Foo->foo() returns "Foo::foo"');
# now check all our other items ...
# calling get_method blessed them all
-isa_ok($_, 'Class::MOP::Method') for (
- \&Foo::FOO_CONSTANT,
- \&Foo::bar,
- \&Foo::baz,
- \&Foo::floob,
- \&Foo::blah,
- \&Foo::bling,
- \&Foo::bang,
- \&Foo::evaled_foo,
- );
+for my $method_name (qw/FOO_CONSTANT
+ bar
+ baz
+ floob
+ blah
+ bling
+ bang
+ evaled_foo/) {
+ isa_ok($Foo->get_method($method_name), 'Class::MOP::Method');
+ {
+ no strict 'refs';
+ is($Foo->get_method($method_name)->body, \&{'Foo::' . $method_name}, '... body matches CODE ref in package');
+ }
+}
{
package Foo::Aliasing;
{
name => $_,
class => 'Foo',
- code => $Foo->get_method($_)
+ code => $Foo->get_method($_)
}
} qw(
FOO_CONSTANT
],
'... got the right list of applicable methods for Foo');
-is($Foo->remove_method('foo'), $foo, '... removed the foo method');
+is($Foo->remove_method('foo')->body, $foo, '... removed the foo method');
ok(!$Foo->has_method('foo'), '... !Foo->has_method(foo) we just removed it');
dies_ok { Foo->foo } '... cannot call Foo->foo because it is not there';
{
name => 'bang',
class => 'Foo',
- code => $Foo->get_method('bang')
+ code => $Foo->get_method('bang')
},
{
name => 'bar',
class => 'Bar',
- code => $Bar->get_method('bar')
+ code => $Bar->get_method('bar')
},
(map {
{
name => $_,
class => 'Foo',
- code => $Foo->get_method($_)
+ code => $Foo->get_method($_)
}
} qw(
baz
{
name => 'foo',
class => 'Bar',
- code => $Bar->get_method('foo')
+ code => $Bar->get_method('foo')
},
{
name => 'meta',
class => 'Bar',
- code => $Bar->get_method('meta')
+ code => $Bar->get_method('meta')
}
],
'... got the right list of applicable methods for Bar');
{
name => 'BUILD',
class => 'Foo',
- code => \&Foo::BUILD
+ code => Class::MOP::Class->initialize('Foo')->get_method('BUILD')
},
{
name => 'foo',
class => 'Foo',
- code => \&Foo::foo
- },
+ code => Class::MOP::Class->initialize('Foo')->get_method('foo')
+ },
],
'... got the right list of applicable methods for Foo');
{
name => 'BUILD',
class => 'Bar',
- code => \&Bar::BUILD
+ code => Class::MOP::Class->initialize('Bar')->get_method('BUILD')
},
{
name => 'bar',
class => 'Bar',
- code => \&Bar::bar
+ code => Class::MOP::Class->initialize('Bar')->get_method('bar')
},
{
name => 'foo',
class => 'Foo',
- code => \&Foo::foo
+ code => Class::MOP::Class->initialize('Foo')->get_method('foo')
},
],
'... got the right list of applicable methods for Bar');
{
name => 'BUILD',
class => 'Bar',
- code => \&Bar::BUILD
+ code => Class::MOP::Class->initialize('Bar')->get_method('BUILD')
},
{
name => 'bar',
class => 'Bar',
- code => \&Bar::bar
+ code => Class::MOP::Class->initialize('Bar')->get_method('bar')
},
{
name => 'baz',
class => 'Baz',
- code => \&Baz::baz
+ code => Class::MOP::Class->initialize('Baz')->get_method('baz')
},
{
name => 'foo',
class => 'Baz',
- code => \&Baz::foo
+ code => Class::MOP::Class->initialize('Baz')->get_method('foo')
},
],
'... got the right list of applicable methods for Baz');
{
name => 'BUILD',
class => 'Foo::Bar',
- code => \&Foo::Bar::BUILD
+ code => Class::MOP::Class->initialize('Foo::Bar')->get_method('BUILD')
},
{
name => 'bar',
class => 'Bar',
- code => \&Bar::bar
+ code => Class::MOP::Class->initialize('Bar')->get_method('bar')
},
{
name => 'foo',
class => 'Foo',
- code => \&Foo::foo
+ code => Class::MOP::Class->initialize('Foo')->get_method('foo')
},
{
name => 'foobar',
class => 'Foo::Bar',
- code => \&Foo::Bar::foobar
+ code => Class::MOP::Class->initialize('Foo::Bar')->get_method('foobar')
},
],
'... got the right list of applicable methods for Foo::Bar');
{
name => 'BUILD',
class => 'Foo::Bar::Baz',
- code => \&Foo::Bar::Baz::BUILD
+ code => Class::MOP::Class->initialize('Foo::Bar::Baz')->get_method('BUILD')
},
{
name => 'bar',
class => 'Foo::Bar::Baz',
- code => \&Foo::Bar::Baz::bar
+ code => Class::MOP::Class->initialize('Foo::Bar::Baz')->get_method('bar')
},
{
name => 'baz',
class => 'Baz',
- code => \&Baz::baz
+ code => Class::MOP::Class->initialize('Baz')->get_method('baz')
},
{
name => 'foo',
class => 'Foo',
- code => \&Foo::foo
+ code => Class::MOP::Class->initialize('Foo')->get_method('foo')
},
{
name => 'foobarbaz',
class => 'Foo::Bar::Baz',
- code => \&Foo::Bar::Baz::foobarbaz
+ code => Class::MOP::Class->initialize('Foo::Bar::Baz')->get_method('foobarbaz')
},
],
'... got the right list of applicable methods for Foo::Bar::Baz');
{
name => 'BUILD',
class => 'Foo::Bar',
- code => \&Foo::Bar::BUILD
+ code => Class::MOP::Class->initialize('Foo::Bar')->get_method('BUILD')
},
{
name => 'BUILD',
class => 'Foo',
- code => \&Foo::BUILD
+ code => Class::MOP::Class->initialize('Foo')->get_method('BUILD')
},
{
name => 'BUILD',
class => 'Bar',
- code => \&Bar::BUILD
+ code => Class::MOP::Class->initialize('Bar')->get_method('BUILD')
}
],
'... got the right list of BUILD methods for Foo::Bar');
{
name => 'BUILD',
class => 'Foo::Bar::Baz',
- code => \&Foo::Bar::Baz::BUILD
+ code => Class::MOP::Class->initialize('Foo::Bar::Baz')->get_method('BUILD')
},
{
name => 'BUILD',
class => 'Foo',
- code => \&Foo::BUILD
+ code => Class::MOP::Class->initialize('Foo')->get_method('BUILD')
},
{
name => 'BUILD',
class => 'Bar',
- code => \&Bar::BUILD
+ code => Class::MOP::Class->initialize('Bar')->get_method('BUILD')
},
],
'... got the right list of BUILD methods for Foo::Bar::Baz');
\ No newline at end of file
ok($class_mop_class_meta->has_method($method_name), '... Class::MOP::Class->has_method(' . $method_name . ')');
{
no strict 'refs';
- is($class_mop_class_meta->get_method($method_name),
+ is($class_mop_class_meta->get_method($method_name)->body,
\&{'Class::MOP::Class::' . $method_name},
'... Class::MOP::Class->get_method(' . $method_name . ') == &Class::MOP::Class::' . $method_name);
}
ok($class_mop_package_meta->has_method($method_name), '... Class::MOP::Package->has_method(' . $method_name . ')');
{
no strict 'refs';
- is($class_mop_package_meta->get_method($method_name),
+ is($class_mop_package_meta->get_method($method_name)->body,
\&{'Class::MOP::Package::' . $method_name},
'... Class::MOP::Package->get_method(' . $method_name . ') == &Class::MOP::Package::' . $method_name);
}
ok($class_mop_module_meta->has_method($method_name), '... Class::MOP::Module->has_method(' . $method_name . ')');
{
no strict 'refs';
- is($class_mop_module_meta->get_method($method_name),
+ is($class_mop_module_meta->get_method($method_name)->body,
\&{'Class::MOP::Module::' . $method_name},
'... Class::MOP::Module->get_method(' . $method_name . ') == &Class::MOP::Module::' . $method_name);
}
projects / gitmo/Class-MOP.git / commitdiff