mirror of
https://git.postgresql.org/git/postgresql.git
synced 2025-01-12 15:39:35 +08:00
pgindent run on plperl.c
This commit is contained in:
parent
c4d124365b
commit
f7b51d175a
@ -58,8 +58,8 @@ PG_MODULE_MAGIC;
|
|||||||
|
|
||||||
|
|
||||||
/**********************************************************************
|
/**********************************************************************
|
||||||
* Information associated with a Perl interpreter. We have one interpreter
|
* Information associated with a Perl interpreter. We have one interpreter
|
||||||
* that is used for all plperlu (untrusted) functions. For plperl (trusted)
|
* that is used for all plperlu (untrusted) functions. For plperl (trusted)
|
||||||
* functions, there is a separate interpreter for each effective SQL userid.
|
* functions, there is a separate interpreter for each effective SQL userid.
|
||||||
* (This is needed to ensure that an unprivileged user can't inject Perl code
|
* (This is needed to ensure that an unprivileged user can't inject Perl code
|
||||||
* that'll be executed with the privileges of some other SQL user.)
|
* that'll be executed with the privileges of some other SQL user.)
|
||||||
@ -83,9 +83,9 @@ PG_MODULE_MAGIC;
|
|||||||
**********************************************************************/
|
**********************************************************************/
|
||||||
typedef struct plperl_interp_desc
|
typedef struct plperl_interp_desc
|
||||||
{
|
{
|
||||||
Oid user_id; /* Hash key (must be first!) */
|
Oid user_id; /* Hash key (must be first!) */
|
||||||
PerlInterpreter *interp; /* The interpreter */
|
PerlInterpreter *interp; /* The interpreter */
|
||||||
HTAB *query_hash; /* plperl_query_entry structs */
|
HTAB *query_hash; /* plperl_query_entry structs */
|
||||||
} plperl_interp_desc;
|
} plperl_interp_desc;
|
||||||
|
|
||||||
|
|
||||||
@ -97,7 +97,7 @@ typedef struct plperl_proc_desc
|
|||||||
char *proname; /* user name of procedure */
|
char *proname; /* user name of procedure */
|
||||||
TransactionId fn_xmin;
|
TransactionId fn_xmin;
|
||||||
ItemPointerData fn_tid;
|
ItemPointerData fn_tid;
|
||||||
plperl_interp_desc *interp; /* interpreter it's created in */
|
plperl_interp_desc *interp; /* interpreter it's created in */
|
||||||
bool fn_readonly;
|
bool fn_readonly;
|
||||||
bool lanpltrusted;
|
bool lanpltrusted;
|
||||||
bool fn_retistuple; /* true, if function returns tuple */
|
bool fn_retistuple; /* true, if function returns tuple */
|
||||||
@ -127,18 +127,19 @@ typedef struct plperl_proc_desc
|
|||||||
**********************************************************************/
|
**********************************************************************/
|
||||||
typedef struct plperl_proc_key
|
typedef struct plperl_proc_key
|
||||||
{
|
{
|
||||||
Oid proc_id; /* Function OID */
|
Oid proc_id; /* Function OID */
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* is_trigger is really a bool, but declare as Oid to ensure this struct
|
* is_trigger is really a bool, but declare as Oid to ensure this struct
|
||||||
* contains no padding
|
* contains no padding
|
||||||
*/
|
*/
|
||||||
Oid is_trigger; /* is it a trigger function? */
|
Oid is_trigger; /* is it a trigger function? */
|
||||||
Oid user_id; /* User calling the function, or 0 */
|
Oid user_id; /* User calling the function, or 0 */
|
||||||
} plperl_proc_key;
|
} plperl_proc_key;
|
||||||
|
|
||||||
typedef struct plperl_proc_ptr
|
typedef struct plperl_proc_ptr
|
||||||
{
|
{
|
||||||
plperl_proc_key proc_key; /* Hash key (must be first!) */
|
plperl_proc_key proc_key; /* Hash key (must be first!) */
|
||||||
plperl_proc_desc *proc_ptr;
|
plperl_proc_desc *proc_ptr;
|
||||||
} plperl_proc_ptr;
|
} plperl_proc_ptr;
|
||||||
|
|
||||||
@ -184,6 +185,7 @@ typedef struct plperl_query_entry
|
|||||||
static HTAB *plperl_interp_hash = NULL;
|
static HTAB *plperl_interp_hash = NULL;
|
||||||
static HTAB *plperl_proc_hash = NULL;
|
static HTAB *plperl_proc_hash = NULL;
|
||||||
static plperl_interp_desc *plperl_active_interp = NULL;
|
static plperl_interp_desc *plperl_active_interp = NULL;
|
||||||
|
|
||||||
/* If we have an unassigned "held" interpreter, it's stored here */
|
/* If we have an unassigned "held" interpreter, it's stored here */
|
||||||
static PerlInterpreter *plperl_held_interp = NULL;
|
static PerlInterpreter *plperl_held_interp = NULL;
|
||||||
|
|
||||||
@ -227,7 +229,8 @@ static char *hek2cstr(HE *he);
|
|||||||
static SV **hv_store_string(HV *hv, const char *key, SV *val);
|
static SV **hv_store_string(HV *hv, const char *key, SV *val);
|
||||||
static SV **hv_fetch_string(HV *hv, const char *key);
|
static SV **hv_fetch_string(HV *hv, const char *key);
|
||||||
static void plperl_create_sub(plperl_proc_desc *desc, char *s, Oid fn_oid);
|
static void plperl_create_sub(plperl_proc_desc *desc, char *s, Oid fn_oid);
|
||||||
static SV *plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo);
|
static SV *plperl_call_perl_func(plperl_proc_desc *desc,
|
||||||
|
FunctionCallInfo fcinfo);
|
||||||
static void plperl_compile_callback(void *arg);
|
static void plperl_compile_callback(void *arg);
|
||||||
static void plperl_exec_callback(void *arg);
|
static void plperl_exec_callback(void *arg);
|
||||||
static void plperl_inline_callback(void *arg);
|
static void plperl_inline_callback(void *arg);
|
||||||
@ -245,31 +248,32 @@ static char *setlocale_perl(int category, char *locale);
|
|||||||
static char *
|
static char *
|
||||||
hek2cstr(HE *he)
|
hek2cstr(HE *he)
|
||||||
{
|
{
|
||||||
/*
|
/*-------------------------
|
||||||
* Unfortunately, while HeUTF8 is true for most things > 256, for
|
* Unfortunately, while HeUTF8 is true for most things > 256, for values
|
||||||
* values 128..255 it's not, but perl will treat them as
|
* 128..255 it's not, but perl will treat them as unicode code points if
|
||||||
* unicode code points if the utf8 flag is not set ( see
|
* the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
|
||||||
* The "Unicode Bug" in perldoc perlunicode for more)
|
* for more)
|
||||||
*
|
*
|
||||||
* So if we did the expected:
|
* So if we did the expected:
|
||||||
* if (HeUTF8(he))
|
* if (HeUTF8(he))
|
||||||
* utf_u2e(key...);
|
* utf_u2e(key...);
|
||||||
* else // must be ascii
|
* else // must be ascii
|
||||||
* return HePV(he);
|
* return HePV(he);
|
||||||
* we won't match columns with codepoints from 128..255
|
* we won't match columns with codepoints from 128..255
|
||||||
*
|
*
|
||||||
* For a more concrete example given a column with the
|
* For a more concrete example given a column with the name of the unicode
|
||||||
* name of the unicode codepoint U+00ae (registered sign)
|
* codepoint U+00ae (registered sign) and a UTF8 database and the perl
|
||||||
* and a UTF8 database and the perl return_next {
|
* return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
|
||||||
* "\N{U+00ae}=>'text } would always fail as heUTF8
|
* 0 and HePV() would give us a char * with 1 byte contains the decimal
|
||||||
* returns 0 and HePV() would give us a char * with 1 byte
|
* value 174
|
||||||
* contains the decimal value 174
|
|
||||||
*
|
*
|
||||||
* Perl has the brains to know when it should utf8 encode
|
* Perl has the brains to know when it should utf8 encode 174 properly, so
|
||||||
* 174 properly, so here we force it into an SV so that
|
* here we force it into an SV so that perl will figure it out and do the
|
||||||
* perl will figure it out and do the right thing
|
* right thing
|
||||||
|
*-------------------------
|
||||||
*/
|
*/
|
||||||
SV *sv = HeSVKEY_force(he);
|
SV *sv = HeSVKEY_force(he);
|
||||||
|
|
||||||
if (HeUTF8(he))
|
if (HeUTF8(he))
|
||||||
SvUTF8_on(sv);
|
SvUTF8_on(sv);
|
||||||
return sv2cstr(sv);
|
return sv2cstr(sv);
|
||||||
@ -547,6 +551,7 @@ select_perl_context(bool trusted)
|
|||||||
else
|
else
|
||||||
{
|
{
|
||||||
#ifdef MULTIPLICITY
|
#ifdef MULTIPLICITY
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* plperl_init_interp will change Perl's idea of the active
|
* plperl_init_interp will change Perl's idea of the active
|
||||||
* interpreter. Reset plperl_active_interp temporarily, so that if we
|
* interpreter. Reset plperl_active_interp temporarily, so that if we
|
||||||
@ -675,7 +680,7 @@ plperl_init_interp(void)
|
|||||||
STMT_START { \
|
STMT_START { \
|
||||||
if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
|
if (saved != NULL) { setlocale_perl(name, saved); pfree(saved); } \
|
||||||
} STMT_END
|
} STMT_END
|
||||||
#endif /* WIN32 */
|
#endif /* WIN32 */
|
||||||
|
|
||||||
if (plperl_on_init && *plperl_on_init)
|
if (plperl_on_init && *plperl_on_init)
|
||||||
{
|
{
|
||||||
@ -685,12 +690,12 @@ plperl_init_interp(void)
|
|||||||
|
|
||||||
/*
|
/*
|
||||||
* The perl API docs state that PERL_SYS_INIT3 should be called before
|
* The perl API docs state that PERL_SYS_INIT3 should be called before
|
||||||
* allocating interpreters. Unfortunately, on some platforms this fails
|
* allocating interpreters. Unfortunately, on some platforms this fails in
|
||||||
* in the Perl_do_taint() routine, which is called when the platform is
|
* the Perl_do_taint() routine, which is called when the platform is using
|
||||||
* using the system's malloc() instead of perl's own. Other platforms,
|
* the system's malloc() instead of perl's own. Other platforms, notably
|
||||||
* notably Windows, fail if PERL_SYS_INIT3 is not called. So we call it
|
* Windows, fail if PERL_SYS_INIT3 is not called. So we call it if it's
|
||||||
* if it's available, unless perl is using the system malloc(), which is
|
* available, unless perl is using the system malloc(), which is true when
|
||||||
* true when MYMALLOC is set.
|
* MYMALLOC is set.
|
||||||
*/
|
*/
|
||||||
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
|
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
|
||||||
{
|
{
|
||||||
@ -859,8 +864,8 @@ plperl_trusted_init(void)
|
|||||||
errcontext("while executing PLC_TRUSTED")));
|
errcontext("while executing PLC_TRUSTED")));
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Force loading of utf8 module now to prevent errors that can arise
|
* Force loading of utf8 module now to prevent errors that can arise from
|
||||||
* from the regex code later trying to load utf8 modules. See
|
* the regex code later trying to load utf8 modules. See
|
||||||
* http://rt.perl.org/rt3/Ticket/Display.html?id=47576
|
* http://rt.perl.org/rt3/Ticket/Display.html?id=47576
|
||||||
*/
|
*/
|
||||||
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
|
eval_pv("my $a=chr(0x100); return $a =~ /\\xa9/i", FALSE);
|
||||||
@ -956,7 +961,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
|
|||||||
{
|
{
|
||||||
TupleDesc td = attinmeta->tupdesc;
|
TupleDesc td = attinmeta->tupdesc;
|
||||||
char **values;
|
char **values;
|
||||||
HE *he;
|
HE *he;
|
||||||
HeapTuple tup;
|
HeapTuple tup;
|
||||||
int i;
|
int i;
|
||||||
|
|
||||||
@ -965,9 +970,9 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
|
|||||||
hv_iterinit(perlhash);
|
hv_iterinit(perlhash);
|
||||||
while ((he = hv_iternext(perlhash)))
|
while ((he = hv_iternext(perlhash)))
|
||||||
{
|
{
|
||||||
SV *val = HeVAL(he);
|
SV *val = HeVAL(he);
|
||||||
char *key = hek2cstr(he);
|
char *key = hek2cstr(he);
|
||||||
int attn = SPI_fnumber(td, key);
|
int attn = SPI_fnumber(td, key);
|
||||||
|
|
||||||
if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
|
if (attn <= 0 || td->attrs[attn - 1]->attisdropped)
|
||||||
ereport(ERROR,
|
ereport(ERROR,
|
||||||
@ -985,7 +990,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
|
|||||||
|
|
||||||
tup = BuildTupleFromCStrings(attinmeta, values);
|
tup = BuildTupleFromCStrings(attinmeta, values);
|
||||||
|
|
||||||
for(i = 0; i < td->natts; i++)
|
for (i = 0; i < td->natts; i++)
|
||||||
{
|
{
|
||||||
if (values[i])
|
if (values[i])
|
||||||
pfree(values[i]);
|
pfree(values[i]);
|
||||||
@ -1173,8 +1178,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
|
|||||||
Oid typioparam;
|
Oid typioparam;
|
||||||
int32 atttypmod;
|
int32 atttypmod;
|
||||||
FmgrInfo finfo;
|
FmgrInfo finfo;
|
||||||
SV *val = HeVAL(he);
|
SV *val = HeVAL(he);
|
||||||
char *key = hek2cstr(he);
|
char *key = hek2cstr(he);
|
||||||
int attn = SPI_fnumber(tupdesc, key);
|
int attn = SPI_fnumber(tupdesc, key);
|
||||||
|
|
||||||
if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped)
|
if (attn <= 0 || tupdesc->attrs[attn - 1]->attisdropped)
|
||||||
@ -1189,7 +1194,8 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
|
|||||||
atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
|
atttypmod = tupdesc->attrs[attn - 1]->atttypmod;
|
||||||
if (SvOK(val))
|
if (SvOK(val))
|
||||||
{
|
{
|
||||||
char *str = sv2cstr(val);
|
char *str = sv2cstr(val);
|
||||||
|
|
||||||
modvalues[slotsused] = InputFunctionCall(&finfo,
|
modvalues[slotsused] = InputFunctionCall(&finfo,
|
||||||
str,
|
str,
|
||||||
typioparam,
|
typioparam,
|
||||||
@ -1452,12 +1458,13 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
|
|||||||
EXTEND(SP, 4);
|
EXTEND(SP, 4);
|
||||||
PUSHs(sv_2mortal(cstr2sv(subname)));
|
PUSHs(sv_2mortal(cstr2sv(subname)));
|
||||||
PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
|
PUSHs(sv_2mortal(newRV_noinc((SV *) pragma_hv)));
|
||||||
/*
|
|
||||||
* Use 'false' for $prolog in mkfunc, which is kept for compatibility
|
/*
|
||||||
* in case a module such as PostgreSQL::PLPerl::NYTprof replaces
|
* Use 'false' for $prolog in mkfunc, which is kept for compatibility in
|
||||||
* the function compiler.
|
* case a module such as PostgreSQL::PLPerl::NYTprof replaces the function
|
||||||
|
* compiler.
|
||||||
*/
|
*/
|
||||||
PUSHs(&PL_sv_no);
|
PUSHs(&PL_sv_no);
|
||||||
PUSHs(sv_2mortal(cstr2sv(s)));
|
PUSHs(sv_2mortal(cstr2sv(s)));
|
||||||
PUTBACK;
|
PUTBACK;
|
||||||
|
|
||||||
@ -1609,15 +1616,17 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
|
|||||||
SV *td)
|
SV *td)
|
||||||
{
|
{
|
||||||
dSP;
|
dSP;
|
||||||
SV *retval, *TDsv;
|
SV *retval,
|
||||||
int i, count;
|
*TDsv;
|
||||||
|
int i,
|
||||||
|
count;
|
||||||
Trigger *tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
|
Trigger *tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
|
||||||
|
|
||||||
ENTER;
|
ENTER;
|
||||||
SAVETMPS;
|
SAVETMPS;
|
||||||
|
|
||||||
TDsv = get_sv("_TD", GV_ADD);
|
TDsv = get_sv("_TD", GV_ADD);
|
||||||
SAVESPTR(TDsv); /* local $_TD */
|
SAVESPTR(TDsv); /* local $_TD */
|
||||||
sv_setsv(TDsv, td);
|
sv_setsv(TDsv, td);
|
||||||
|
|
||||||
PUSHMARK(sp);
|
PUSHMARK(sp);
|
||||||
@ -1796,7 +1805,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
|
|||||||
else
|
else
|
||||||
{
|
{
|
||||||
/* Return a perl string converted to a Datum */
|
/* Return a perl string converted to a Datum */
|
||||||
char *str;
|
char *str;
|
||||||
|
|
||||||
if (prodesc->fn_retisarray && SvROK(perlret) &&
|
if (prodesc->fn_retisarray && SvROK(perlret) &&
|
||||||
SvTYPE(SvRV(perlret)) == SVt_PVAV)
|
SvTYPE(SvRV(perlret)) == SVt_PVAV)
|
||||||
@ -2500,7 +2509,7 @@ plperl_return_next(SV *sv)
|
|||||||
|
|
||||||
if (SvOK(sv))
|
if (SvOK(sv))
|
||||||
{
|
{
|
||||||
char *str;
|
char *str;
|
||||||
|
|
||||||
if (prodesc->fn_retisarray && SvROK(sv) &&
|
if (prodesc->fn_retisarray && SvROK(sv) &&
|
||||||
SvTYPE(SvRV(sv)) == SVt_PVAV)
|
SvTYPE(SvRV(sv)) == SVt_PVAV)
|
||||||
@ -2754,7 +2763,7 @@ plperl_spi_prepare(char *query, int argc, SV **argv)
|
|||||||
typInput,
|
typInput,
|
||||||
typIOParam;
|
typIOParam;
|
||||||
int32 typmod;
|
int32 typmod;
|
||||||
char *typstr;
|
char *typstr;
|
||||||
|
|
||||||
typstr = sv2cstr(argv[i]);
|
typstr = sv2cstr(argv[i]);
|
||||||
parseTypeString(typstr, &typId, &typmod);
|
parseTypeString(typstr, &typId, &typmod);
|
||||||
@ -2922,7 +2931,8 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
|
|||||||
{
|
{
|
||||||
if (SvOK(argv[i]))
|
if (SvOK(argv[i]))
|
||||||
{
|
{
|
||||||
char *str = sv2cstr(argv[i]);
|
char *str = sv2cstr(argv[i]);
|
||||||
|
|
||||||
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
|
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
|
||||||
str,
|
str,
|
||||||
qdesc->argtypioparams[i],
|
qdesc->argtypioparams[i],
|
||||||
@ -3057,7 +3067,8 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
|
|||||||
{
|
{
|
||||||
if (SvOK(argv[i]))
|
if (SvOK(argv[i]))
|
||||||
{
|
{
|
||||||
char *str = sv2cstr(argv[i]);
|
char *str = sv2cstr(argv[i]);
|
||||||
|
|
||||||
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
|
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
|
||||||
str,
|
str,
|
||||||
qdesc->argtypioparams[i],
|
qdesc->argtypioparams[i],
|
||||||
@ -3177,10 +3188,12 @@ static SV **
|
|||||||
hv_store_string(HV *hv, const char *key, SV *val)
|
hv_store_string(HV *hv, const char *key, SV *val)
|
||||||
{
|
{
|
||||||
int32 hlen;
|
int32 hlen;
|
||||||
char *hkey;
|
char *hkey;
|
||||||
SV **ret;
|
SV **ret;
|
||||||
|
|
||||||
hkey = (char*)pg_do_encoding_conversion((unsigned char *)key, strlen(key), GetDatabaseEncoding(), PG_UTF8);
|
hkey = (char *)
|
||||||
|
pg_do_encoding_conversion((unsigned char *) key, strlen(key),
|
||||||
|
GetDatabaseEncoding(), PG_UTF8);
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* This seems nowhere documented, but under Perl 5.8.0 and up, hv_store()
|
* This seems nowhere documented, but under Perl 5.8.0 and up, hv_store()
|
||||||
@ -3205,16 +3218,18 @@ static SV **
|
|||||||
hv_fetch_string(HV *hv, const char *key)
|
hv_fetch_string(HV *hv, const char *key)
|
||||||
{
|
{
|
||||||
int32 hlen;
|
int32 hlen;
|
||||||
char *hkey;
|
char *hkey;
|
||||||
SV **ret;
|
SV **ret;
|
||||||
|
|
||||||
hkey = (char*)pg_do_encoding_conversion((unsigned char *)key, strlen(key), GetDatabaseEncoding(), PG_UTF8);
|
hkey = (char *)
|
||||||
|
pg_do_encoding_conversion((unsigned char *) key, strlen(key),
|
||||||
|
GetDatabaseEncoding(), PG_UTF8);
|
||||||
|
|
||||||
/* See notes in hv_store_string */
|
/* See notes in hv_store_string */
|
||||||
hlen = -strlen(hkey);
|
hlen = -strlen(hkey);
|
||||||
ret = hv_fetch(hv, hkey, hlen, 0);
|
ret = hv_fetch(hv, hkey, hlen, 0);
|
||||||
|
|
||||||
if(hkey != key)
|
if (hkey != key)
|
||||||
pfree(hkey);
|
pfree(hkey);
|
||||||
|
|
||||||
return ret;
|
return ret;
|
||||||
|
Loading…
Reference in New Issue
Block a user