This patch, when applied in src/pl will unbreak plperl in

bmomjian · bmomjian · commit 5c6fa5ee3229 · 2000-09-12T04:28:30.000Z
7.0.2 release. Sorry, if that's fixed ages ago - I don't track
development versions of PostgreSQL.

Patch is just a little bit tested (some valid functions created and
successfully run as well as some erroneous ones created and emitted proper
error messages when used).

My platform is FreeBSD 5.0-CURRENT (with perl 5.6.0 provided in the
base system).

Alex Kapranoff
diff --git a/src/pl/Makefile b/src/pl/Makefile
@@ -4,7 +4,7 @@
 #
 # Copyright (c) 1994, Regents of the University of California
 #
-# $Header: /cvsroot/pgsql/src/pl/Makefile,v 1.12 2000/08/31 16:12:09 petere Exp $
+# $Header: /cvsroot/pgsql/src/pl/Makefile,v 1.13 2000/09/12 04:28:30 momjian Exp $
 #
 #-------------------------------------------------------------------------
 
@@ -18,10 +18,9 @@ ifeq ($(USE_TCL), true)
 DIRS += tcl
 endif
 
-# Disabled because it doesn't work
-#ifeq ($(with_perl), yes)
-#DIRS += plperl
-#endif
+ifeq ($(with_perl), yes)
+DIRS += plperl
+endif
 
 all install installdirs uninstall depend distprep:
 	@for dir in $(DIRS); do $(MAKE) -C $$dir $@ || exit; done
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
@@ -33,7 +33,7 @@
  *	  ENHANCEMENTS, OR MODIFICATIONS.
  *
  * IDENTIFICATION
- *	  $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.12 2000/07/05 23:11:55 tgl Exp $
+ *	  $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.13 2000/09/12 04:28:30 momjian Exp $
  *
  **********************************************************************/
 
@@ -324,13 +324,13 @@ plperl_create_sub(char * s)
 	count = perl_call_pv("mksafefunc", G_SCALAR | G_EVAL | G_KEEPERR);
 	SPAGAIN;
 
-	if (SvTRUE(GvSV(errgv)))
+	if (SvTRUE(ERRSV))
 	{
 		POPs;
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
-		elog(ERROR, "creation of function failed : %s", SvPV(GvSV(errgv), na));
+		elog(ERROR, "creation of function failed : %s", SvPV_nolen(ERRSV));
 	}
 
 	if (count != 1) {
@@ -449,13 +449,13 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)
 		elog(ERROR, "plperl : didn't get a return item from function");
 	}
 
-	if (SvTRUE(GvSV(errgv)))
+	if (SvTRUE(ERRSV))
 	{
 		POPs;
 		PUTBACK;
 		FREETMPS;
 		LEAVE;
-		elog(ERROR, "plperl : error from function : %s", SvPV(GvSV(errgv), na));
+		elog(ERROR, "plperl : error from function : %s", SvPV_nolen(ERRSV));
 	}
 
 	retval = newSVsv(POPs);
@@ -661,7 +661,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
 	else
 	{
 		retval = FunctionCall3(&prodesc->result_in_func,
-							   PointerGetDatum(SvPV(perlret, na)),
+							   PointerGetDatum(SvPV_nolen(perlret)),
 							   ObjectIdGetDatum(prodesc->result_in_elem),
 							   Int32GetDatum(prodesc->result_in_len));
 	}
@@ -2184,6 +2184,6 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)
 			sv_catpvf(output, "'%s' => undef,", attname);
 	}
 	sv_catpv(output, "}");
-	output = perl_eval_pv(SvPV(output, na), TRUE);
+	output = perl_eval_pv(SvPV_nolen(output), TRUE);
 	return output;
 }

Original file line number	Diff line number	Diff line change
`@@ -4,7 +4,7 @@`
`4`	`4`	`#`
`5`	`5`	`# Copyright (c) 1994, Regents of the University of California`
`6`	`6`	`#`
`7`		`-# $Header: /cvsroot/pgsql/src/pl/Makefile,v 1.12 2000/08/31 16:12:09 petere Exp $`
	`7`	`+# $Header: /cvsroot/pgsql/src/pl/Makefile,v 1.13 2000/09/12 04:28:30 momjian Exp $`
`8`	`8`	`#`
`9`	`9`	`#-------------------------------------------------------------------------`
`10`	`10`
`@@ -18,10 +18,9 @@ ifeq ($(USE_TCL), true)`
`18`	`18`	`DIRS += tcl`
`19`	`19`	`endif`
`20`	`20`
`21`		`-# Disabled because it doesn't work`
`22`		`-#ifeq ($(with_perl), yes)`
`23`		`-#DIRS += plperl`
`24`		`-#endif`
	`21`	`+ifeq ($(with_perl), yes)`
	`22`	`+DIRS += plperl`
	`23`	`+endif`
`25`	`24`
`26`	`25`	`all install installdirs uninstall depend distprep:`
`27`	`26`	`@for dir in $(DIRS); do $(MAKE) -C $$dir $@ \|\| exit; done`
Original file line number	Diff line number	Diff line change
`@@ -33,7 +33,7 @@`
`33`	`33`	`* ENHANCEMENTS, OR MODIFICATIONS.`
`34`	`34`	`*`
`35`	`35`	`* IDENTIFICATION`
`36`		`- * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.12 2000/07/05 23:11:55 tgl Exp $`
	`36`	`+ * $Header: /cvsroot/pgsql/src/pl/plperl/plperl.c,v 1.13 2000/09/12 04:28:30 momjian Exp $`
`37`	`37`	`*`
`38`	`38`	`**********************************************************************/`
`39`	`39`
`@@ -324,13 +324,13 @@ plperl_create_sub(char * s)`
`324`	`324`	`count = perl_call_pv("mksafefunc", G_SCALAR \| G_EVAL \| G_KEEPERR);`
`325`	`325`	`SPAGAIN;`
`326`	`326`
`327`		`- if (SvTRUE(GvSV(errgv)))`
	`327`	`+ if (SvTRUE(ERRSV))`
`328`	`328`	`{`
`329`	`329`	`POPs;`
`330`	`330`	`PUTBACK;`
`331`	`331`	`FREETMPS;`
`332`	`332`	`LEAVE;`
`333`		`- elog(ERROR, "creation of function failed : %s", SvPV(GvSV(errgv), na));`
	`333`	`+ elog(ERROR, "creation of function failed : %s", SvPV_nolen(ERRSV));`
`334`	`334`	`}`
`335`	`335`
`336`	`336`	`if (count != 1) {`
`@@ -449,13 +449,13 @@ plperl_call_perl_func(plperl_proc_desc * desc, FunctionCallInfo fcinfo)`
`449`	`449`	`elog(ERROR, "plperl : didn't get a return item from function");`
`450`	`450`	`}`
`451`	`451`
`452`		`- if (SvTRUE(GvSV(errgv)))`
	`452`	`+ if (SvTRUE(ERRSV))`
`453`	`453`	`{`
`454`	`454`	`POPs;`
`455`	`455`	`PUTBACK;`
`456`	`456`	`FREETMPS;`
`457`	`457`	`LEAVE;`
`458`		`- elog(ERROR, "plperl : error from function : %s", SvPV(GvSV(errgv), na));`
	`458`	`+ elog(ERROR, "plperl : error from function : %s", SvPV_nolen(ERRSV));`
`459`	`459`	`}`
`460`	`460`
`461`	`461`	`retval = newSVsv(POPs);`
`@@ -661,7 +661,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)`
`661`	`661`	`else`
`662`	`662`	`{`
`663`	`663`	`retval = FunctionCall3(&prodesc->result_in_func,`
`664`		`- PointerGetDatum(SvPV(perlret, na)),`
	`664`	`+ PointerGetDatum(SvPV_nolen(perlret)),`
`665`	`665`	`ObjectIdGetDatum(prodesc->result_in_elem),`
`666`	`666`	`Int32GetDatum(prodesc->result_in_len));`
`667`	`667`	`}`
`@@ -2184,6 +2184,6 @@ plperl_build_tuple_argument(HeapTuple tuple, TupleDesc tupdesc)`
`2184`	`2184`	`sv_catpvf(output, "'%s' => undef,", attname);`
`2185`	`2185`	`}`
`2186`	`2186`	`sv_catpv(output, "}");`
`2187`		`- output = perl_eval_pv(SvPV(output, na), TRUE);`
	`2187`	`+ output = perl_eval_pv(SvPV_nolen(output), TRUE);`
`2188`	`2188`	`return output;`
`2189`	`2189`	`}`