summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Dunstan <andrew@dunslane.net>2012-01-15 16:20:39 -0500
committerAndrew Dunstan <andrew@dunslane.net>2012-01-15 16:20:39 -0500
commitef007e67022bf7f2367aa10fd226d6fb86b6fb9c (patch)
treeca89f67464e1dda3739e080fe33f8a287bc104bf
parentb994c57a8032f55f816768ee55a677e03190abae (diff)
downloadpostgresql-ef007e67022bf7f2367aa10fd226d6fb86b6fb9c.tar.gz
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.
-rw-r--r--src/pl/plperl/GNUmakefile4
-rw-r--r--src/pl/plperl/expected/plperl_elog.out4
-rw-r--r--src/pl/plperl/plperl_helpers.h21
-rw-r--r--src/pl/plperl/sql/plperl_elog.sql3
4 files changed, 23 insertions, 9 deletions
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index 55f48cd401..2f448018a4 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}); $$;