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.
This commit is contained in:
parent
b2b4af535e
commit
01d83ffdca
@ -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();
|
|||||||
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,19 +47,26 @@ 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
|
||||||
@ -68,7 +75,7 @@ sv2cstr(SV *sv)
|
|||||||
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 $$
|
|||||||
$$;
|
$$;
|
||||||
|
|
||||||
select uses_global();
|
select uses_global();
|
||||||
|
|
||||||
|
-- make sure we don't choke on readonly values
|
||||||
|
do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
|
||||||
|
Loading…
x
Reference in New Issue
Block a user