| … | |
… | |
| 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))); |
