Cleanup.xs

   1 /* This file is part of the Thread::Cleanup Perl module.
   2  * See http://search.cpan.org/dist/Thread-Cleanup/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 #define __PACKAGE__     "Thread::Cleanup"
  10 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  11
  12 #define TC_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
  13
  14 STATIC void tc_callback(pTHX_ void *ud) {
  15  dSP;
  16
  17  ENTER;
  18  SAVETMPS;
  19
  20  PUSHMARK(SP);
  21  PUTBACK;
  22
  23  call_pv(__PACKAGE__ "::_CLEANUP", G_VOID | G_EVAL);
  24
  25  PUTBACK;
  26
  27  FREETMPS;
  28  LEAVE;
  29 }
  30
  31 STATIC int tc_endav_free(pTHX_ SV *sv, MAGIC *mg) {
  32  SAVEDESTRUCTOR_X(tc_callback, NULL);
  33
  34  return 0;
  35 }
  36
  37 STATIC MGVTBL tc_endav_vtbl = {
  38  0,
  39  0,
  40  0,
  41  0,
  42  tc_endav_free
  43 #if MGf_COPY
  44  , 0
  45 #endif
  46 #if MGf_DUP
  47  , 0
  48 #endif
  49 #if MGf_LOCAL
  50  , 0
  51 #endif
  52 };
  53
  54 MODULE = Thread::Cleanup            PACKAGE = Thread::Cleanup
  55
  56 PROTOTYPES: DISABLE
  57
  58 void
  59 CLONE(...)
  60 PREINIT:
  61  GV *gv;
  62 PPCODE:
  63  gv = gv_fetchpv(__PACKAGE__ "::_CLEANUP", 0, SVt_PVCV);
  64  if (gv) {
  65   CV *cv = GvCV(gv);
  66   if (!PL_endav)
  67    PL_endav = newAV();
  68   SvREFCNT_inc(cv);
  69   if (!av_store(PL_endav, av_len(PL_endav) + 1, (SV *) cv))
  70    SvREFCNT_dec(cv);
  71   sv_magicext((SV *) PL_endav, NULL, PERL_MAGIC_ext, &tc_endav_vtbl, NULL, 0);
  72  }
  73  XSRETURN(0);