From 01d83ffdcae92f75dbfd41de0b4213d241edd394 Mon Sep 17 00:00:00 2001
From: Andrew Dunstan <andrew@dunslane.net>
Date: Sun, 15 Jan 2012 16:15:04 -0500
Subject: [PATCH] Improve efficiency of recent changes to plperl's sv2cstr().

Along the way, add a missing dependency in the GNUmakefile.

Alex Hunsaker, with a slight adjustment by me.
---
 src/pl/plperl/GNUmakefile              |  4 ++--
 src/pl/plperl/expected/plperl_elog.out |  4 ++++
 src/pl/plperl/plperl_helpers.h         | 21 ++++++++++++++-------
 src/pl/plperl/sql/plperl_elog.sql      |  3 +++
 4 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index 0f3bd99570..188d7d234b 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -72,11 +72,11 @@ perlchunks.h: $(PERLCHUNKS)
 
 all: all-lib
 
-SPI.c: SPI.xs
+SPI.c: SPI.xs plperl_helpers.h
 	@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
 	$(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
 
-Util.c: Util.xs
+Util.c: Util.xs plperl_helpers.h
 	@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
 	$(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
 
diff --git a/src/pl/plperl/expected/plperl_elog.out b/src/pl/plperl/expected/plperl_elog.out
index 02497d9e02..60eade8ddd 100644
--- a/src/pl/plperl/expected/plperl_elog.out
+++ b/src/pl/plperl/expected/plperl_elog.out
@@ -58,3 +58,7 @@ select uses_global();
  uses_global worked
 (1 row)
 
+-- make sure we don't choke on readonly values
+do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
+NOTICE:  0
+CONTEXT:  PL/Perl anonymous code block
diff --git a/src/pl/plperl/plperl_helpers.h b/src/pl/plperl/plperl_helpers.h
index 800a408ac4..35e1257457 100644
--- a/src/pl/plperl/plperl_helpers.h
+++ b/src/pl/plperl/plperl_helpers.h
@@ -47,28 +47,35 @@ sv2cstr(SV *sv)
 {
 	char	   *val, *res;
 	STRLEN		len;
-	SV         *nsv;
 
 	/*
 	 * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
 	 *
 	 * SvPVutf8() croaks nastily on certain things, like typeglobs and
 	 * readonly objects such as $^V. That's a perl bug - it's not supposed to
-	 * happen. To avoid crashing the backend, we make a copy of the
-	 * sv before passing it to SvPVutf8(). The copy is garbage collected 
+	 * happen. To avoid crashing the backend, we make a copy of the sv before
+	 * passing it to SvPVutf8(). The copy is garbage collected 
 	 * when we're done with it.
 	 */
-	nsv = newSVsv(sv);
-	val = SvPVutf8(nsv, len);
+	if (SvREADONLY(sv) ||
+		isGV_with_GP(sv) ||
+		(SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
+		sv = newSVsv(sv);
+	else
+		/* increase the reference count so we cant just SvREFCNT_dec() it when
+		 * we are done */
+		SvREFCNT_inc(sv);
+
+	val = SvPVutf8(sv, len);
 
 	/*
 	 * we use perl's length in the event we had an embedded null byte to ensure
 	 * we error out properly
 	 */
-	res =  utf_u2e(val, len);
+	res = utf_u2e(val, len);
 
 	/* safe now to garbage collect the new SV */
-	SvREFCNT_dec(nsv);
+	SvREFCNT_dec(sv);
 
 	return res;
 }
diff --git a/src/pl/plperl/sql/plperl_elog.sql b/src/pl/plperl/sql/plperl_elog.sql
index 4f1c014efb..40896a48f4 100644
--- a/src/pl/plperl/sql/plperl_elog.sql
+++ b/src/pl/plperl/sql/plperl_elog.sql
@@ -43,3 +43,6 @@ create or replace function uses_global() returns text language plperl as $$
 $$;
 
 select uses_global();
+
+-- make sure we don't choke on readonly values
+do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
-- 
2.40.0