);
}
-# This doesn't always get initialized in a constructor because there is a
-# weird object construction path for subclasses of Class::MOP::Class. At one
-# point, this always got initialized by calling into the XS code first, but
-# that is no longer guaranteed to happen.
-sub _method_map { $_[0]->{'methods'} ||= {} }
-
sub wrap_method_body {
my ( $self, %args ) = @_;
( defined $method_name && length $method_name )
|| confess "You must define a method name";
- my $removed_method = delete $self->_full_method_map->{$method_name};
+ my $removed_method = delete $self->_method_map->{$method_name};
$self->remove_package_symbol(
{ sigil => '&', type => 'CODE', name => $method_name } );
mop_update_method_map(pTHX_ SV *const self, SV *const class_name, HV *const stash, HV *const map)
{
const char *const class_name_pv = HvNAME(stash); /* must be HvNAME(stash), not SvPV_nolen_const(class_name) */
- SV *method_metaclass_name;
char *method_name;
I32 method_name_len;
SV *coderef;
HV *symbols;
- dSP;
symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE);
sv_2mortal((SV*)symbols);
char *cvpkg_name;
char *cv_name;
SV *method_slot;
- SV *method_object;
if (!mop_get_code_info(coderef, &cvpkg_name, &cv_name)) {
continue;
if ( SvROK(body) && ((CV *) SvRV(body)) == cv ) {
continue;
}
+ else {
+ /* $map->{$method_name} = undef */
+ sv_setsv(method_slot, &PL_sv_undef);
+ }
}
-
- method_metaclass_name = mop_call0(aTHX_ self, mop_method_metaclass); /* $self->method_metaclass() */
-
- /*
- $method_object = $method_metaclass->wrap(
- $cv,
- associated_metaclass => $self,
- package_name => $class_name,
- name => $method_name
- );
- */
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- EXTEND(SP, 8);
- PUSHs(method_metaclass_name); /* invocant */
- mPUSHs(newRV_inc((SV *)cv));
- PUSHs(mop_associated_metaclass);
- PUSHs(self);
- PUSHs(KEY_FOR(package_name));
- PUSHs(class_name);
- PUSHs(KEY_FOR(name));
- mPUSHs(newSVpv(method_name, method_name_len));
- PUTBACK;
-
- call_sv(mop_wrap, G_SCALAR | G_METHOD);
- SPAGAIN;
- method_object = POPs;
- PUTBACK;
- /* $map->{$method_name} = $method_object */
- sv_setsv(method_slot, method_object);
-
- FREETMPS;
- LEAVE;
}
}
PROTOTYPES: DISABLE
void
-_full_method_map(self)
+_method_map(self)
SV *self
PREINIT:
HV *const obj = (HV *)SvRV(self);