plperl update from Andrew Dunstan, deriving (I believe) from Command Prompt's

plperlNG. Review and minor cleanup/improvements by Joe Conway.

Summary of new functionality:
- Shared data space and namespace. There is a new global variable %_SHARED
  that functions can use to store and save data between invocations of a
  function, or between different functions. Also, all trusted plperl function
  now share a common Safe container (this is an optimization, also), which
  they can use for storing non-lexical variables, functions, etc.
- Triggers are now supported
- Records can now be returned (as a hash reference)
- Sets of records can now be returned (as a reference to an array of hash
  references).
- New function spi_exec_query() provided for performing db functions or
  getting data from db.
- Optimization for counting hash keys (Abhijit Menon-Sen)
- Allow return of 'record' and 'setof record'

src/pl/plperl/GNUmakefile

 # Makefile for PL/Perl
-# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.12 2004/01/21 19:04:11 tgl Exp $
+# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.13 2004/07/01 20:50:22 joe Exp $
 
 subdir = src/pl/plperl
 top_builddir = ../../..
@@ -25,8 +25,13 @@ NAME = plperl
 SO_MAJOR_VERSION = 0
 SO_MINOR_VERSION = 0
 
-OBJS = plperl.o eloglvl.o SPI.o
+OBJS = plperl.o spi_internal.o SPI.o
+
+ifeq ($(enable_rpath), yes)
+SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS) -Wl,-rpath,$(perl_archlibexp)/CORE
+else
 SHLIB_LINK = $(perl_embed_ldflags) $(BE_DLLLIBS)
+endif
 
 include $(top_srcdir)/src/Makefile.shlib
 

src/pl/plperl/SPI.xs

@@ -6,17 +6,17 @@
 #include "perl.h"
 #include "XSUB.h"
 
-#include "eloglvl.h"
+#include "spi_internal.h"
 
 
 
-MODULE = SPI PREFIX = elog_
+MODULE = SPI PREFIX = spi_
 
 PROTOTYPES: ENABLE
 VERSIONCHECK: DISABLE
 
 void
-elog_elog(level, message)
+spi_elog(level, message)
 	int level
 	char* message
 	CODE:
@@ -24,21 +24,33 @@ elog_elog(level, message)
 
 
 int
-elog_DEBUG()
+spi_DEBUG()
 
 int
-elog_LOG()
+spi_LOG()
 
 int
-elog_INFO()
+spi_INFO()
 
 int
-elog_NOTICE()
+spi_NOTICE()
 
 int
-elog_WARNING()
+spi_WARNING()
 
 int
-elog_ERROR()
-
-
+spi_ERROR()
+
+SV*
+spi_spi_exec_query(query, ...)
+	char* query;
+	PREINIT:
+		HV *ret_hash;
+		int limit=0;
+	CODE:
+			if (items>2) Perl_croak(aTHX_ "Usage: spi_exec_query(query, limit) or spi_exec_query(query)");
+			if (items == 2) limit = SvIV(ST(1));
+			ret_hash=plperl_spi_exec(query, limit);
+		RETVAL = newRV_noinc((SV*)ret_hash);
+	OUTPUT:
+		RETVAL

src/pl/plperl/eloglvl.c

-#include "postgres.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 DEBUG2;
-}
-
-int
-elog_LOG(void)
-{
-	return LOG;
-}
-
-int
-elog_INFO(void)
-{
-	return INFO;
-}
-
-int
-elog_NOTICE(void)
-{
-	return NOTICE;
-}
-
-int
-elog_WARNING(void)
-{
-	return WARNING;
-}
-
-int
-elog_ERROR(void)
-{
-	return ERROR;
-}

src/pl/plperl/eloglvl.h

-
-int			elog_DEBUG(void);
-
-int			elog_LOG(void);
-
-int			elog_INFO(void);
-
-int			elog_NOTICE(void);
-
-int			elog_WARNING(void);
-
-int			elog_ERROR(void);

src/pl/plperl/spi_internal.c

+#include "postgres.h"
+#include "executor/spi.h"
+#include "utils/syscache.h"
+/*
+ * This kludge is necessary because of the conflicting
+ * definitions of 'DEBUG' between postgres and perl.
+ * we'll live.
+ */
+
+#include "spi_internal.h"
+
+static char* plperl_spi_status_string(int);
+
+static HV* plperl_spi_execute_fetch_result(SPITupleTable*, int, int );
+
+int
+spi_DEBUG(void)
+{
+	return DEBUG2;
+}
+
+int
+spi_LOG(void)
+{
+	return LOG;
+}
+
+int
+spi_INFO(void)
+{
+	return INFO;
+}
+
+int
+spi_NOTICE(void)
+{
+	return NOTICE;
+}
+
+int
+spi_WARNING(void)
+{
+	return WARNING;
+}
+
+int
+spi_ERROR(void)
+{
+	return ERROR;
+}
+
+HV*
+plperl_spi_exec(char* query, int limit)
+{
+	HV *ret_hv;
+	int spi_rv;
+
+	spi_rv = SPI_exec(query, limit);
+	ret_hv=plperl_spi_execute_fetch_result(SPI_tuptable, SPI_processed, spi_rv);
+
+	return ret_hv;
+}
+
+static HV*
+plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
+{
+	int	i;
+	char	*attname;
+	char	*attdata;
+
+	HV *array;
+
+	array = newHV();
+
+	for (i = 0; i < tupdesc->natts; i++) {
+		/************************************************************
+		* Get the attribute name
+		************************************************************/
+		attname = tupdesc->attrs[i]->attname.data;
+
+		/************************************************************
+		* Get the attributes value
+		************************************************************/
+		attdata = SPI_getvalue(tuple, tupdesc, i+1);
+		hv_store(array, attname, strlen(attname), newSVpv(attdata,0), 0);
+	}
+	return array;
+}
+
+static HV*
+plperl_spi_execute_fetch_result(SPITupleTable *tuptable, int rows, int status)
+{
+
+	HV *result;
+	int i;
+
+	result = newHV();
+
+	if (status == SPI_OK_UTILITY)
+	{
+		hv_store(result, "status", strlen("status"), newSVpv("SPI_OK_UTILITY",0), 0);
+		hv_store(result, "rows", strlen("rows"), newSViv(rows), 0);
+	}
+	else if (status != SPI_OK_SELECT)
+	{
+		hv_store(result, "status", strlen("status"), newSVpv((char*)plperl_spi_status_string(status),0), 0);
+		hv_store(result, "rows", strlen("rows"), newSViv(rows), 0);
+	}
+	else
+	{
+		if (rows)
+		{
+			char* key=palloc(sizeof(int));
+			HV *row;
+			for (i = 0; i < rows; i++)
+			{
+				row = plperl_hash_from_tuple(tuptable->vals[i], tuptable->tupdesc);
+				sprintf(key, "%i", i);
+				hv_store(result, key, strlen(key), newRV_noinc((SV*)row), 0);
+			}
+			SPI_freetuptable(tuptable);
+		}
+	}
+	return result;
+}
+
+static char*
+plperl_spi_status_string(int status)
+{
+	switch(status){
+		/*errors*/
+		case SPI_ERROR_TYPUNKNOWN:
+			return "SPI_ERROR_TYPUNKNOWN";
+		case SPI_ERROR_NOOUTFUNC:
+			return "SPI_ERROR_NOOUTFUNC";
+		case SPI_ERROR_NOATTRIBUTE:
+			return "SPI_ERROR_NOATTRIBUTE";
+		case SPI_ERROR_TRANSACTION:
+			return "SPI_ERROR_TRANSACTION";
+		case SPI_ERROR_PARAM:
+			return "SPI_ERROR_PARAM";
+		case SPI_ERROR_ARGUMENT:
+			return "SPI_ERROR_ARGUMENT";
+		case SPI_ERROR_CURSOR:
+			return "SPI_ERROR_CURSOR";
+		case SPI_ERROR_UNCONNECTED:
+			return "SPI_ERROR_UNCONNECTED";
+		case SPI_ERROR_OPUNKNOWN:
+			return "SPI_ERROR_OPUNKNOWN";
+		case SPI_ERROR_COPY:
+			return "SPI_ERROR_COPY";
+		case SPI_ERROR_CONNECT:
+			return "SPI_ERROR_CONNECT";
+		/*ok*/
+		case SPI_OK_CONNECT:
+			return "SPI_OK_CONNECT";
+		case SPI_OK_FINISH:
+			return "SPI_OK_FINISH";
+		case SPI_OK_FETCH:
+			return "SPI_OK_FETCH";
+		case SPI_OK_UTILITY:
+			return "SPI_OK_UTILITY";
+		case SPI_OK_SELECT:
+			return "SPI_OK_SELECT";
+		case SPI_OK_SELINTO:
+			return "SPI_OK_SELINTO";
+		case SPI_OK_INSERT:
+			return "SPI_OK_INSERT";
+		case SPI_OK_DELETE:
+			return "SPI_OK_DELETE";
+		case SPI_OK_UPDATE:
+			return "SPI_OK_UPDATE";
+		case SPI_OK_CURSOR:
+			return "SPI_OK_CURSOR";
+	}
+
+	return "Unknown or Invalid code";
+}
+

src/pl/plperl/spi_internal.h

+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int			spi_DEBUG(void);
+
+int			spi_LOG(void);
+
+int			spi_INFO(void);
+
+int			spi_NOTICE(void);
+
+int			spi_WARNING(void);
+
+int			spi_ERROR(void);
+
+HV*		plperl_spi_exec(char*, int);
+
+