Commit 01d83ffd authored by Andrew Dunstan's avatar Andrew Dunstan

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.
parent b2b4af53
...@@ -72,11 +72,11 @@ perlchunks.h: $(PERLCHUNKS) ...@@ -72,11 +72,11 @@ perlchunks.h: $(PERLCHUNKS)
all: all-lib 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 @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 $< >$@ $(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 @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 $< >$@ $(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
......
...@@ -58,3 +58,7 @@ select uses_global(); ...@@ -58,3 +58,7 @@ select uses_global();
uses_global worked uses_global worked
(1 row) (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
...@@ -47,28 +47,35 @@ sv2cstr(SV *sv) ...@@ -47,28 +47,35 @@ sv2cstr(SV *sv)
{ {
char *val, *res; char *val, *res;
STRLEN len; STRLEN len;
SV *nsv;
/* /*
* get a utf8 encoded char * out of perl. *note* it may not be valid utf8! * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
* *
* SvPVutf8() croaks nastily on certain things, like typeglobs and * SvPVutf8() croaks nastily on certain things, like typeglobs and
* readonly objects such as $^V. That's a perl bug - it's not supposed to * 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 * happen. To avoid crashing the backend, we make a copy of the sv before
* sv before passing it to SvPVutf8(). The copy is garbage collected * passing it to SvPVutf8(). The copy is garbage collected
* when we're done with it. * when we're done with it.
*/ */
nsv = newSVsv(sv); if (SvREADONLY(sv) ||
val = SvPVutf8(nsv, len); 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 use perl's length in the event we had an embedded null byte to ensure
* we error out properly * we error out properly
*/ */
res = utf_u2e(val, len); res = utf_u2e(val, len);
/* safe now to garbage collect the new SV */ /* safe now to garbage collect the new SV */
SvREFCNT_dec(nsv); SvREFCNT_dec(sv);
return res; return res;
} }
......
...@@ -43,3 +43,6 @@ create or replace function uses_global() returns text language plperl as $$ ...@@ -43,3 +43,6 @@ create or replace function uses_global() returns text language plperl as $$
$$; $$;
select uses_global(); select uses_global();
-- make sure we don't choke on readonly values
do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment