… | |
… | |
313 | return newRV_inc ((SV *)ext->cb); |
313 | return newRV_inc ((SV *)ext->cb); |
314 | } |
314 | } |
315 | |
315 | |
316 | void attachable_base::clear () |
316 | void attachable_base::clear () |
317 | { |
317 | { |
318 | //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D |
|
|
319 | |
|
|
320 | if (self) |
318 | if (self) |
321 | { |
319 | { |
|
|
320 | if (cb) |
|
|
321 | if (SvROK (*av_fetch ((AV *)cb, EVENT_OBJECT_DESTROY, 1))) |
|
|
322 | INVOKE_OBJECT (DESTROY, static_cast<object *>(this)); |
|
|
323 | else if (SvROK (*av_fetch ((AV *)cb, EVENT_MAP_DESTROY, 1))) |
|
|
324 | INVOKE_MAP (DESTROY, static_cast<mapstruct *>(this)); |
|
|
325 | |
|
|
326 | // disconnect Perl from C, to avoid crashes |
|
|
327 | sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext); |
|
|
328 | |
|
|
329 | // clear the perl hash, might or might not be a good idea |
322 | hv_clear ((HV *)SvRV ((SV *)self)); |
330 | hv_clear ((HV *)SvRV ((SV *)self)); |
323 | sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext); |
331 | |
324 | SvREFCNT_dec (self); |
332 | SvREFCNT_dec (self); |
|
|
333 | self = 0; |
325 | } |
334 | } |
326 | |
335 | |
327 | if (cb) |
336 | if (cb) |
328 | { |
337 | { |
329 | SvREFCNT_dec (cb); |
338 | SvREFCNT_dec (cb); |
… | |
… | |
373 | |
382 | |
374 | ///////////////////////////////////////////////////////////////////////////// |
383 | ///////////////////////////////////////////////////////////////////////////// |
375 | |
384 | |
376 | void reattach (data_type type, void *obj) |
385 | void reattach (data_type type, void *obj) |
377 | { |
386 | { |
|
|
387 | //TODO only do this when the object has _attachment's |
|
|
388 | |
378 | dSP; |
389 | dSP; |
379 | ENTER; |
390 | ENTER; |
380 | SAVETMPS; |
391 | SAVETMPS; |
381 | PUSHMARK (SP); |
392 | PUSHMARK (SP); |
382 | XPUSHs (sv_2mortal (newSVdt (type, obj))); |
393 | XPUSHs (sv_2mortal (newSVdt (type, obj))); |