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)
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 $< >$@
......
......@@ -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
......@@ -47,19 +47,26 @@ 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
......@@ -68,7 +75,7 @@ sv2cstr(SV *sv)
res = utf_u2e(val, len);
/* safe now to garbage collect the new SV */
SvREFCNT_dec(nsv);
SvREFCNT_dec(sv);
return res;
}
......
......@@ -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}); $$;
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