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

[Jifty commits]

Author: nothingmuch
Date: Wed May  7 04:27:36 2008
New Revision: 5372

Modified:
   Runops-Hook/trunk/Hook.xs

Log:
ignore perl hook's retval by default

Modified: Runops-Hook/trunk/Hook.xs
==============================================================================
--- Runops-Hook/trunk/Hook.xs	(original)
+++ Runops-Hook/trunk/Hook.xs	Wed May  7 04:27:36 2008
@@ -11,6 +11,7 @@
 static UV Runops_Hook_threshold = 0;
 
 static SV *Runops_Hook_perl_hook;
+static bool Runops_Hook_perl_ignore_ret = 1;
 
 /* this is the modified runloop */
 int runops_hooked(pTHX)
@@ -73,23 +74,32 @@
 Runops_Hook_perl (pTHX) {
 	dSP;
 
-	int ret_count;
 	SV *sv_ret;
 	bool ret;
 
+	/* don't want to hook the hook */
 	Runops_Hook_disable();
 
 	ENTER;
 	SAVETMPS;
 
+
 	PUSHMARK(SP);
-	PUTBACK;
-	ret_count = call_sv(Runops_Hook_perl_hook, G_SCALAR|G_NOARGS);
+
+	call_sv(Runops_Hook_perl_hook, ( Runops_Hook_perl_ignore_ret ? G_DISCARD : G_SCALAR ) | G_NOARGS);
 
 	SPAGAIN;
 
-	sv_ret = POPs;
-	ret = SvTRUE(sv_ret);
+	/* we coerce it here so that SvTRUE is evaluated without hooking, and
+	 * Runops_Hook_enable() is the last thing in this hook */
+
+	if (!Runops_Hook_perl_ignore_ret) {
+		sv_ret = POPs;
+		ret = SvTRUE(sv_ret);
+	} else {
+		ret = 0;
+	}
+
 
 	PUTBACK;
 	FREETMPS;
@@ -97,7 +107,7 @@
 
 	Runops_Hook_enable();
 
-	return 0;
+	return ret;
 }
 
 void
@@ -206,3 +216,17 @@
 	Runops_Hook_clear_perl_hook(aTHX);
 	Runops_Hook_clear_hook();
 }
+
+void
+ignore_hook_ret()
+	CODE:
+{
+	Runops_Hook_perl_ignore_ret = 1;
+}
+
+void
+unignore_hook_ret()
+	CODE:
+{
+	Runops_Hook_perl_ignore_ret = 0;
+}