[Jifty-commit] r5375 - Runops-Hook/trunk

Jifty commits jifty-commit at lists.jifty.org
Wed May 7 06:29:35 EDT 2008


Author: nothingmuch
Date: Wed May  7 06:29:32 2008
New Revision: 5375

Modified:
   Runops-Hook/trunk/Hook.xs

Log:
B::OP passed to perl hook

Modified: Runops-Hook/trunk/Hook.xs
==============================================================================
--- Runops-Hook/trunk/Hook.xs	(original)
+++ Runops-Hook/trunk/Hook.xs	Wed May  7 06:29:32 2008
@@ -1,6 +1,7 @@
 #define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #include "perl.h"
+#include "embed.h"
 #include "XSUB.h"
 
 bool (*Runops_Hook_hook)(pTHX);
@@ -13,7 +14,7 @@
 static SV *Runops_Hook_perl_hook;
 static bool Runops_Hook_perl_ignore_ret = 1;
 
-static bool Runops_Hook_loaded_b;
+static bool Runops_Hook_loaded_B;
 
 /* this is the modified runloop */
 int runops_hooked(pTHX)
@@ -71,12 +72,32 @@
 	return 0;
 }
 
+SV *
+Runops_Hook_op_to_BOP (pTHX_ OP *op) {
+	dSP;
+
+	/* fake a B::UNOP that we use as a trampoline to make a B::OP object out of PL_op */
+	UNOP fakeop;
+	fakeop.op_first = op;
+
+	PUSHMARK(SP);
+	XPUSHs(sv_bless(sv_2mortal(newRV(sv_2mortal(newSVuv((UV)&fakeop)))), gv_stashpv("B::UNOP", 0)));
+	PUTBACK;
+
+	call_pv("B::UNOP::first", G_SCALAR);
+
+	SPAGAIN;
+
+	return POPs;
+}
+
 /* this is a hook that calls to a perl code ref */
 bool
 Runops_Hook_perl (pTHX) {
 	dSP;
 
 	SV *sv_ret;
+	SV *PL_op_object;
 	bool ret;
 
 	/* don't want to hook the hook */
@@ -85,10 +106,14 @@
 	ENTER;
 	SAVETMPS;
 
+	PL_op_object = Runops_Hook_op_to_BOP(aTHX_ PL_op);
 
 	PUSHMARK(SP);
+	XPUSHs(Runops_Hook_perl_hook);
+	XPUSHs(PL_op_object);
+	PUTBACK;
 
-	call_sv(Runops_Hook_perl_hook, ( Runops_Hook_perl_ignore_ret ? G_DISCARD : G_SCALAR ) | G_NOARGS);
+	call_sv(Runops_Hook_perl_hook, (Runops_Hook_perl_ignore_ret ? G_DISCARD : G_SCALAR));
 
 	SPAGAIN;
 
@@ -208,9 +233,9 @@
 set_hook(SV *hook)
 	CODE:
 {
-	if (!Runops_Hook_loaded_b) {
+	if (!Runops_Hook_loaded_B) {
 		load_module( PERL_LOADMOD_NOIMPORT, newSVpvs("B"), newSViv(0) );
-		Runops_Hook_loaded_b = 1;
+		Runops_Hook_loaded_B = 1;
 	}
 
 	Runops_Hook_set_perl_hook(aTHX_ hook);


More information about the Jifty-commit mailing list