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