open-dsi
/
postgres
mirror of https://github.com/postgres/postgres
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

pgindent run on plperl.c

Browse Source
pull/1/head
Alvaro Herrera 15 years ago
parent c4d124365b
commit f7b51d175a
1 changed files with 82 additions and 67 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 75
      src/pl/plperl/plperl.c

75
src/pl/plperl/plperl.c
Unescape 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);

Write Preview
Loading…
Cancel
Save