execute_perl leaks memory, patched

["Martin Persson" <mep@passagen.se>]

Hi,
I noticed that execute_perl() in perl.c leaks memory after a while... If
you use a timer in a script with a short interval it will eat up quite alot,
it chewed up 128MB over a day for me with a timer interval at 100ms...

Anyway, i wrote a patch that uses perl_call_args instead of perl_eval_pv,
it still evaluates the perl function so that an error will be caught and
printed out instead of crashing xchat... Tell me what you think, here's
the diff -ur1 patch for xchat 1.7.7

/Martin





________________________________________
Ladda ner det senaste från Passagens Filarkiv http://tucows.passagen.se/


--- perl.c	Mon Jun  4 14:23:51 2001
+++ perl.c.new	Thu Jun 14 00:22:49 2001
@@ -267,27 +267,40 @@
 */
-static SV *
+
+/*
+  2001/06/14: execute_perl replaced by Martin Persson <mep@passagen.se>
+	      previous use of perl_eval leaked memory, replaced with
+	      a version that uses perl_call instead
+*/
+int
 execute_perl (char *function, char *args)
 {
-	static char *perl_cmd = NULL;
-	static char *perl_format = {
-	  "{\n"
-	    "my $__result__;\n"
-	    "eval {\n;"
-	      "$__result__ = &%s('%s');\n"
-	    "};\n"
-	    "return $__result__ unless $@;"
-	    "IRC::print(\"\\cbPerl error:\\cb $@\\n\");"
-	    "return 1;\n"
-	  "}\n"
-	};
-
-	if (perl_cmd)
-		free (perl_cmd);
-	perl_cmd = malloc (strlen (function) + strlen (args) * 2 + strlen(perl_format) + 1);
-	sprintf (perl_cmd, perl_format, function, escape_quotes (args));
-#ifndef HAVE_PERL_EVAL_PV
-	return (perl_eval_pv (perl_cmd, TRUE));
-#else
-	return (Perl_eval_pv (perl_cmd, TRUE));
-#endif
+	char *perl_args[2] = { args, NULL }, buf[512];
+	int count, ret_value = 1;
+	SV *sv;
+	
+	dSP;
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(sp);
+	count = perl_call_argv(function, G_EVAL | G_SCALAR, perl_args);
+	SPAGAIN;
+	
+	sv = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+	if (SvTRUE(sv)) {
+		snprintf(buf, 512, "Perl error: %s\n", SvPV(sv, PL_na));
+		PrintText(perl_sess, buf);
+		POPs;
+	} else if (count != 1) {
+		snprintf(buf, 512, "Perl error: expected 1 value from %s, "
+			"got: %d\n", function, count);
+		PrintText(perl_sess, buf);
+	} else {
+		ret_value = POPi;
+	}
+	
+	PUTBACK;
+	FREETMPS;
+	LEAVE;
+	
+	return ret_value;
 }
@@ -482,3 +495,3 @@
 	struct _perl_inbound_handlers *data;
-	SV *handler_return;
+	int handler_return;
 
@@ -494,5 +507,5 @@
 			handler_return = execute_perl (data->handler_name, buf);
-			if (SvIV (handler_return))
+			if (handler_return)
 			{
-				return SvIV (handler_return);
+				return handler_return;
 			}
@@ -508,3 +521,3 @@
 	struct _perl_inbound_handlers *data;
-	SV *handler_return;
+	int handler_return;
 
@@ -522,5 +535,5 @@
 			handler_return = execute_perl (data->handler_name, buf);
-			if (SvIV (handler_return))
+			if (handler_return)
 			{
-				return SvIV (handler_return);
+				return handler_return;
 			}
@@ -540,3 +553,3 @@
 	char nullargs[] = "";
-	SV *handler_return;
+	int handler_return;
 	int command = FALSE;
@@ -579,6 +592,6 @@
 			}
-			if (SvIV (handler_return))
+			if (handler_return)
 			{
 				free (command_name);
-				return SvIV (handler_return);
+				return handler_return;
 			}
@@ -598,3 +611,3 @@
 	char *args;
-	SV *handler_return;
+	int handler_return;
 
@@ -645,6 +658,6 @@
 			}
-			if (SvIV (handler_return))
+			if (handler_return)
 			{
 				free (args);
-				return SvIV (handler_return);
+				return handler_return;
 			}