@@ -58,8 +58,8 @@ PG_MODULE_MAGIC;
5858
5959
6060/**********************************************************************
61- * Information associated with a Perl interpreter. We have one interpreter
62- * that is used for all plperlu (untrusted) functions. For plperl (trusted)
61+ * Information associated with a Perl interpreter. We have one interpreter
62+ * that is used for all plperlu (untrusted) functions. For plperl (trusted)
6363 * functions, there is a separate interpreter for each effective SQL userid.
6464 * (This is needed to ensure that an unprivileged user can't inject Perl code
6565 * that'll be executed with the privileges of some other SQL user.)
@@ -83,9 +83,9 @@ PG_MODULE_MAGIC;
8383 **********************************************************************/
8484typedef struct plperl_interp_desc
8585{
86- Oid user_id ; /* Hash key (must be first!) */
87- PerlInterpreter * interp ; /* The interpreter */
88- HTAB * query_hash ; /* plperl_query_entry structs */
86+ Oid user_id ; /* Hash key (must be first!) */
87+ PerlInterpreter * interp ; /* The interpreter */
88+ HTAB * query_hash ; /* plperl_query_entry structs */
8989} plperl_interp_desc ;
9090
9191
@@ -97,7 +97,7 @@ typedef struct plperl_proc_desc
9797 char * proname ; /* user name of procedure */
9898 TransactionId fn_xmin ;
9999 ItemPointerData fn_tid ;
100- plperl_interp_desc * interp ; /* interpreter it's created in */
100+ plperl_interp_desc * interp ; /* interpreter it's created in */
101101 bool fn_readonly ;
102102 bool lanpltrusted ;
103103 bool fn_retistuple ; /* true, if function returns tuple */
@@ -127,18 +127,19 @@ typedef struct plperl_proc_desc
127127 **********************************************************************/
128128typedef struct plperl_proc_key
129129{
130- Oid proc_id ; /* Function OID */
130+ Oid proc_id ; /* Function OID */
131+
131132 /*
132133 * is_trigger is really a bool, but declare as Oid to ensure this struct
133134 * contains no padding
134135 */
135- Oid is_trigger ; /* is it a trigger function? */
136- Oid user_id ; /* User calling the function, or 0 */
136+ Oid is_trigger ; /* is it a trigger function? */
137+ Oid user_id ; /* User calling the function, or 0 */
137138} plperl_proc_key ;
138139
139140typedef struct plperl_proc_ptr
140141{
141- plperl_proc_key proc_key ; /* Hash key (must be first!) */
142+ plperl_proc_key proc_key ; /* Hash key (must be first!) */
142143 plperl_proc_desc * proc_ptr ;
143144} plperl_proc_ptr ;
144145
@@ -184,6 +185,7 @@ typedef struct plperl_query_entry
184185static HTAB * plperl_interp_hash = NULL ;
185186static HTAB * plperl_proc_hash = NULL ;
186187static plperl_interp_desc * plperl_active_interp = NULL ;
188+
187189/* If we have an unassigned "held" interpreter, it's stored here */
188190static PerlInterpreter * plperl_held_interp = NULL ;
189191
@@ -227,7 +229,8 @@ static char *hek2cstr(HE *he);
227229static SV * * hv_store_string (HV * hv , const char * key , SV * val );
228230static SV * * hv_fetch_string (HV * hv , const char * key );
229231static void plperl_create_sub (plperl_proc_desc * desc , char * s , Oid fn_oid );
230- static SV * plperl_call_perl_func (plperl_proc_desc * desc , FunctionCallInfo fcinfo );
232+ static SV * plperl_call_perl_func (plperl_proc_desc * desc ,
233+ FunctionCallInfo fcinfo );
231234static void plperl_compile_callback (void * arg );
232235static void plperl_exec_callback (void * arg );
233236static void plperl_inline_callback (void * arg );
@@ -245,31 +248,32 @@ static char *setlocale_perl(int category, char *locale);
245248static char *
246249hek2cstr (HE * he )
247250{
248- /*
249- * Unfortunately, while HeUTF8 is true for most things > 256, for
250- * values 128..255 it's not, but perl will treat them as
251- * unicode code points if the utf8 flag is not set ( see
252- * The "Unicode Bug" in perldoc perlunicode for more)
251+ /*-------------------------
252+ * Unfortunately, while HeUTF8 is true for most things > 256, for values
253+ * 128..255 it's not, but perl will treat them as unicode code points if
254+ * the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
255+ * for more)
253256 *
254257 * So if we did the expected:
255- * if (HeUTF8(he))
256- * utf_u2e(key...);
257- * else // must be ascii
258- * return HePV(he);
258+ * if (HeUTF8(he))
259+ * utf_u2e(key...);
260+ * else // must be ascii
261+ * return HePV(he);
259262 * we won't match columns with codepoints from 128..255
260263 *
261- * For a more concrete example given a column with the
262- * name of the unicode codepoint U+00ae (registered sign)
263- * and a UTF8 database and the perl return_next {
264- * "\N{U+00ae}=>'text } would always fail as heUTF8
265- * returns 0 and HePV() would give us a char * with 1 byte
266- * contains the decimal value 174
264+ * For a more concrete example given a column with the name of the unicode
265+ * codepoint U+00ae (registered sign) and a UTF8 database and the perl
266+ * return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
267+ * 0 and HePV() would give us a char * with 1 byte contains the decimal
268+ * value 174
267269 *
268- * Perl has the brains to know when it should utf8 encode
269- * 174 properly, so here we force it into an SV so that
270- * perl will figure it out and do the right thing
270+ * Perl has the brains to know when it should utf8 encode 174 properly, so
271+ * here we force it into an SV so that perl will figure it out and do the
272+ * right thing
273+ *-------------------------
271274 */
272- SV * sv = HeSVKEY_force (he );
275+ SV * sv = HeSVKEY_force (he );
276+
273277 if (HeUTF8 (he ))
274278 SvUTF8_on (sv );
275279 return sv2cstr (sv );
@@ -547,6 +551,7 @@ select_perl_context(bool trusted)
547551 else
548552 {
549553#ifdef MULTIPLICITY
554+
550555 /*
551556 * plperl_init_interp will change Perl's idea of the active
552557 * interpreter. Reset plperl_active_interp temporarily, so that if we
@@ -675,7 +680,7 @@ plperl_init_interp(void)
675680 STMT_START { \
676681 if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
677682 } STMT_END
678- #endif /* WIN32 */
683+ #endif /* WIN32 */
679684
680685 if (plperl_on_init && * plperl_on_init )
681686 {
@@ -685,12 +690,12 @@ plperl_init_interp(void)
685690
686691 /*
687692 * The perl API docs state that PERL_SYS_INIT3 should be called before
688- * allocating interpreters. Unfortunately, on some platforms this fails
689- * in the Perl_do_taint() routine, which is called when the platform is
690- * using the system's malloc() instead of perl's own. Other platforms,
691- * notably Windows, fail if PERL_SYS_INIT3 is not called. So we call it
692- * if it's available, unless perl is using the system malloc(), which is
693- * true when MYMALLOC is set.
693+ * allocating interpreters. Unfortunately, on some platforms this fails in
694+ * the Perl_do_taint() routine, which is called when the platform is using
695+ * the system's malloc() instead of perl's own. Other platforms, notably
696+ * Windows, fail if PERL_SYS_INIT3 is not called. So we call it if it's
697+ * available, unless perl is using the system malloc(), which is true when
698+ * MYMALLOC is set.
694699 */
695700#if defined(PERL_SYS_INIT3 ) && !defined(MYMALLOC )
696701 {
@@ -859,8 +864,8 @@ plperl_trusted_init(void)
859864 errcontext ("while executing PLC_TRUSTED" )));
860865
861866 /*
862- * Force loading of utf8 module now to prevent errors that can arise
863- * from the regex code later trying to load utf8 modules. See
867+ * Force loading of utf8 module now to prevent errors that can arise from
868+ * the regex code later trying to load utf8 modules. See
864869 * http://rt.perl.org/rt3/Ticket/Display.html?id=47576
865870 */
866871 eval_pv ("my $a=chr(0x100); return $a =~ /\\xa9/i" , FALSE);
@@ -956,7 +961,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
956961{
957962 TupleDesc td = attinmeta -> tupdesc ;
958963 char * * values ;
959- HE * he ;
964+ HE * he ;
960965 HeapTuple tup ;
961966 int i ;
962967
@@ -965,9 +970,9 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
965970 hv_iterinit (perlhash );
966971 while ((he = hv_iternext (perlhash )))
967972 {
968- SV * val = HeVAL (he );
969- char * key = hek2cstr (he );
970- int attn = SPI_fnumber (td , key );
973+ SV * val = HeVAL (he );
974+ char * key = hek2cstr (he );
975+ int attn = SPI_fnumber (td , key );
971976
972977 if (attn <= 0 || td -> attrs [attn - 1 ]-> attisdropped )
973978 ereport (ERROR ,
@@ -985,7 +990,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
985990
986991 tup = BuildTupleFromCStrings (attinmeta , values );
987992
988- for (i = 0 ; i < td -> natts ; i ++ )
993+ for (i = 0 ; i < td -> natts ; i ++ )
989994 {
990995 if (values [i ])
991996 pfree (values [i ]);
@@ -1173,8 +1178,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
11731178 Oid typioparam ;
11741179 int32 atttypmod ;
11751180 FmgrInfo finfo ;
1176- SV * val = HeVAL (he );
1177- char * key = hek2cstr (he );
1181+ SV * val = HeVAL (he );
1182+ char * key = hek2cstr (he );
11781183 int attn = SPI_fnumber (tupdesc , key );
11791184
11801185 if (attn <= 0 || tupdesc -> attrs [attn - 1 ]-> attisdropped )
@@ -1189,7 +1194,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
11891194 atttypmod = tupdesc -> attrs [attn - 1 ]-> atttypmod ;
11901195 if (SvOK (val ))
11911196 {
1192- char * str = sv2cstr (val );
1197+ char * str = sv2cstr (val );
1198+
11931199 modvalues [slotsused ] = InputFunctionCall (& finfo ,
11941200 str ,
11951201 typioparam ,
@@ -1452,12 +1458,13 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
14521458 EXTEND (SP , 4 );
14531459 PUSHs (sv_2mortal (cstr2sv (subname )));
14541460 PUSHs (sv_2mortal (newRV_noinc ((SV * ) pragma_hv )));
1455- /*
1456- * Use 'false' for $prolog in mkfunc, which is kept for compatibility
1457- * in case a module such as PostgreSQL::PLPerl::NYTprof replaces
1458- * the function compiler.
1461+
1462+ /*
1463+ * Use 'false' for $prolog in mkfunc, which is kept for compatibility in
1464+ * case a module such as PostgreSQL::PLPerl::NYTprof replaces the function
1465+ * compiler.
14591466 */
1460- PUSHs (& PL_sv_no );
1467+ PUSHs (& PL_sv_no );
14611468 PUSHs (sv_2mortal (cstr2sv (s )));
14621469 PUTBACK ;
14631470
@@ -1609,15 +1616,17 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
16091616 SV * td )
16101617{
16111618 dSP ;
1612- SV * retval , * TDsv ;
1613- int i , count ;
1619+ SV * retval ,
1620+ * TDsv ;
1621+ int i ,
1622+ count ;
16141623 Trigger * tg_trigger = ((TriggerData * ) fcinfo -> context )-> tg_trigger ;
16151624
16161625 ENTER ;
16171626 SAVETMPS ;
16181627
16191628 TDsv = get_sv ("_TD" , GV_ADD );
1620- SAVESPTR (TDsv ); /* local $_TD */
1629+ SAVESPTR (TDsv ); /* local $_TD */
16211630 sv_setsv (TDsv , td );
16221631
16231632 PUSHMARK (sp );
@@ -1796,7 +1805,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
17961805 else
17971806 {
17981807 /* Return a perl string converted to a Datum */
1799- char * str ;
1808+ char * str ;
18001809
18011810 if (prodesc -> fn_retisarray && SvROK (perlret ) &&
18021811 SvTYPE (SvRV (perlret )) == SVt_PVAV )
@@ -2500,7 +2509,7 @@ plperl_return_next(SV *sv)
25002509
25012510 if (SvOK (sv ))
25022511 {
2503- char * str ;
2512+ char * str ;
25042513
25052514 if (prodesc -> fn_retisarray && SvROK (sv ) &&
25062515 SvTYPE (SvRV (sv )) == SVt_PVAV )
@@ -2754,7 +2763,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv)
27542763 typInput ,
27552764 typIOParam ;
27562765 int32 typmod ;
2757- char * typstr ;
2766+ char * typstr ;
27582767
27592768 typstr = sv2cstr (argv [i ]);
27602769 parseTypeString (typstr , & typId , & typmod );
@@ -2922,7 +2931,8 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
29222931 {
29232932 if (SvOK (argv [i ]))
29242933 {
2925- char * str = sv2cstr (argv [i ]);
2934+ char * str = sv2cstr (argv [i ]);
2935+
29262936 argvalues [i ] = InputFunctionCall (& qdesc -> arginfuncs [i ],
29272937 str ,
29282938 qdesc -> argtypioparams [i ],
@@ -3057,7 +3067,8 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
30573067 {
30583068 if (SvOK (argv [i ]))
30593069 {
3060- char * str = sv2cstr (argv [i ]);
3070+ char * str = sv2cstr (argv [i ]);
3071+
30613072 argvalues [i ] = InputFunctionCall (& qdesc -> arginfuncs [i ],
30623073 str ,
30633074 qdesc -> argtypioparams [i ],
@@ -3177,10 +3188,12 @@ static SV **
31773188hv_store_string (HV * hv , const char * key , SV * val )
31783189{
31793190 int32 hlen ;
3180- char * hkey ;
3181- SV * * ret ;
3191+ char * hkey ;
3192+ SV * * ret ;
31823193
3183- hkey = (char * )pg_do_encoding_conversion ((unsigned char * )key , strlen (key ), GetDatabaseEncoding (), PG_UTF8 );
3194+ hkey = (char * )
3195+ pg_do_encoding_conversion ((unsigned char * ) key , strlen (key ),
3196+ GetDatabaseEncoding (), PG_UTF8 );
31843197
31853198 /*
31863199 * This seems nowhere documented, but under Perl 5.8.0 and up, hv_store()
@@ -3205,16 +3218,18 @@ static SV **
32053218hv_fetch_string (HV * hv , const char * key )
32063219{
32073220 int32 hlen ;
3208- char * hkey ;
3209- SV * * ret ;
3221+ char * hkey ;
3222+ SV * * ret ;
32103223
3211- hkey = (char * )pg_do_encoding_conversion ((unsigned char * )key , strlen (key ), GetDatabaseEncoding (), PG_UTF8 );
3224+ hkey = (char * )
3225+ pg_do_encoding_conversion ((unsigned char * ) key , strlen (key ),
3226+ GetDatabaseEncoding (), PG_UTF8 );
32123227
32133228 /* See notes in hv_store_string */
32143229 hlen = - strlen (hkey );
32153230 ret = hv_fetch (hv , hkey , hlen , 0 );
32163231
3217- if (hkey != key )
3232+ if (hkey != key )
32183233 pfree (hkey );
32193234
32203235 return ret ;
0 commit comments