Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

Untitled

By: a guest on Apr 16th, 2012  |  syntax: None  |  size: 2.57 KB  |  hits: 5  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #define SVt_PADNAME SVt_PVMG
  6.  
  7. #ifndef COP_SEQ_RANGE_LOW_set
  8. # define COP_SEQ_RANGE_LOW_set(sv,val)                                  \
  9.   do { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = val; } while(0)
  10. # define COP_SEQ_RANGE_HIGH_set(sv,val)                                 \
  11.   do { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = val; } while(0)
  12. #endif
  13.  
  14. #ifndef PAD_MAX
  15. # define PAD_MAX I32_MAX
  16. #endif
  17.  
  18. static BHK my_blk_hooks;
  19.  
  20. #define pad_add_my_scalar_pvn(namepv, namelen)      \
  21.   S_pad_add_my_scalar_pvn(aTHX_ namepv, namelen)
  22.  
  23. static
  24. PADOFFSET S_pad_add_my_scalar_pvn(pTHX_ char const *namepv, STRLEN namelen)
  25. {
  26.   PADOFFSET offset;
  27.   SV *namesv, *myvar;
  28.  
  29.   myvar = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, 1);
  30.   offset = AvFILLp(PL_comppad);
  31.   SvPADMY_on(myvar);
  32.  
  33.   PL_curpad = AvARRAY(PL_comppad);
  34.   namesv = newSV_type(SVt_PADNAME);
  35.   sv_setpvn(namesv, namepv, namelen);
  36.  
  37.   COP_SEQ_RANGE_LOW_set(namesv, PL_cop_seqmax);
  38.   COP_SEQ_RANGE_HIGH_set(namesv, PAD_MAX);
  39.   PL_cop_seqmax++;
  40.  
  41.   av_store(PL_comppad_name, offset, namesv);
  42.  
  43.   return offset;
  44. }
  45.  
  46. #define new_hook(cb) S_new_hook(aTHX_ cb)
  47.  
  48. static SV *
  49. S_new_hook (pTHX_ SV *cb)
  50. {
  51.   HV *obj = newHV();
  52.   SV *self = newRV_noinc((SV *)obj);
  53.   sv_bless(self, gv_stashpvs("Hook::EndOfRuntime::Hook", 0));
  54.   hv_stores(obj, "cb", cb);
  55.   return self;
  56. }
  57.  
  58. #define runtime_hook(cb) S_runtime_hook(aTHX_ cb)
  59.  
  60. static OP *
  61. S_runtime_hook (pTHX_ SV *cb)
  62. {
  63.   OP *pvarop;
  64.   pvarop = newOP(OP_PADSV, (OPpLVAL_INTRO<<8));
  65.   pvarop->op_targ = pad_add_my_scalar_pvn("\0", 1);
  66.   return newASSIGNOP(OPf_STACKED, pvarop, 0,
  67.                      newSVOP(OP_CONST, 0, new_hook(cb)));
  68. }
  69.  
  70. #define call_cb(cb) S_call_cb(aTHX_ cb)
  71.  
  72. static void
  73. S_call_cb (pTHX_ CV *cb)
  74. {
  75.   dSP;
  76.   ENTER;
  77.   SAVETMPS;
  78.   PUSHMARK(SP);
  79.   PUTBACK;
  80.  
  81.   call_sv((SV *)cb, G_VOID | G_DISCARD);
  82.  
  83.   FREETMPS;
  84.   LEAVE;
  85. }
  86.  
  87. static SV *current_cb;
  88.  
  89. void
  90. my_pre_block_end (pTHX_ OP **op_ptr)
  91. {
  92.   if (!current_cb)
  93.     return;
  94.  
  95.   OP *hook = runtime_hook(current_cb);
  96.   current_cb = NULL;
  97.   *op_ptr = op_append_elem(OP_LIST, hook, *op_ptr);
  98. }
  99.  
  100. MODULE = Hook::EndOfRuntime  PACKAGE = Hook::EndOfRuntime
  101.  
  102. PROTOTYPES: DISABLE
  103.  
  104. BOOT:
  105.   BhkENTRY_set(&my_blk_hooks, bhk_pre_end, my_pre_block_end);
  106.   Perl_blockhook_register(aTHX_ &my_blk_hooks);
  107.  
  108. void
  109. after_runtime (UV level, SV *cb)
  110.   CODE:
  111.     if (current_cb)
  112.       croak("override");
  113.     current_cb = newSVsv(cb);
  114.  
  115. MODULE = Hook::EndOfRuntime  PACKAGE = Hook::EndOfRuntime::Hook
  116.  
  117. void
  118. DESTROY (self)
  119.     SV *self
  120.   PREINIT:
  121.     CV *cb;
  122.   CODE:
  123.     cb = (CV *)SvRV(*hv_fetchs((HV *)SvRV(self), "cb", 0));
  124.     call_cb(cb);
create a new version of this paste RAW Paste Data