mirror/postgresql
2
0
Fork 0
mirror of https://git.postgresql.org/git/postgresql.git synced 2025-01-12 15:39:35 +08:00
Code Issues Packages Projects Releases Wiki Activity

pgindent run on plperl.c

Browse Source
This commit is contained in:
Alvaro Herrera 2011-02-17 16:40:13 -03:00
parent c4d124365b
commit f7b51d175a
1 changed files with 82 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/pl/plperl/plperl.c
View File

@ -128,6 +128,7 @@ typedef struct plperl_proc_desc
typedef struct plperl_proc_key
{
Oid proc_id; /* Function OID */
/*
* is_trigger is really a bool, but declare as Oid to ensure this struct
* contains no padding
@ -184,6 +185,7 @@ typedef struct plperl_query_entry
static HTAB *plperl_interp_hash = NULL;
static HTAB *plperl_proc_hash = NULL;
static plperl_interp_desc *plperl_active_interp = NULL;
/* If we have an unassigned "held" interpreter, it's stored here */
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_fetch_string(HV *hv, const char *key);
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_exec_callback(void *arg);
static void plperl_inline_callback(void *arg);
@ -245,11 +248,11 @@ static char *setlocale_perl(int category, char *locale);
static char *
hek2cstr(HE *he)
{
/*
* Unfortunately, while HeUTF8 is true for most things > 256, for
* values 128..255 it's not, but perl will treat them as
* unicode code points if the utf8 flag is not set ( see
* The "Unicode Bug" in perldoc perlunicode for more)
/*-------------------------
* Unfortunately, while HeUTF8 is true for most things > 256, for values
* 128..255 it's not, but perl will treat them as unicode code points if
* the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
* for more)
*
* So if we did the expected:
* if (HeUTF8(he))
@ -258,18 +261,19 @@ hek2cstr(HE *he)
* return HePV(he);
* we won't match columns with codepoints from 128..255
*
* For a more concrete example given a column with the
* name of the unicode codepoint U+00ae (registered sign)
* and a UTF8 database and the perl return_next {
* "\N{U+00ae}=>'text } would always fail as heUTF8
* returns 0 and HePV() would give us a char * with 1 byte
* contains the decimal value 174
* For a more concrete example given a column with the name of the unicode
* codepoint U+00ae (registered sign) and a UTF8 database and the perl
* return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
* 0 and HePV() would give us a char * with 1 byte contains the decimal
* value 174
*
* Perl has the brains to know when it should utf8 encode
* 174 properly, so here we force it into an SV so that
* perl will figure it out and do the right thing
* Perl has the brains to know when it should utf8 encode 174 properly, so
* here we force it into an SV so that perl will figure it out and do the
* right thing
*-------------------------
*/
SV *sv = HeSVKEY_force(he);
if (HeUTF8(he))
SvUTF8_on(sv);
return sv2cstr(sv);
@ -547,6 +551,7 @@ select_perl_context(bool trusted)
else
{
#ifdef MULTIPLICITY
/*
* plperl_init_interp will change Perl's idea of the active
* interpreter. Reset plperl_active_interp temporarily, so that if we
@ -685,12 +690,12 @@ plperl_init_interp(void)
/*
* The perl API docs state that PERL_SYS_INIT3 should be called before
* allocating interpreters. Unfortunately, on some platforms this fails
* in the Perl_do_taint() routine, which is called when the platform is
* using the system's malloc() instead of perl's own. Other platforms,
* notably Windows, fail if PERL_SYS_INIT3 is not called. So we call it
* if it's available, unless perl is using the system malloc(), which is
* true when MYMALLOC is set.
* allocating interpreters. Unfortunately, on some platforms this fails in
* the Perl_do_taint() routine, which is called when the platform is using
* the system's malloc() instead of perl's own. Other platforms, notably
* Windows, fail if PERL_SYS_INIT3 is not called. So we call it if it's
* available, unless perl is using the system malloc(), which is true when
* MYMALLOC is set.
*/
#if defined(PERL_SYS_INIT3) && !defined(MYMALLOC)
{
@ -859,8 +864,8 @@ plperl_trusted_init(void)
errcontext("while executing PLC_TRUSTED")));
/*
* Force loading of utf8 module now to prevent errors that can arise
* from the regex code later trying to load utf8 modules. See
* 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);
@ -1190,6 +1195,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
if (SvOK(val))
{
char *str = sv2cstr(val);
modvalues[slotsused] = InputFunctionCall(&finfo,
str,
typioparam,
@ -1452,10 +1458,11 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
EXTEND(SP, 4);
PUSHs(sv_2mortal(cstr2sv(subname)));
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
* the function compiler.
* Use 'false' for $prolog in mkfunc, which is kept for compatibility in
* case a module such as PostgreSQL::PLPerl::NYTprof replaces the function
* compiler.
*/
PUSHs(&PL_sv_no);
PUSHs(sv_2mortal(cstr2sv(s)));
@ -1609,8 +1616,10 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
SV *td)
{
dSP;
SV *retval, *TDsv;
int i, count;
SV *retval,
*TDsv;
int i,
count;
Trigger *tg_trigger = ((TriggerData *) fcinfo->context)->tg_trigger;
ENTER;
@ -2923,6 +2932,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
if (SvOK(argv[i]))
{
char *str = sv2cstr(argv[i]);
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
str,
qdesc->argtypioparams[i],
@ -3058,6 +3068,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
if (SvOK(argv[i]))
{
char *str = sv2cstr(argv[i]);
argvalues[i] = InputFunctionCall(&qdesc->arginfuncs[i],
str,
qdesc->argtypioparams[i],
@ -3180,7 +3191,9 @@ hv_store_string(HV *hv, const char *key, SV *val)
char *hkey;
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()
@ -3208,7 +3221,9 @@ hv_fetch_string(HV *hv, const char *key)
char *hkey;
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 */
hlen = -strlen(hkey);