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  char *val,
54  *res;
55  STRLEN len;
56 
57  /*
58  * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
59  */
60 
61  /*
62  * SvPVutf8() croaks nastily on certain things, like typeglobs and
63  * readonly objects such as $^V. That's a perl bug - it's not supposed to
64  * happen. To avoid crashing the backend, we make a copy of the sv before
65  * passing it to SvPVutf8(). The copy is garbage collected when we're done
66  * with it.
67  */
68  if (SvREADONLY(sv) ||
69  isGV_with_GP(sv) ||
70  (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
71  sv = newSVsv(sv);
72  else
73  {
74  /*
75  * increase the reference count so we can just SvREFCNT_dec() it when
76  * we are done
77  */
79  }
80 
81  /*
82  * Request the string from Perl, in UTF-8 encoding; but if we're in a
83  * SQL_ASCII database, just request the byte soup without trying to make
84  * it UTF8, because that might fail.
85  */
87  val = SvPV(sv, len);
88  else
89  val = SvPVutf8(sv, len);
90 
91  /*
92  * Now convert to database encoding. We use perl's length in the event we
93  * had an embedded null byte to ensure we error out properly.
94  */
95  res = utf_u2e(val, len);
96 
97  /* safe now to garbage collect the new SV */
98  SvREFCNT_dec(sv);
99 
100  return res;
101 }
102 
103 /*
104  * Create a new SV from a string assumed to be in the current database's
105  * encoding.
106  */
107 static inline SV *
108 cstr2sv(const char *str)
109 {
110  SV *sv;
111  char *utf8_str;
112 
113  /* no conversion when SQL_ASCII */
115  return newSVpv(str, 0);
116 
117  utf8_str = utf_e2u(str);
118 
119  sv = newSVpv(utf8_str, 0);
120  SvUTF8_on(sv);
121  pfree(utf8_str);
122 
123  return sv;
124 }
125 
126 /*
127  * croak() with specified message, which is given in the database encoding.
128  *
129  * Ideally we'd just write croak("%s", str), but plain croak() does not play
130  * nice with non-ASCII data. In modern Perl versions we can call cstr2sv()
131  * and pass the result to croak_sv(); in versions that don't have croak_sv(),
132  * we have to work harder.
133  */
134 static inline void
135 croak_cstr(const char *str)
136 {
137 #ifdef croak_sv
138  /* Use sv_2mortal() to be sure the transient SV gets freed */
139  croak_sv(sv_2mortal(cstr2sv(str)));
140 #else
141 
142  /*
143  * The older way to do this is to assign a UTF8-marked value to ERRSV and
144  * then call croak(NULL). But if we leave it to croak() to append the
145  * error location, it does so too late (only after popping the stack) in
146  * some Perl versions. Hence, use mess() to create an SV with the error
147  * location info already appended.
148  */
149  SV *errsv = get_sv("@", GV_ADD);
150  char *utf8_str = utf_e2u(str);
151  SV *ssv;
152 
153  ssv = mess("%s", utf8_str);
154  SvUTF8_on(ssv);
155 
156  pfree(utf8_str);
157 
158  sv_setsv(errsv, ssv);
159 
160  croak(NULL);
161 #endif /* croak_sv */
162 }
163 
164 #endif /* PL_PERL_HELPERS_H */
char * pstrdup(const char *in)
Definition: mcxt.c:1077
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:950
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 NULL
Definition: c.h:229
#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)