plperl_ro_v4.patch

*** a/src/pl/plperl/GNUmakefile
--- b/src/pl/plperl/GNUmakefile
***************
*** 72,82 **** perlchunks.h: $(PERLCHUNKS)
  
  all: all-lib
  
! SPI.c: SPI.xs
  	@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
  	@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 $< >$@
  
--- 72,82 ----
  
  all: all-lib
  
! 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 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 $< >$@
  
*** a/src/pl/plperl/expected/plperl_elog.out
--- b/src/pl/plperl/expected/plperl_elog.out
***************
*** 58,60 **** select uses_global();
--- 58,62 ----
   uses_global worked
  (1 row)
  
+ -- make sure we don't choke on readonly values
+ do language plperl $$ elog('NOTICE', ${^TAINT}); $$;
*** a/src/pl/plperl/plperl_helpers.h
--- b/src/pl/plperl/plperl_helpers.h
***************
*** 47,74 **** 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 
  	 * when we're done with it.
  	 */
! 	nsv = newSVsv(sv);
! 	val = SvPVutf8(nsv, 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);
  
  	/* safe now to garbage collect the new SV */
! 	SvREFCNT_dec(nsv);
  
  	return res;
  }
--- 47,81 ----
  {
  	char	   *val, *res;
  	STRLEN		len;
  
  	/*
  	 * 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 
  	 * when we're done with it.
  	 */
! 	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);
  
  	/* safe now to garbage collect the new SV */
! 	SvREFCNT_dec(sv);
  
  	return res;
  }
*** a/src/pl/plperl/sql/plperl_elog.sql
--- b/src/pl/plperl/sql/plperl_elog.sql
***************
*** 43,45 **** create or replace function uses_global() returns text language plperl as $$
--- 43,48 ----
  $$;
  
  select uses_global();
+ 
+ -- make sure we don't choke on readonly values
+ do language plperl $$ elog('NOTICE', ${^TAINT}); $$;