Attached is a uuencoded tarball that contains

3 new files and two patches for the plperl subdir.

These changes add the ability for plperl functions
to call 'elog'. It also sets up the frame work to
allow me to add access to the SPI functions.


--
Mark Hollomon

Author: bmomjian

src/pl/plperl/Makefile.PL

@@ -47,6 +47,11 @@ print MAKEFILE <<_STATIC_;
 SRCDIR= ../../../src
 include \$(SRCDIR)/Makefile.global
 
+EXTDIR= $Config{privlib}/ExtUtils
+
+XSUBPP= \$(EXTDIR)/xsubpp
+
+TYPEMAP= -typemap \$(EXTDIR)/typemap
 
 # use the same compiler as perl did
 CC= $Config{cc}
@@ -95,12 +100,16 @@ endif
 #
 all:	 plperl
 
-plperl : plperl.o
-	\$(CC) -o plperl.so plperl.o \$(SHLIB_EXTRA_LIBS) \$(LDADD) \$(LDFLAGS)
+plperl : plperl.o SPI.o
+	\$(CC) -o plperl.so plperl.o SPI.o \$(SHLIB_EXTRA_LIBS) \$(LDADD) \$(LDFLAGS)
 
 %.o : %.c
 	\$(CC) -c \$(CFLAGS) \$<
 
+%.o : %.xs
+	\$(XSUBPP} \$(TYPEMAP) \$< > xtmp.c
+	\$(CC) -c \$(CFLAGS) -o \$@ xtmp.c
+
 
 #
 # Clean 

src/pl/plperl/SPI.xs

@@ -0,0 +1,74 @@
+/* system stuff */
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <string.h>
+#include <setjmp.h>
+
+/* postgreSQL stuff */
+#include "executor/spi.h"
+#include "commands/trigger.h"
+#include "utils/elog.h"
+#include "utils/builtins.h"
+#include "fmgr.h"
+#include "access/heapam.h"
+
+#include "tcop/tcopprot.h"
+#include "utils/syscache.h"
+#include "catalog/pg_proc.h"
+#include "catalog/pg_type.h"
+
+/* perl stuff */
+/*
+ * Evil Code Alert
+ *
+ * both posgreSQL and perl try to do 'the right thing'
+ * and provide union semun if the platform doesn't define
+ * it in a system header.
+ * psql uses HAVE_UNION_SEMUN
+ * perl uses HAS_UNION_SEMUN
+ * together, they cause compile errors.
+ * If we need it, the psql headers above will provide it.
+ * So we tell perl that we have it.
+ */
+#ifndef HAS_UNION_SEMUN
+#define HAS_UNION_SEMUN
+#endif
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "eloglvl.h"
+
+
+
+MODULE = SPI PREFIX = elog_
+
+PROTOTYPES: ENABLE
+VERSIONCHECK: DISABLE
+
+void
+elog_elog(level, message)
+	int level
+	char* message
+	CODE:
+	if (level > 0)
+		return;
+	else
+		elog(level, message);
+
+
+int
+elog_NOIND()
+
+int
+elog_DEBUG()
+
+int
+elog_ERROR()
+
+int
+elog_NOTICE()

src/pl/plperl/eloglvl.c

@@ -0,0 +1,25 @@
+#include "utils/elog.h"
+
+/*
+ * This kludge is necessary because of the conflicting
+ * definitions of 'DEBUG' between postgres and perl.
+ * we'll live.
+ */
+
+#include "eloglvl.h"
+
+int elog_DEBUG(void) {
+	return DEBUG;
+}
+
+int elog_ERROR(void) {
+	return ERROR;
+}
+
+int elog_NOIND(void) {
+	return NOIND;
+}
+
+int elog_NOTICE(void) {
+	return NOTICE;
+}

src/pl/plperl/eloglvl.h

@@ -0,0 +1,8 @@
+
+int elog_DEBUG(void) ;
+
+int elog_ERROR(void) ;
+
+int elog_NOIND(void) ;
+
+int elog_NOTICE(void);

src/pl/plperl/plperl.c

@@ -218,7 +218,7 @@ static void
 plperl_init_safe_interp(void)
 {
 
-	char *embedding[] = { "", "-e", "BEGIN { use DynaLoader; require Safe;}", "0" };
+	char *embedding[] = { "", "-e", "use DynaLoader; require Safe; SPI::bootstrap()", "0" };
 
 	plperl_safe_interp = perl_alloc();
 	if (!plperl_safe_interp)
@@ -235,10 +235,6 @@ plperl_init_safe_interp(void)
 	 ************************* ***********************************/
 	 plperl_proc_hash = newHV();
 
-	/************************************************************
-	 * Install the commands for SPI support in the safe interpreter
-	 * Someday.
-	 ************************************************************/
 }
 
 
@@ -356,13 +352,15 @@ plperl_create_sub(SV *s) {
 
 extern void boot_DynaLoader _((CV* cv));
 extern void boot_Opcode _((CV* cv));
+extern void boot_SPI _((CV* cv));
 
 extern void
 plperl_init_shared_libs(void)
 {
 	char *file = __FILE__;
 	newXS("DynaLoader::bootstrap", boot_DynaLoader, file);
 	newXS("Opcode::bootstrap", boot_Opcode, file);
+	newXS("SPI::bootstrap", boot_SPI, file);
 }
 
 /**********************************************************************
@@ -574,6 +572,7 @@ plperl_func_handler(FmgrInfo *proinfo,
 		proc_internal_def = newSVpvf(
 			"$::x = new Safe;" 
 			"$::x->permit_only(':default');"
+			"$::x->share(qw[&elog &DEBUG &NOTICE &NOIND &ERROR]);"
 			"use strict;"
 			"return $::x->reval( q[ sub { %s } ]);", proc_source);