use Sub::Name 'subname';
use B 'svref_2object';
-our $VERSION = '0.15';
+our $VERSION = '0.17';
use base 'Class::MOP::Module';
$class = blessed($class) || $class;
# now create the metaclass
my $meta;
- if ($class =~ /^Class::MOP::/) {
+ if ($class =~ /^Class::MOP::Class$/) {
$meta = bless {
'$:package' => $package_name,
'%:attributes' => {},
sub superclasses {
my $self = shift;
- no strict 'refs';
if (@_) {
my @supers = @_;
- @{$self->name . '::ISA'} = @supers;
+ @{$self->get_package_symbol('@ISA')} = @supers;
# NOTE:
# we need to check the metaclass
# compatability here so that we can
# we don't know about
$self->check_metaclass_compatability();
}
- @{$self->name . '::ISA'};
+ @{$self->get_package_symbol('@ISA')};
}
sub class_precedence_list {
|| 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);
- no strict 'refs';
- no warnings 'redefine';
- *{$full_method_name} = subname $full_method_name => $method;
+ $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method);
}
{
# 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);
- no strict 'refs';
- no warnings 'redefine';
- *{$full_method_name} = $method;
+ $self->add_package_symbol("&${method_name}" => $method);
+}
+
+sub find_method_by_name {
+ my ($self, $method_name) = @_;
+ return $self->name->can($method_name);
}
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);
- no strict 'refs';
- return 0 if !defined(&{$sub_name});
- my $method = \&{$sub_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__';
-
- # at this point we are relatively sure
- # it is our method, so we bless/wrap it
+
+ # FIXME:
+ # dont bless subs, its bad mkay
$self->method_metaclass->wrap($method) unless blessed($method);
+
return 1;
}
|| confess "You must define a method name";
return unless $self->has_method($method_name);
-
- no strict 'refs';
- return \&{$self->name . '::' . $method_name};
+
+ return $self->get_package_symbol("&${method_name}");
}
sub remove_method {
my $removed_method = $self->get_method($method_name);
- no strict 'refs';
- delete ${$self->name . '::'}{$method_name}
+ $self->remove_package_symbol("&${method_name}")
if defined $removed_method;
return $removed_method;
sub get_method_list {
my $self = shift;
- no strict 'refs';
- grep { $self->has_method($_) } keys %{$self->name . '::'};
+ grep { $self->has_method($_) } $self->list_all_package_symbols;
}
sub compute_all_applicable_methods {
$attribute->attach_to_class($self);
$attribute->install_accessors();
$self->get_attribute_map->{$attribute->name} = $attribute;
-
- # FIXME
- # in theory we have to tell everyone the slot structure may have changed
}
sub has_attribute {
This will return a CODE reference of the specified C<$method_name>,
or return undef if that method does not exist.
+=item B<find_method_by_name ($method_name>
+
+This will return a CODE reference of the specified C<$method_name>,
+or return undef if that method does not exist.
+
+Unlike C<get_method> this will also look in the superclasses.
+
=item B<remove_method ($method_name)>
This will attempt to remove a given C<$method_name> from the class.
=back
-=head1 AUTHOR
+=head1 AUTHORS
Stevan Little E<lt>stevan@iinteractive.comE<gt>
+Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
+
=head1 COPYRIGHT AND LICENSE
Copyright 2006 by Infinity Interactive, Inc.