Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
Postgres FD Implementation
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Abuhujair Javed
Postgres FD Implementation
Commits
f7b51d17
Commit
f7b51d17
authored
Feb 17, 2011
by
Alvaro Herrera
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
pgindent run on plperl.c
parent
c4d12436
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
82 additions
and
67 deletions
+82
-67
src/pl/plperl/plperl.c
src/pl/plperl/plperl.c
+82
-67
No files found.
src/pl/plperl/plperl.c
View file @
f7b51d17
...
@@ -128,6 +128,7 @@ typedef struct plperl_proc_desc
...
@@ -128,6 +128,7 @@ 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
...
@@ -184,6 +185,7 @@ typedef struct plperl_query_entry
...
@@ -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);
...
@@ -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,11 +248,11 @@ static char *setlocale_perl(int category, char *locale);
...
@@ -245,11 +248,11 @@ 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 ( se
e
*
the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicod
e
*
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))
...
@@ -258,18 +261,19 @@ hek2cstr(HE *he)
...
@@ -258,18 +261,19 @@ hek2cstr(HE *he)
* 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)
...
@@ -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
...
@@ -685,12 +690,12 @@ plperl_init_interp(void)
...
@@ -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)
...
@@ -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
);
...
@@ -985,7 +990,7 @@ plperl_build_tuple_result(HV *perlhash, AttInMetadata *attinmeta)
...
@@ -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
]);
...
@@ -1190,6 +1195,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
...
@@ -1190,6 +1195,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
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,10 +1458,11 @@ plperl_create_sub(plperl_proc_desc *prodesc, char *s, Oid fn_oid)
...
@@ -1452,10 +1458,11 @@ 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
* Use 'false' for $prolog in mkfunc, which is kept for compatibility
in
*
in case a module such as PostgreSQL::PLPerl::NYTprof replaces
*
case a module such as PostgreSQL::PLPerl::NYTprof replaces the function
*
the function
compiler.
* compiler.
*/
*/
PUSHs
(
&
PL_sv_no
);
PUSHs
(
&
PL_sv_no
);
PUSHs
(
sv_2mortal
(
cstr2sv
(
s
)));
PUSHs
(
sv_2mortal
(
cstr2sv
(
s
)));
...
@@ -1609,8 +1616,10 @@ plperl_call_perl_trigger_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo,
...
@@ -1609,8 +1616,10 @@ 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
;
...
@@ -2923,6 +2932,7 @@ plperl_spi_exec_prepared(char *query, HV *attr, int argc, SV **argv)
...
@@ -2923,6 +2932,7 @@ 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
],
...
@@ -3058,6 +3068,7 @@ plperl_spi_query_prepared(char *query, int argc, SV **argv)
...
@@ -3058,6 +3068,7 @@ 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
],
...
@@ -3180,7 +3191,9 @@ hv_store_string(HV *hv, const char *key, SV *val)
...
@@ -3180,7 +3191,9 @@ hv_store_string(HV *hv, const char *key, SV *val)
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()
...
@@ -3208,13 +3221,15 @@ hv_fetch_string(HV *hv, const char *key)
...
@@ -3208,13 +3221,15 @@ hv_fetch_string(HV *hv, const char *key)
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
;
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment