void ReleasePerlObject(pTHX_ WINOLEOBJECT *pObj) { dSP; HV *stash = SvSTASH(pObj->self); DBG(("ReleasePerlObject |%lx|", pObj)); if (!pObj) return; /* ReleasePerlObject may be called multiple times for a single object: * first by Uninitialize() and then by Win32::OLE::DESTROY. * Make sure nothing is cleaned up twice! */ if (pObj->destroy) { SV *self = sv_2mortal(newRV_inc((SV*)pObj->self)); /* honour OVERLOAD setting */ if (Gv_AMG(stash)) SvAMAGIC_on(self); DBG((" Calling destroy method for object |%lx|\n", pObj)); ENTER; SAVETMPS; if (SvPOK(pObj->destroy)) { /* $self->Dispatch($destroy,$retval); */ EXTEND(SP, 3); PUSHMARK(sp); PUSHs(self); PUSHs(pObj->destroy); PUSHs(sv_newmortal()); PUTBACK; perl_call_method("Dispatch", G_DISCARD); } else { /* &$destroy($self); */ PUSHMARK(sp); XPUSHs(self); PUTBACK; perl_call_sv(pObj->destroy, G_DISCARD); } FREETMPS; LEAVE; DBG((" Returned from destroy method for 0x%08x\n", pObj)); SvREFCNT_dec(pObj->destroy); pObj->destroy = NULL; } if (pObj->pEventSink) { DBG((" Unadvise connection |%lx|", pObj)); pObj->pEventSink->Unadvise(); pObj->pEventSink = NULL; } if (pObj->pDispatch) { if (pObj->flags & OBJFLAG_UNIQUE) { dPERINTERP; IUnknown *punk; // XXX check error? pObj->pDispatch->QueryInterface(IID_IUnknown, (void**)&punk); hv_delete(g_hv_unique, (char*)&punk, sizeof(punk), G_DISCARD); DBG((" hv_delete(%08x)", punk)); punk->Release(); } DBG((" Release pDispatch")); pObj->pDispatch->Release(); pObj->pDispatch = NULL; } if (pObj->pTypeInfo) { DBG((" Release pTypeInfo")); pObj->pTypeInfo->Release(); pObj->pTypeInfo = NULL; } if (pObj->pEnum) { DBG((" Release pEnum")); pObj->pEnum->Release(); pObj->pEnum = NULL; } if (pObj->destroy) { DBG((" destroy(%d)", SvREFCNT(pObj->destroy))); SvREFCNT_dec(pObj->destroy); pObj->destroy = NULL; } if (pObj->hashTable) { DBG((" hashTable(%d)", SvREFCNT(pObj->hashTable))); >>>>>>>>>>>>>>>> SvREFCNT_dec(pObj->hashTable); pObj->hashTable = NULL; } DBG(("\n")); } /* ReleasePerlObject */