PostgreSQL Source Code  git master
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros
plperl_helpers.h
Go to the documentation of this file.
1 #ifndef PL_PERL_HELPERS_H
2 #define PL_PERL_HELPERS_H
3 
4 #include "mb/pg_wchar.h"
5 
6 /*
7  * convert from utf8 to database encoding
8  *
9  * Returns a palloc'ed copy of the original string
10  */
11 static inline char *
12 utf_u2e(char *utf8_str, size_t len)
13 {
14  char *ret;
15 
16  ret = pg_any_to_server(utf8_str, len, PG_UTF8);
17 
18  /* ensure we have a copy even if no conversion happened */
19  if (ret == utf8_str)
20  ret = pstrdup(ret);
21 
22  return ret;
23 }
24 
25 /*
26  * convert from database encoding to utf8
27  *
28  * Returns a palloc'ed copy of the original string
29  */
30 static inline char *
31 utf_e2u(const char *str)
32 {
33  char *ret;
34 
35  ret = pg_server_to_any(str, strlen(str), PG_UTF8);
36 
37  /* ensure we have a copy even if no conversion happened */
38  if (ret == str)
39  ret = pstrdup(ret);
40 
41  return ret;
42 }
43 
44 
45 /*
46  * Convert an SV to a char * in the current database encoding
47  *
48  * Returns a palloc'ed copy of the original string
49  */
50 static inline char *
51 sv2cstr(SV *sv)
52 {
53  dTHX;
54  char *val,
55  *res;
56  STRLEN len;
57 
58  /*
59  * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
60  */
61 
62  /*
63  * SvPVutf8() croaks nastily on certain things, like typeglobs and
64  * readonly objects such as $^V. That's a perl bug - it's not supposed to
65  * happen. To avoid crashing the backend, we make a copy of the sv before
66  * passing it to SvPVutf8(). The copy is garbage collected when we're done
67  * with it.
68  */
69  if (SvREADONLY(sv) ||
70  isGV_with_GP(sv) ||
71  (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
72  sv = newSVsv(sv);
73  else
74  {
75  /*
76  * increase the reference count so we can just SvREFCNT_dec() it when
77  * we are done
78  */
80  }
81 
82  /*
83  * Request the string from Perl, in UTF-8 encoding; but if we're in a
84  * SQL_ASCII database, just request the byte soup without trying to make
85  * it UTF8, because that might fail.
86  */
88  val = SvPV(sv, len);
89  else
90  val = SvPVutf8(sv, len);
91 
92  /*
93  * Now convert to database encoding. We use perl's length in the event we
94  * had an embedded null byte to ensure we error out properly.
95  */
96  res = utf_u2e(val, len);
97 
98  /* safe now to garbage collect the new SV */
99  SvREFCNT_dec(sv);
100 
101  return res;
102 }
103 
104 /*
105  * Create a new SV from a string assumed to be in the current database's
106  * encoding.
107  */
108 static inline SV *
109 cstr2sv(const char *str)
110 {
111  dTHX;
112  SV *sv;
113  char *utf8_str;
114 
115  /* no conversion when SQL_ASCII */
117  return newSVpv(str, 0);
118 
119  utf8_str = utf_e2u(str);
120 
121  sv = newSVpv(utf8_str, 0);
122  SvUTF8_on(sv);
123  pfree(utf8_str);
124 
125  return sv;
126 }
127 
128 /*
129  * croak() with specified message, which is given in the database encoding.
130  *
131  * Ideally we'd just write croak("%s", str), but plain croak() does not play
132  * nice with non-ASCII data. In modern Perl versions we can call cstr2sv()
133  * and pass the result to croak_sv(); in versions that don't have croak_sv(),
134  * we have to work harder.
135  */
136 static inline void
137 croak_cstr(const char *str)
138 {
139  dTHX;
140 
141 #ifdef croak_sv
142  /* Use sv_2mortal() to be sure the transient SV gets freed */
143  croak_sv(sv_2mortal(cstr2sv(str)));
144 #else
145 
146  /*
147  * The older way to do this is to assign a UTF8-marked value to ERRSV and
148  * then call croak(NULL). But if we leave it to croak() to append the
149  * error location, it does so too late (only after popping the stack) in
150  * some Perl versions. Hence, use mess() to create an SV with the error
151  * location info already appended.
152  */
153  SV *errsv = get_sv("@", GV_ADD);
154  char *utf8_str = utf_e2u(str);
155  SV *ssv;
156 
157  ssv = mess("%s", utf8_str);
158  SvUTF8_on(ssv);
159 
160  pfree(utf8_str);
161 
162  sv_setsv(errsv, ssv);
163 
164  croak(NULL);
165 #endif /* croak_sv */
166 }
167 
168 #endif /* PL_PERL_HELPERS_H */
#define dTHX
Definition: ppport.h:3208
char * pstrdup(const char *in)
Definition: mcxt.c:1076
static char * utf_u2e(char *utf8_str, size_t len)
char * pg_server_to_any(const char *s, int len, int encoding)
Definition: mbutils.c:645
void pfree(void *pointer)
Definition: mcxt.c:949
static char * utf_e2u(const char *str)
#define SvREFCNT_inc_simple_void(sv)
Definition: ppport.h:4725
int GetDatabaseEncoding(void)
Definition: mbutils.c:1015
static void croak_cstr(const char *str)
static SV * cstr2sv(const char *str)
#define get_sv
Definition: ppport.h:3878
char * pg_any_to_server(const char *s, int len, int encoding)
Definition: mbutils.c:572
long val
Definition: informix.c:689
#define isGV_with_GP(gv)
Definition: ppport.h:5367
static char * sv2cstr(SV *sv)