aboutsummaryrefslogtreecommitdiff
path: root/src/pl/plperl/plperl.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/pl/plperl/plperl.c')
-rw-r--r--src/pl/plperl/plperl.c163
1 files changed, 86 insertions, 77 deletions
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 7d62caa4692..ff46d2c2854 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1,7 +1,7 @@
/**********************************************************************
* plperl.c - perl as a procedural language for PostgreSQL
*
- * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.178 2010/06/29 04:12:47 petere Exp $
+ * $PostgreSQL: pgsql/src/pl/plperl/plperl.c,v 1.179 2010/07/06 19:19:01 momjian Exp $
*
**********************************************************************/
@@ -185,6 +185,7 @@ static void plperl_inline_callback(void *arg);
static char *strip_trailing_ws(const char *msg);
static OP *pp_require_safe(pTHX);
static int restore_context(bool);
+
#ifdef WIN32
static char *setlocale_perl(int category, char *locale);
#endif
@@ -241,7 +242,8 @@ _PG_init(void)
*
* If initialization fails due to, e.g., plperl_init_interp() throwing an
* exception, then we'll return here on the next usage and the user will
- * get a rather cryptic: ERROR: attempt to redefine parameter "plperl.use_strict"
+ * get a rather cryptic: ERROR: attempt to redefine parameter
+ * "plperl.use_strict"
*/
static bool inited = false;
HASHCTL hash_ctl;
@@ -536,7 +538,6 @@ plperl_init_interp(void)
STMT_START { \
if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
} STMT_END
-
#endif
if (plperl_on_init)
@@ -579,17 +580,19 @@ plperl_init_interp(void)
/*
* Record the original function for the 'require' and 'dofile' opcodes.
- * (They share the same implementation.) Ensure it's used for new interpreters.
+ * (They share the same implementation.) Ensure it's used for new
+ * interpreters.
*/
if (!pp_require_orig)
pp_require_orig = PL_ppaddr[OP_REQUIRE];
- else
+ else
{
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
- PL_ppaddr[OP_DOFILE] = pp_require_orig;
+ PL_ppaddr[OP_DOFILE] = pp_require_orig;
}
#ifdef PLPERL_ENABLE_OPMASK_EARLY
+
/*
* For regression testing to prove that the PLC_PERLBOOT and PLC_TRUSTED
* code doesn't even compile any unsafe ops. In future there may be a
@@ -611,11 +614,11 @@ plperl_init_interp(void)
errcontext("while running Perl initialization")));
#ifdef PLPERL_RESTORE_LOCALE
- PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
- PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype);
+ PLPERL_RESTORE_LOCALE(LC_COLLATE, save_collate);
+ PLPERL_RESTORE_LOCALE(LC_CTYPE, save_ctype);
PLPERL_RESTORE_LOCALE(LC_MONETARY, save_monetary);
- PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric);
- PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
+ PLPERL_RESTORE_LOCALE(LC_NUMERIC, save_numeric);
+ PLPERL_RESTORE_LOCALE(LC_TIME, save_time);
#endif
return plperl;
@@ -693,27 +696,27 @@ plperl_destroy_interp(PerlInterpreter **interp)
static void
plperl_trusted_init(void)
{
- HV *stash;
- SV *sv;
- char *key;
- I32 klen;
-
+ HV *stash;
+ SV *sv;
+ char *key;
+ I32 klen;
+
/* use original require while we set up */
PL_ppaddr[OP_REQUIRE] = pp_require_orig;
PL_ppaddr[OP_DOFILE] = pp_require_orig;
-
+
eval_pv(PLC_TRUSTED, FALSE);
if (SvTRUE(ERRSV))
ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
errcontext("while executing PLC_TRUSTED")));
-
+
if (GetDatabaseEncoding() == PG_UTF8)
{
/*
- * Force loading of utf8 module now to prevent errors that can
- * arise from the regex code later trying to load utf8 modules.
- * See http://rt.perl.org/rt3/Ticket/Display.html?id=47576
+ * Force loading of utf8 module now to prevent errors that can arise
+ * from the regex code later trying to load utf8 modules. See
+ * http://rt.perl.org/rt3/Ticket/Display.html?id=47576
*/
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
if (SvTRUE(ERRSV))
@@ -721,37 +724,37 @@ plperl_trusted_init(void)
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
errcontext("while executing utf8fix")));
}
-
+
/*
* Lock down the interpreter
*/
-
+
/* switch to the safe require/dofile opcode for future code */
PL_ppaddr[OP_REQUIRE] = pp_require_safe;
- PL_ppaddr[OP_DOFILE] = pp_require_safe;
-
- /*
- * prevent (any more) unsafe opcodes being compiled
- * PL_op_mask is per interpreter, so this only needs to be set once
+ PL_ppaddr[OP_DOFILE] = pp_require_safe;
+
+ /*
+ * prevent (any more) unsafe opcodes being compiled PL_op_mask is per
+ * interpreter, so this only needs to be set once
*/
PL_op_mask = plperl_opmask;
-
+
/* delete the DynaLoader:: namespace so extensions can't be loaded */
stash = gv_stashpv("DynaLoader", GV_ADDWARN);
hv_iterinit(stash);
- while ((sv = hv_iternextsv(stash, &key, &klen)))
+ while ((sv = hv_iternextsv(stash, &key, &klen)))
{
if (!isGV_with_GP(sv) || !GvCV(sv))
continue;
SvREFCNT_dec(GvCV(sv)); /* free the CV */
- GvCV(sv) = NULL; /* prevent call via GV */
+ GvCV(sv) = NULL; /* prevent call via GV */
}
hv_clear(stash);
-
+
/* invalidate assorted caches */
++PL_sub_generation;
hv_clear(PL_stashcache);
-
+
/*
* Execute plperl.on_plperl_init in the locked-down interpreter
*/
@@ -762,7 +765,7 @@ plperl_trusted_init(void)
ereport(ERROR,
(errmsg("%s", strip_trailing_ws(SvPV_nolen(ERRSV))),
errcontext("while executing plperl.on_plperl_init")));
-
+
}
}
@@ -1316,11 +1319,11 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
if (!subref)
ereport(ERROR,
- (errmsg("didn't get a CODE reference from compiling function \"%s\"",
- prodesc->proname)));
-
+ (errmsg("didn't get a CODE reference from compiling function \"%s\"",
+ prodesc->proname)));
+
prodesc->reference = subref;
-
+
return;
}
@@ -3055,62 +3058,68 @@ plperl_inline_callback(void *arg)
static char *
setlocale_perl(int category, char *locale)
{
- char *RETVAL = setlocale(category, locale);
- if (RETVAL) {
+ char *RETVAL = setlocale(category, locale);
+
+ if (RETVAL)
+ {
#ifdef USE_LOCALE_CTYPE
- if (category == LC_CTYPE
+ if (category == LC_CTYPE
#ifdef LC_ALL
- || category == LC_ALL
+ || category == LC_ALL
#endif
- )
- {
- char *newctype;
+ )
+ {
+ char *newctype;
+
#ifdef LC_ALL
- if (category == LC_ALL)
- newctype = setlocale(LC_CTYPE, NULL);
- else
+ if (category == LC_ALL)
+ newctype = setlocale(LC_CTYPE, NULL);
+ else
#endif
- newctype = RETVAL;
- new_ctype(newctype);
- }
-#endif /* USE_LOCALE_CTYPE */
+ newctype = RETVAL;
+ new_ctype(newctype);
+ }
+#endif /* USE_LOCALE_CTYPE */
#ifdef USE_LOCALE_COLLATE
- if (category == LC_COLLATE
+ if (category == LC_COLLATE
#ifdef LC_ALL
- || category == LC_ALL
+ || category == LC_ALL
#endif
- )
- {
- char *newcoll;
+ )
+ {
+ char *newcoll;
+
#ifdef LC_ALL
- if (category == LC_ALL)
- newcoll = setlocale(LC_COLLATE, NULL);
- else
+ if (category == LC_ALL)
+ newcoll = setlocale(LC_COLLATE, NULL);
+ else
#endif
- newcoll = RETVAL;
- new_collate(newcoll);
- }
-#endif /* USE_LOCALE_COLLATE */
+ newcoll = RETVAL;
+ new_collate(newcoll);
+ }
+#endif /* USE_LOCALE_COLLATE */
#ifdef USE_LOCALE_NUMERIC
- if (category == LC_NUMERIC
+ if (category == LC_NUMERIC
#ifdef LC_ALL
- || category == LC_ALL
+ || category == LC_ALL
#endif
- )
- {
- char *newnum;
+ )
+ {
+ char *newnum;
+
#ifdef LC_ALL
- if (category == LC_ALL)
- newnum = setlocale(LC_NUMERIC, NULL);
- else
+ if (category == LC_ALL)
+ newnum = setlocale(LC_NUMERIC, NULL);
+ else
#endif
- newnum = RETVAL;
- new_numeric(newnum);
- }
-#endif /* USE_LOCALE_NUMERIC */
- }
+ newnum = RETVAL;
+ new_numeric(newnum);
+ }
+#endif /* USE_LOCALE_NUMERIC */
+ }
- return RETVAL;
+ return RETVAL;
}
+
#endif
generated by cgit v1.2.3 (git 2.25.1) at 2025-06-05 09:27:11 +0000