Add utility functions to PLPerl:

    quote_literal, quote_nullable, quote_ident,
    encode_bytea, decode_bytea, looks_like_number,
    encode_array_literal, encode_array_constructor.
Split SPI.xs into two - SPI.xs now contains only SPI functions. Remainder
are in new Util.xs.
Some more code and documentation cleanup along the way, as well as
adding some CVS markers to files missing them.

Original patch from Tim Bunce, with a little editing from me.

13 files changed, 567 insertions, 165 deletions

diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index 81c918a1d59..f794f028bec 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -1,5 +1,5 @@
 # Makefile for PL/Perl
-# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.41 2010/01/10 18:10:03 tgl Exp $
+# $PostgreSQL: pgsql/src/pl/plperl/GNUmakefile,v 1.42 2010/01/20 01:08:21 adunstan Exp $
 
 subdir = src/pl/plperl
 top_builddir = ../../..
@@ -34,14 +34,14 @@ rpathdir = $(perl_archlibexp)/CORE
 
 NAME = plperl
 
-OBJS = plperl.o spi_internal.o SPI.o
+OBJS = plperl.o SPI.o Util.o
 
 PERLCHUNKS = plc_perlboot.pl plc_safe_bad.pl plc_safe_ok.pl
 
 SHLIB_LINK = $(perl_embed_ldflags)
 
 REGRESS_OPTS = --dbname=$(PL_TESTDB) --load-language=plperl  --load-language=plperlu
-REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperlu
+REGRESS = plperl plperl_trigger plperl_shared plperl_elog plperl_util plperlu
 # if Perl can support two interpreters in one backend, 
 # test plperl-and-plperlu cases
 ifneq ($(PERL),)
@@ -64,6 +64,9 @@ all: all-lib
 SPI.c: SPI.xs
 	$(PERL) $(perl_privlibexp)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
 
+Util.c: Util.xs
+	$(PERL) $(perl_privlibexp)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
+
 install: all installdirs install-lib
 
 installdirs: installdirs-lib
@@ -78,7 +81,7 @@ submake:
 	$(MAKE) -C $(top_builddir)/src/test/regress pg_regress$(X)
 
 clean distclean maintainer-clean: clean-lib
-	rm -f SPI.c $(OBJS) perlchunks.h
+	rm -f SPI.c Util.c $(OBJS) perlchunks.h
 	rm -rf results
 	rm -f regression.diffs regression.out
 
diff --git a/src/pl/plperl/SPI.xs b/src/pl/plperl/SPI.xs
index 967ac0adbab..9cee19a7f79 100644
--- a/src/pl/plperl/SPI.xs
+++ b/src/pl/plperl/SPI.xs
@@ -1,3 +1,12 @@
+/**********************************************************************
+ * PostgreSQL::InServer::SPI
+ *
+ * SPI interface for plperl.  
+ *
+ *    $PostgreSQL: pgsql/src/pl/plperl/SPI.xs,v 1.21 2010/01/20 01:08:21 adunstan Exp $
+ *
+ **********************************************************************/
+
 /* this must be first: */
 #include "postgres.h"
 /* Defined by Perl */
@@ -8,40 +17,6 @@
 
 
 /*
- * Implementation of plperl's elog() function
- *
- * If the error level is less than ERROR, we'll just emit the message and
- * return.  When it is ERROR, elog() will longjmp, which we catch and
- * turn into a Perl croak().  Note we are assuming that elog() can't have
- * any internal failures that are so bad as to require a transaction abort.
- *
- * This is out-of-line to suppress "might be clobbered by longjmp" warnings.
- */
-static void
-do_spi_elog(int level, char *message)
-{
-	MemoryContext oldcontext = CurrentMemoryContext;
-
-	PG_TRY();
-	{
-		elog(level, "%s", message);
-	}
-	PG_CATCH();
-	{
-		ErrorData  *edata;
-
-		/* Must reset elog.c's state */
-		MemoryContextSwitchTo(oldcontext);
-		edata = CopyErrorData();
-		FlushErrorState();
-
-		/* Punt the error to Perl */
-		croak("%s", edata->message);
-	}
-	PG_END_TRY();
-}
-
-/*
  * Interface routine to catch ereports and punt them to Perl
  */
 static void
@@ -69,40 +44,11 @@ do_plperl_return_next(SV *sv)
 }
 
 
-MODULE = SPI PREFIX = spi_
+MODULE = PostgreSQL::InServer::SPI PREFIX = spi_
 
 PROTOTYPES: ENABLE
 VERSIONCHECK: DISABLE
 
-void
-spi_elog(level, message)
-	int level
-	char* message
-	CODE:
-		if (level > ERROR)		/* no PANIC allowed thanks */
-			level = ERROR;
-		if (level < DEBUG5)
-			level = DEBUG5;
-		do_spi_elog(level, message);
-
-int
-spi_DEBUG()
-
-int
-spi_LOG()
-
-int
-spi_INFO()
-
-int
-spi_NOTICE()
-
-int
-spi_WARNING()
-
-int
-spi_ERROR()
-
 SV*
 spi_spi_exec_query(query, ...)
 	char* query;
diff --git a/src/pl/plperl/Util.xs b/src/pl/plperl/Util.xs
new file mode 100644
index 00000000000..e77961698d8
--- /dev/null
+++ b/src/pl/plperl/Util.xs
@@ -0,0 +1,205 @@
+/**********************************************************************
+ * PostgreSQL::InServer::Util
+ *
+ * $PostgreSQL: pgsql/src/pl/plperl/Util.xs,v 1.1 2010/01/20 01:08:21 adunstan Exp $
+ *
+ * Defines plperl interfaces for general-purpose utilities.
+ * This module is bootstrapped as soon as an interpreter is initialized.
+ * Currently doesn't define a PACKAGE= so all subs are in main:: to avoid
+ * the need for explicit importing.
+ *
+ **********************************************************************/
+
+/* this must be first: */
+#include "postgres.h"
+#include "fmgr.h"
+#include "utils/builtins.h"
+#include "utils/bytea.h"       /* for byteain & byteaout */
+#include "mb/pg_wchar.h"       /* for GetDatabaseEncoding */
+/* Defined by Perl */
+#undef _
+
+/* perl stuff */
+#include "plperl.h"
+
+
+/*
+ * Implementation of plperl's elog() function
+ *
+ * If the error level is less than ERROR, we'll just emit the message and
+ * return.  When it is ERROR, elog() will longjmp, which we catch and
+ * turn into a Perl croak().  Note we are assuming that elog() can't have
+ * any internal failures that are so bad as to require a transaction abort.
+ *
+ * This is out-of-line to suppress "might be clobbered by longjmp" warnings.
+ */
+static void
+do_util_elog(int level, char *message)
+{
+    MemoryContext oldcontext = CurrentMemoryContext;
+
+    PG_TRY();
+    {
+        elog(level, "%s", message);
+    }
+    PG_CATCH();
+    {
+        ErrorData  *edata;
+
+        /* Must reset elog.c's state */
+        MemoryContextSwitchTo(oldcontext);
+        edata = CopyErrorData();
+        FlushErrorState();
+
+        /* Punt the error to Perl */
+        croak("%s", edata->message);
+    }
+    PG_END_TRY();
+}
+
+static SV  *
+newSVstring_len(const char *str, STRLEN len)
+{
+    SV         *sv;
+
+    sv = newSVpvn(str, len);
+#if PERL_BCDVERSION >= 0x5006000L
+    if (GetDatabaseEncoding() == PG_UTF8)
+        SvUTF8_on(sv);
+#endif
+    return sv;
+}
+
+static text *
+sv2text(SV *sv)
+{
+    STRLEN    sv_len;
+    char     *sv_pv;
+
+    if (!sv)
+        sv = &PL_sv_undef;
+    sv_pv = SvPV(sv, sv_len);
+    return cstring_to_text_with_len(sv_pv, sv_len);
+}
+
+MODULE = PostgreSQL::InServer::Util PREFIX = util_
+
+PROTOTYPES: ENABLE
+VERSIONCHECK: DISABLE
+
+int
+_aliased_constants()
+    PROTOTYPE:
+    ALIAS:
+        DEBUG   = DEBUG2
+        LOG     = LOG
+        INFO    = INFO
+        NOTICE  = NOTICE
+        WARNING = WARNING
+        ERROR   = ERROR
+    CODE:
+    /* uses the ALIAS value as the return value */
+    RETVAL = ix;
+    OUTPUT:
+    RETVAL
+
+
+void
+util_elog(level, message)
+    int level
+    char* message
+    CODE:
+        if (level > ERROR)      /* no PANIC allowed thanks */
+            level = ERROR;
+        if (level < DEBUG5)
+            level = DEBUG5;
+        do_util_elog(level, message);
+
+SV *
+util_quote_literal(sv)
+    SV *sv
+    CODE:
+    if (!sv || !SvOK(sv)) {
+        RETVAL = &PL_sv_undef;
+    }
+    else {
+        text *arg = sv2text(sv);
+        text *ret = DatumGetTextP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg)));
+        RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+    }
+    OUTPUT:
+    RETVAL
+
+SV *
+util_quote_nullable(sv)
+    SV *sv
+    CODE:
+    if (!sv || !SvOK(sv)) 
+	{
+        RETVAL = newSVstring_len("NULL", 4);
+    }
+    else 
+	{
+        text *arg = sv2text(sv);
+        text *ret = DatumGetTextP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg)));
+        RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+    }
+    OUTPUT:
+    RETVAL
+
+SV *
+util_quote_ident(sv)
+    SV *sv
+    PREINIT:
+        text *arg;
+        text *ret;
+    CODE:
+        arg = sv2text(sv);
+        ret = DatumGetTextP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg)));
+        RETVAL = newSVstring_len(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+    OUTPUT:
+    RETVAL
+
+SV *
+util_decode_bytea(sv)
+    SV *sv
+    PREINIT:
+        char *arg;
+        text *ret;
+    CODE:
+        arg = SvPV_nolen(sv);
+        ret = DatumGetTextP(DirectFunctionCall1(byteain, PointerGetDatum(arg)));
+        /* not newSVstring_len because this is raw bytes not utf8'able */
+        RETVAL = newSVpvn(VARDATA(ret), (VARSIZE(ret) - VARHDRSZ));
+    OUTPUT:
+    RETVAL
+
+SV *
+util_encode_bytea(sv)
+    SV *sv
+    PREINIT:
+        text *arg;
+        char *ret;
+    CODE:
+        arg = sv2text(sv);
+        ret = DatumGetCString(DirectFunctionCall1(byteaout, PointerGetDatum(arg)));
+        RETVAL = newSVstring_len(ret, strlen(ret));
+    OUTPUT:
+    RETVAL
+
+SV *
+looks_like_number(sv)
+    SV *sv
+    CODE:
+    if (!SvOK(sv))
+        RETVAL = &PL_sv_undef;
+    else if ( looks_like_number(sv) )
+        RETVAL = &PL_sv_yes;
+    else
+        RETVAL = &PL_sv_no;
+    OUTPUT:
+    RETVAL
+
+
+BOOT:
+    items = 0;  /* avoid 'unused variable' warning */
diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out
index 1791d3cc314..89497e3236d 100644
--- a/src/pl/plperl/expected/plperl_elog.out
+++ b/src/pl/plperl/expected/plperl_elog.out
@@ -21,7 +21,6 @@ create or replace function perl_warn(text) returns void language plperl as $$
 $$;
 select perl_warn('implicit elog via warn');
 NOTICE:  implicit elog via warn at line 4.
-
 CONTEXT:  PL/Perl function "perl_warn"
  perl_warn 
 -----------
diff --git a/src/pl/plperl/expected/plperl_util.out b/src/pl/plperl/expected/plperl_util.out
new file mode 100644
index 00000000000..6f16669b261
--- /dev/null
+++ b/src/pl/plperl/expected/plperl_util.out
@@ -0,0 +1,171 @@
+-- test plperl utility functions (defined in Util.xs)
+-- test quote_literal
+create or replace function perl_quote_literal() returns setof text language plperl as $$
+	return_next "undef: ".quote_literal(undef);
+	return_next sprintf"$_: ".quote_literal($_)
+		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
+	return undef;
+$$;
+select perl_quote_literal();
+ perl_quote_literal 
+--------------------
+ undef: 
+ foo: 'foo'
+ a'b: 'a''b'
+ a"b: 'a"b'
+ c''d: 'c''''d'
+ e\f: E'e\\f'
+ : ''
+(7 rows)
+
+-- test quote_nullable
+create or replace function perl_quote_nullable() returns setof text language plperl as $$
+	return_next "undef: ".quote_nullable(undef);
+	return_next sprintf"$_: ".quote_nullable($_)
+		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
+	return undef;
+$$;
+select perl_quote_nullable();
+ perl_quote_nullable 
+---------------------
+ undef: NULL
+ foo: 'foo'
+ a'b: 'a''b'
+ a"b: 'a"b'
+ c''d: 'c''''d'
+ e\f: E'e\\f'
+ : ''
+(7 rows)
+
+-- test quote_ident
+create or replace function perl_quote_ident() returns setof text language plperl as $$
+	return_next "undef: ".quote_ident(undef); # generates undef warning if warnings enabled
+	return_next "$_: ".quote_ident($_)
+		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{g.h}, q{};
+	return undef;
+$$;
+select perl_quote_ident();
+ perl_quote_ident 
+------------------
+ undef: ""
+ foo: foo
+ a'b: "a'b"
+ a"b: "a""b"
+ c''d: "c''d"
+ e\f: "e\f"
+ g.h: "g.h"
+ : ""
+(8 rows)
+
+-- test decode_bytea
+create or replace function perl_decode_bytea() returns setof text language plperl as $$
+	return_next "undef: ".decode_bytea(undef); # generates undef warning if warnings enabled
+	return_next "$_: ".decode_bytea($_)
+		for q{foo}, q{a\047b}, q{};
+	return undef;
+$$;
+select perl_decode_bytea();
+ perl_decode_bytea 
+-------------------
+ undef: 
+ foo: foo
+ a\047b: a'b
+ : 
+(4 rows)
+
+-- test encode_bytea
+create or replace function perl_encode_bytea() returns setof text language plperl as $$
+	return_next encode_bytea(undef); # generates undef warning if warnings enabled
+	return_next encode_bytea($_)
+		for q{@}, qq{@\x01@}, qq{@\x00@}, q{};
+	return undef;
+$$;
+select perl_encode_bytea();
+ perl_encode_bytea 
+-------------------
+ \x
+ \x40
+ \x400140
+ \x400040
+ \x
+(5 rows)
+
+-- test encode_array_literal
+create or replace function perl_encode_array_literal() returns setof text language plperl as $$
+	return_next encode_array_literal(undef);
+	return_next encode_array_literal(0);
+	return_next encode_array_literal(42);
+	return_next encode_array_literal($_)
+		for [], [0], [1..5], [[]], [[1,2,[3]],4];
+	return_next encode_array_literal($_,'|')
+		for [], [0], [1..5], [[]], [[1,2,[3]],4];
+	return undef;
+$$;
+select perl_encode_array_literal();
+ perl_encode_array_literal 
+---------------------------
+ 
+ 0
+ 42
+ {}
+ {"0"}
+ {"1", "2", "3", "4", "5"}
+ {{}}
+ {{"1", "2", {"3"}}, "4"}
+ {}
+ {"0"}
+ {"1"|"2"|"3"|"4"|"5"}
+ {{}}
+ {{"1"|"2"|{"3"}}|"4"}
+(13 rows)
+
+-- test encode_array_constructor
+create or replace function perl_encode_array_constructor() returns setof text language plperl as $$
+	return_next encode_array_constructor(undef);
+	return_next encode_array_constructor(0);
+	return_next encode_array_constructor(42);
+	return_next encode_array_constructor($_)
+		for [], [0], [1..5], [[]], [[1,2,[3]],4];
+	return undef;
+$$;
+select perl_encode_array_constructor();
+      perl_encode_array_constructor      
+-----------------------------------------
+ NULL
+ '0'
+ '42'
+ ARRAY[]
+ ARRAY['0']
+ ARRAY['1', '2', '3', '4', '5']
+ ARRAY[ARRAY[]]
+ ARRAY[ARRAY['1', '2', ARRAY['3']], '4']
+(8 rows)
+
+-- test looks_like_number
+create or replace function perl_looks_like_number() returns setof text language plperl as $$
+	return_next "undef is undef" if not defined looks_like_number(undef);
+	return_next quote_nullable($_).": ". (looks_like_number($_) ? "number" : "not number")
+		for 'foo', 0, 1, 1.3, '+3.e-4',
+			'42 x', # trailing garbage
+			'99  ', # trailing space
+			'  99', # leading space
+			'    ', # only space
+			'';     # empty string
+	return undef;
+$$;
+select perl_looks_like_number();
+ perl_looks_like_number 
+------------------------
+ undef is undef
+ 'foo': not number
+ '0': number
+ '1': number
+ '1.3': number
+ '+3.e-4': number
+ '42 x': not number
+ '99  ': number
+ '  99': number
+ '    ': not number
+ '': not number
+(11 rows)
+
diff --git a/src/pl/plperl/plc_perlboot.pl b/src/pl/plperl/plc_perlboot.pl
index d2d55184766..29f7bed3dc4 100644
--- a/src/pl/plperl/plc_perlboot.pl
+++ b/src/pl/plperl/plc_perlboot.pl
@@ -1,24 +1,33 @@
-SPI::bootstrap();
+
+#  $PostgreSQL: pgsql/src/pl/plperl/plc_perlboot.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
+
+PostgreSQL::InServer::Util::bootstrap();
+PostgreSQL::InServer::SPI::bootstrap();
+
+use strict;
+use warnings;
 use vars qw(%_SHARED);
 
 sub ::plperl_warn {
 	(my $msg = shift) =~ s/\(eval \d+\) //g;
+	chomp $msg;
 	&elog(&NOTICE, $msg);
 }
 $SIG{__WARN__} = \&::plperl_warn;
 
 sub ::plperl_die {
 	(my $msg = shift) =~ s/\(eval \d+\) //g;
-    die $msg;
+	die $msg;
 }
 $SIG{__DIE__} = \&::plperl_die;
 
+
 sub ::mkunsafefunc {
 	my $ret = eval(qq[ sub { $_[0] $_[1] } ]);
 	$@ =~ s/\(eval \d+\) //g if $@;
 	return $ret;
 }
-
+  
 use strict;
 
 sub ::mk_strict_unsafefunc {
@@ -27,24 +36,36 @@ sub ::mk_strict_unsafefunc {
 	return $ret;
 }
 
-sub ::_plperl_to_pg_array {
-  my $arg = shift;
-  ref $arg eq 'ARRAY' || return $arg;
-  my $res = '';
-  my $first = 1;
-  foreach my $elem (@$arg) {
-    $res .= ', ' unless $first; $first = undef;
-    if (ref $elem) {
-      $res .= _plperl_to_pg_array($elem);
-    }
-    elsif (defined($elem)) {
-      my $str = qq($elem);
-      $str =~ s/([\"\\])/\\$1/g;
-      $res .= qq(\"$str\");
-    }
-    else {
-      $res .= 'NULL' ;
-    }
-  }
-  return qq({$res});
+sub ::encode_array_literal {
+	my ($arg, $delim) = @_;
+	return $arg
+		if ref $arg ne 'ARRAY';
+	$delim = ', ' unless defined $delim;
+	my $res = '';
+	foreach my $elem (@$arg) {
+		$res .= $delim if length $res;
+		if (ref $elem) {
+			$res .= ::encode_array_literal($elem, $delim);
+		}
+		elsif (defined $elem) {
+			(my $str = $elem) =~ s/(["\\])/\\$1/g;
+			$res .= qq("$str");
+		}
+		else {
+			$res .= 'NULL';
+		}
+	}
+	return qq({$res});
+}
+
+sub ::encode_array_constructor {
+	my $arg = shift;
+	return quote_nullable($arg)
+		if ref $arg ne 'ARRAY';
+	my $res = join ", ", map {
+		(ref $_) ? ::encode_array_constructor($_)
+				 : ::quote_nullable($_)
+	} @$arg;
+	return "ARRAY[$res]";
 }
+
diff --git a/src/pl/plperl/plc_safe_bad.pl b/src/pl/plperl/plc_safe_bad.pl
index 838ccc63af5..4193c818180 100644
--- a/src/pl/plperl/plc_safe_bad.pl
+++ b/src/pl/plperl/plc_safe_bad.pl
@@ -1,3 +1,6 @@
+
+#  $PostgreSQL: pgsql/src/pl/plperl/plc_safe_bad.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
+
 use vars qw($PLContainer);
 
 $PLContainer = new Safe('PLPerl');
diff --git a/src/pl/plperl/plc_safe_ok.pl b/src/pl/plperl/plc_safe_ok.pl
index 73c5573ba89..cc4d3bdc3fa 100644
--- a/src/pl/plperl/plc_safe_ok.pl
+++ b/src/pl/plperl/plc_safe_ok.pl
@@ -1,3 +1,7 @@
+
+
+#  $PostgreSQL: pgsql/src/pl/plperl/plc_safe_ok.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
+
 use vars qw($PLContainer);
 
 $PLContainer = new Safe('PLPerl');
@@ -7,8 +11,11 @@ $PLContainer->permit(qw[:base_math !:base_io sort time]);
 $PLContainer->share(qw[&elog &return_next
 	&spi_query &spi_fetchrow &spi_cursor_close &spi_exec_query
 	&spi_prepare &spi_exec_prepared &spi_query_prepared &spi_freeplan
-	&_plperl_to_pg_array
 	&DEBUG &LOG &INFO &NOTICE &WARNING &ERROR %_SHARED
+	&quote_literal &quote_nullable &quote_ident
+	&encode_bytea &decode_bytea
+	&encode_array_literal &encode_array_constructor
+	&looks_like_number
 ]);
 
 # Load strict into the container.
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 1dd704ffd06..6daab687c3b 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
 /**********************************************************************
  * plperl.c - perl as a procedural language for PostgreSQL
  *
- *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.159 2010/01/09 02:40:50 adunstan Exp $
+ *	  $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.160 2010/01/20 01:08:21 adunstan Exp $
  *
  **********************************************************************/
 
@@ -589,12 +589,12 @@ plperl_convert_to_pg_array(SV *src)
 	XPUSHs(src);
 	PUTBACK;
 
-	count = call_pv("::_plperl_to_pg_array", G_SCALAR);
+	count = perl_call_pv("::encode_array_literal", G_SCALAR);
 
 	SPAGAIN;
 
 	if (count != 1)
-		elog(ERROR, "unexpected _plperl_to_pg_array failure");
+		elog(ERROR, "unexpected encode_array_literal failure");
 
 	rv = POPs;
 
@@ -1089,7 +1089,8 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s)
  **********************************************************************/
 
 EXTERN_C void boot_DynaLoader(pTHX_ CV *cv);
-EXTERN_C void boot_SPI(pTHX_ CV *cv);
+EXTERN_C void boot_PostgreSQL__InServer__SPI(pTHX_ CV *cv);
+EXTERN_C void boot_PostgreSQL__InServer__Util(pTHX_ CV *cv);
 
 static void
 plperl_init_shared_libs(pTHX)
@@ -1097,7 +1098,10 @@ plperl_init_shared_libs(pTHX)
 	char	   *file = __FILE__;
 
 	newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-	newXS("SPI::bootstrap", boot_SPI, file);
+	newXS("PostgreSQL::InServer::SPI::bootstrap",
+		  boot_PostgreSQL__InServer__SPI, file);
+	newXS("PostgreSQL::InServer::Util::bootstrap",
+		boot_PostgreSQL__InServer__Util, file);
 }
 
 
diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h
index ae1002cdd73..6d58f117ca1 100644
--- a/src/pl/plperl/plperl.h
+++ b/src/pl/plperl/plperl.h
@@ -8,7 +8,7 @@
  * Portions Copyright (c) 1996-2010, PostgreSQL Global Development Group
  * Portions Copyright (c) 1995, Regents of the University of California
  *
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.h,v 1.10 2010/01/02 16:58:12 momjian Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.h,v 1.11 2010/01/20 01:08:21 adunstan Exp $
  */
 
 #ifndef PL_PERL_H
@@ -30,28 +30,19 @@
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
-#include "ppport.h"
 
-/* just in case these symbols aren't provided */
-#ifndef pTHX_
-#define pTHX_
-#define pTHX void
-#endif
+/* perl version and platform portability */
+#define NEED_eval_pv
+#define NEED_newRV_noinc
+#define NEED_sv_2pv_flags
+#include "ppport.h"
 
 /* perl may have a different width of "bool", don't buy it */
 #ifdef bool
 #undef bool
 #endif
 
-/* routines from spi_internal.c */
-int			spi_DEBUG(void);
-int			spi_LOG(void);
-int			spi_INFO(void);
-int			spi_NOTICE(void);
-int			spi_WARNING(void);
-int			spi_ERROR(void);
-
-/* routines from plperl.c */
+/* declare routines from plperl.c for access by .xs files */
 HV		   *plperl_spi_exec(char *, int);
 void		plperl_return_next(SV *);
 SV		   *plperl_spi_query(char *);
diff --git a/src/pl/plperl/spi_internal.c b/src/pl/plperl/spi_internal.c
deleted file mode 100644
index 5544fbf4617..00000000000
--- a/src/pl/plperl/spi_internal.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/*
- * $PostgreSQL: pgsql/src/pl/plperl/spi_internal.c,v 1.10 2009/06/11 14:49:14 momjian Exp $
- *
- *
- * This kludge is necessary because of the conflicting
- * definitions of 'DEBUG' between postgres and perl.
- * we'll live.
- */
-
-#include "postgres.h"
-/* Defined by Perl */
-#undef _
-
-/* perl stuff */
-#include "plperl.h"
-
-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;
-}
diff --git a/src/pl/plperl/sql/plperl_util.sql b/src/pl/plperl/sql/plperl_util.sql
new file mode 100644
index 00000000000..6a810d8dd28
--- /dev/null
+++ b/src/pl/plperl/sql/plperl_util.sql
@@ -0,0 +1,100 @@
+-- test plperl utility functions (defined in Util.xs)
+
+-- test quote_literal
+
+create or replace function perl_quote_literal() returns setof text language plperl as $$
+	return_next "undef: ".quote_literal(undef);
+	return_next sprintf"$_: ".quote_literal($_)
+		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
+	return undef;
+$$;
+
+select perl_quote_literal();
+
+-- test quote_nullable
+
+create or replace function perl_quote_nullable() returns setof text language plperl as $$
+	return_next "undef: ".quote_nullable(undef);
+	return_next sprintf"$_: ".quote_nullable($_)
+		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{};
+	return undef;
+$$;
+
+select perl_quote_nullable();
+
+-- test quote_ident
+
+create or replace function perl_quote_ident() returns setof text language plperl as $$
+	return_next "undef: ".quote_ident(undef); # generates undef warning if warnings enabled
+	return_next "$_: ".quote_ident($_)
+		for q{foo}, q{a'b}, q{a"b}, q{c''d}, q{e\f}, q{g.h}, q{};
+	return undef;
+$$;
+
+select perl_quote_ident();
+
+-- test decode_bytea
+
+create or replace function perl_decode_bytea() returns setof text language plperl as $$
+	return_next "undef: ".decode_bytea(undef); # generates undef warning if warnings enabled
+	return_next "$_: ".decode_bytea($_)
+		for q{foo}, q{a\047b}, q{};
+	return undef;
+$$;
+
+select perl_decode_bytea();
+
+-- test encode_bytea
+
+create or replace function perl_encode_bytea() returns setof text language plperl as $$
+	return_next encode_bytea(undef); # generates undef warning if warnings enabled
+	return_next encode_bytea($_)
+		for q{@}, qq{@\x01@}, qq{@\x00@}, q{};
+	return undef;
+$$;
+
+select perl_encode_bytea();
+
+-- test encode_array_literal
+
+create or replace function perl_encode_array_literal() returns setof text language plperl as $$
+	return_next encode_array_literal(undef);
+	return_next encode_array_literal(0);
+	return_next encode_array_literal(42);
+	return_next encode_array_literal($_)
+		for [], [0], [1..5], [[]], [[1,2,[3]],4];
+	return_next encode_array_literal($_,'|')
+		for [], [0], [1..5], [[]], [[1,2,[3]],4];
+	return undef;
+$$;
+
+select perl_encode_array_literal();
+
+-- test encode_array_constructor
+
+create or replace function perl_encode_array_constructor() returns setof text language plperl as $$
+	return_next encode_array_constructor(undef);
+	return_next encode_array_constructor(0);
+	return_next encode_array_constructor(42);
+	return_next encode_array_constructor($_)
+		for [], [0], [1..5], [[]], [[1,2,[3]],4];
+	return undef;
+$$;
+
+select perl_encode_array_constructor();
+
+-- test looks_like_number
+
+create or replace function perl_looks_like_number() returns setof text language plperl as $$
+	return_next "undef is undef" if not defined looks_like_number(undef);
+	return_next quote_nullable($_).": ". (looks_like_number($_) ? "number" : "not number")
+		for 'foo', 0, 1, 1.3, '+3.e-4',
+			'42 x', # trailing garbage
+			'99  ', # trailing space
+			'  99', # leading space
+			'    ', # only space
+			'';     # empty string
+	return undef;
+$$;
+
+select perl_looks_like_number();
diff --git a/src/pl/plperl/text2macro.pl b/src/pl/plperl/text2macro.pl
index 1628e8688d8..7e13ea5b276 100644
--- a/src/pl/plperl/text2macro.pl
+++ b/src/pl/plperl/text2macro.pl
@@ -1,3 +1,6 @@
+
+# $PostgreSQL: pgsql/src/pl/plperl/text2macro.pl,v 1.2 2010/01/20 01:08:21 adunstan Exp $
+
 =head1 NAME
 
 text2macro.pl - convert text files into C string-literal macro definitions