mirror of https://github.com/postgres/postgres
Commit 121d2d3d70 included simd.h into pg_wchar.h. This caused a problem
on Windows, since Perl has "#define free" (referring to globals), which
breaks the Windows' header. To fix, move the static inline function
definitions from plperl_helpers.h, into plperl.h, where we already
document the necessary inclusion order. Since those functions were the
only reason for the existence of plperl_helpers.h, remove it.
First reported by Justin Pryzby
Diagnosis and review by Andres Freund, patch by myself per suggestion
from Tom Lane
Discussion: https://www.postgresql.org/message-id/20220826115546.GE2342%40telsasoft.com
pull/103/head
John Naylor
3 years ago
parent
52144b6fcd
commit
4eec2e03c3
@ -1,171 +0,0 @@ |
||||
#ifndef PL_PERL_HELPERS_H |
||||
#define PL_PERL_HELPERS_H |
||||
|
||||
#include "mb/pg_wchar.h" |
||||
|
||||
#include "plperl.h" |
||||
|
||||
|
||||
/*
|
||||
* convert from utf8 to database encoding |
||||
* |
||||
* Returns a palloc'ed copy of the original string |
||||
*/ |
||||
static inline char * |
||||
utf_u2e(char *utf8_str, size_t len) |
||||
{ |
||||
char *ret; |
||||
|
||||
ret = pg_any_to_server(utf8_str, len, PG_UTF8); |
||||
|
||||
/* ensure we have a copy even if no conversion happened */ |
||||
if (ret == utf8_str) |
||||
ret = pstrdup(ret); |
||||
|
||||
return ret; |
||||
} |
||||
|
||||
/*
|
||||
* convert from database encoding to utf8 |
||||
* |
||||
* Returns a palloc'ed copy of the original string |
||||
*/ |
||||
static inline char * |
||||
utf_e2u(const char *str) |
||||
{ |
||||
char *ret; |
||||
|
||||
ret = pg_server_to_any(str, strlen(str), PG_UTF8); |
||||
|
||||
/* ensure we have a copy even if no conversion happened */ |
||||
if (ret == str) |
||||
ret = pstrdup(ret); |
||||
|
||||
return ret; |
||||
} |
||||
|
||||
|
||||
/*
|
||||
* Convert an SV to a char * in the current database encoding |
||||
* |
||||
* Returns a palloc'ed copy of the original string |
||||
*/ |
||||
static inline char * |
||||
sv2cstr(SV *sv) |
||||
{ |
||||
dTHX; |
||||
char *val, |
||||
*res; |
||||
STRLEN len; |
||||
|
||||
/*
|
||||
* get a utf8 encoded char * out of perl. *note* it may not be valid utf8! |
||||
*/ |
||||
|
||||
/*
|
||||
* SvPVutf8() croaks nastily on certain things, like typeglobs and |
||||
* readonly objects such as $^V. That's a perl bug - it's not supposed to |
||||
* happen. To avoid crashing the backend, we make a copy of the sv before |
||||
* passing it to SvPVutf8(). The copy is garbage collected when we're done |
||||
* with it. |
||||
*/ |
||||
if (SvREADONLY(sv) || |
||||
isGV_with_GP(sv) || |
||||
(SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)) |
||||
sv = newSVsv(sv); |
||||
else |
||||
{ |
||||
/*
|
||||
* increase the reference count so we can just SvREFCNT_dec() it when |
||||
* we are done |
||||
*/ |
||||
SvREFCNT_inc_simple_void(sv); |
||||
} |
||||
|
||||
/*
|
||||
* Request the string from Perl, in UTF-8 encoding; but if we're in a |
||||
* SQL_ASCII database, just request the byte soup without trying to make |
||||
* it UTF8, because that might fail. |
||||
*/ |
||||
if (GetDatabaseEncoding() == PG_SQL_ASCII) |
||||
val = SvPV(sv, len); |
||||
else |
||||
val = SvPVutf8(sv, len); |
||||
|
||||
/*
|
||||
* Now convert to database encoding. We use perl's length in the event we |
||||
* had an embedded null byte to ensure we error out properly. |
||||
*/ |
||||
res = utf_u2e(val, len); |
||||
|
||||
/* safe now to garbage collect the new SV */ |
||||
SvREFCNT_dec(sv); |
||||
|
||||
return res; |
||||
} |
||||
|
||||
/*
|
||||
* Create a new SV from a string assumed to be in the current database's |
||||
* encoding. |
||||
*/ |
||||
static inline SV * |
||||
cstr2sv(const char *str) |
||||
{ |
||||
dTHX; |
||||
SV *sv; |
||||
char *utf8_str; |
||||
|
||||
/* no conversion when SQL_ASCII */ |
||||
if (GetDatabaseEncoding() == PG_SQL_ASCII) |
||||
return newSVpv(str, 0); |
||||
|
||||
utf8_str = utf_e2u(str); |
||||
|
||||
sv = newSVpv(utf8_str, 0); |
||||
SvUTF8_on(sv); |
||||
pfree(utf8_str); |
||||
|
||||
return sv; |
||||
} |
||||
|
||||
/*
|
||||
* croak() with specified message, which is given in the database encoding. |
||||
* |
||||
* Ideally we'd just write croak("%s", str), but plain croak() does not play |
||||
* nice with non-ASCII data. In modern Perl versions we can call cstr2sv() |
||||
* and pass the result to croak_sv(); in versions that don't have croak_sv(), |
||||
* we have to work harder. |
||||
*/ |
||||
static inline void |
||||
croak_cstr(const char *str) |
||||
{ |
||||
dTHX; |
||||
|
||||
#ifdef croak_sv |
||||
/* Use sv_2mortal() to be sure the transient SV gets freed */ |
||||
croak_sv(sv_2mortal(cstr2sv(str))); |
||||
#else |
||||
|
||||
/*
|
||||
* The older way to do this is to assign a UTF8-marked value to ERRSV and |
||||
* then call croak(NULL). But if we leave it to croak() to append the |
||||
* error location, it does so too late (only after popping the stack) in |
||||
* some Perl versions. Hence, use mess() to create an SV with the error |
||||
* location info already appended. |
||||
*/ |
||||
SV *errsv = get_sv("@", GV_ADD); |
||||
char *utf8_str = utf_e2u(str); |
||||
SV *ssv; |
||||
|
||||
ssv = mess("%s", utf8_str); |
||||
SvUTF8_on(ssv); |
||||
|
||||
pfree(utf8_str); |
||||
|
||||
sv_setsv(errsv, ssv); |
||||
|
||||
croak(NULL); |
||||
#endif /* croak_sv */ |
||||
} |
||||
|
||||
#endif /* PL_PERL_HELPERS_H */ |
||||
Loading…
Reference in new issue