PostgreSQL Source Code  git master
plperl.h
Go to the documentation of this file.
1 /*-------------------------------------------------------------------------
2  *
3  * plperl.h
4  * Common include file for PL/Perl files
5  *
6  * This should be included _AFTER_ postgres.h and system include files, as
7  * well as headers that could in turn include system headers.
8  *
9  * Portions Copyright (c) 1996-2024, PostgreSQL Global Development Group
10  * Portions Copyright (c) 1995, Regents of the University of California
11  *
12  * src/pl/plperl/plperl.h
13  */
14 
15 #ifndef PL_PERL_H
16 #define PL_PERL_H
17 
18 /* defines free() by way of system headers, so must be included before perl.h */
19 #include "mb/pg_wchar.h"
20 
21 /*
22  * Pull in Perl headers via a wrapper header, to control the scope of
23  * the system_header pragma therein.
24  */
25 #include "plperl_system.h"
26 
27 /* declare routines from plperl.c for access by .xs files */
28 HV *plperl_spi_exec(char *, int);
29 void plperl_return_next(SV *);
30 SV *plperl_spi_query(char *);
31 SV *plperl_spi_fetchrow(char *);
32 SV *plperl_spi_prepare(char *, int, SV **);
33 HV *plperl_spi_exec_prepared(char *, HV *, int, SV **);
34 SV *plperl_spi_query_prepared(char *, int, SV **);
35 void plperl_spi_freeplan(char *);
36 void plperl_spi_cursor_close(char *);
37 void plperl_spi_commit(void);
38 void plperl_spi_rollback(void);
39 char *plperl_sv_to_literal(SV *, char *);
40 void plperl_util_elog(int level, SV *msg);
41 
42 
43 /* helper functions */
44 
45 /*
46  * convert from utf8 to database encoding
47  *
48  * Returns a palloc'ed copy of the original string
49  */
50 static inline char *
51 utf_u2e(char *utf8_str, size_t len)
52 {
53  char *ret;
54 
55  ret = pg_any_to_server(utf8_str, len, PG_UTF8);
56 
57  /* ensure we have a copy even if no conversion happened */
58  if (ret == utf8_str)
59  ret = pstrdup(ret);
60 
61  return ret;
62 }
63 
64 /*
65  * convert from database encoding to utf8
66  *
67  * Returns a palloc'ed copy of the original string
68  */
69 static inline char *
70 utf_e2u(const char *str)
71 {
72  char *ret;
73 
74  ret = pg_server_to_any(str, strlen(str), PG_UTF8);
75 
76  /* ensure we have a copy even if no conversion happened */
77  if (ret == str)
78  ret = pstrdup(ret);
79 
80  return ret;
81 }
82 
83 /*
84  * Convert an SV to a char * in the current database encoding
85  *
86  * Returns a palloc'ed copy of the original string
87  */
88 static inline char *
89 sv2cstr(SV *sv)
90 {
91  dTHX;
92  char *val,
93  *res;
94  STRLEN len;
95 
96  /*
97  * get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
98  */
99 
100  /*
101  * SvPVutf8() croaks nastily on certain things, like typeglobs and
102  * readonly objects such as $^V. That's a perl bug - it's not supposed to
103  * happen. To avoid crashing the backend, we make a copy of the sv before
104  * passing it to SvPVutf8(). The copy is garbage collected when we're done
105  * with it.
106  */
107  if (SvREADONLY(sv) ||
108  isGV_with_GP(sv) ||
109  (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
110  sv = newSVsv(sv);
111  else
112  {
113  /*
114  * increase the reference count so we can just SvREFCNT_dec() it when
115  * we are done
116  */
118  }
119 
120  /*
121  * Request the string from Perl, in UTF-8 encoding; but if we're in a
122  * SQL_ASCII database, just request the byte soup without trying to make
123  * it UTF8, because that might fail.
124  */
126  val = SvPV(sv, len);
127  else
128  val = SvPVutf8(sv, len);
129 
130  /*
131  * Now convert to database encoding. We use perl's length in the event we
132  * had an embedded null byte to ensure we error out properly.
133  */
134  res = utf_u2e(val, len);
135 
136  /* safe now to garbage collect the new SV */
137  SvREFCNT_dec(sv);
138 
139  return res;
140 }
141 
142 /*
143  * Create a new SV from a string assumed to be in the current database's
144  * encoding.
145  */
146 static inline SV *
147 cstr2sv(const char *str)
148 {
149  dTHX;
150  SV *sv;
151  char *utf8_str;
152 
153  /* no conversion when SQL_ASCII */
155  return newSVpv(str, 0);
156 
157  utf8_str = utf_e2u(str);
158 
159  sv = newSVpv(utf8_str, 0);
160  SvUTF8_on(sv);
161  pfree(utf8_str);
162 
163  return sv;
164 }
165 
166 /*
167  * croak() with specified message, which is given in the database encoding.
168  *
169  * Ideally we'd just write croak("%s", str), but plain croak() does not play
170  * nice with non-ASCII data. In modern Perl versions we can call cstr2sv()
171  * and pass the result to croak_sv(); in versions that don't have croak_sv(),
172  * we have to work harder.
173  */
174 static inline void
175 croak_cstr(const char *str)
176 {
177  dTHX;
178 
179 #ifdef croak_sv
180  /* Use sv_2mortal() to be sure the transient SV gets freed */
181  croak_sv(sv_2mortal(cstr2sv(str)));
182 #else
183 
184  /*
185  * The older way to do this is to assign a UTF8-marked value to ERRSV and
186  * then call croak(NULL). But if we leave it to croak() to append the
187  * error location, it does so too late (only after popping the stack) in
188  * some Perl versions. Hence, use mess() to create an SV with the error
189  * location info already appended.
190  */
191  SV *errsv = get_sv("@", GV_ADD);
192  char *utf8_str = utf_e2u(str);
193  SV *ssv;
194 
195  ssv = mess("%s", utf8_str);
196  SvUTF8_on(ssv);
197 
198  pfree(utf8_str);
199 
200  sv_setsv(errsv, ssv);
201 
202  croak(NULL);
203 #endif /* croak_sv */
204 }
205 
206 #endif /* PL_PERL_H */
long val
Definition: informix.c:664
char * pg_any_to_server(const char *s, int len, int encoding)
Definition: mbutils.c:677
int GetDatabaseEncoding(void)
Definition: mbutils.c:1262
char * pg_server_to_any(const char *s, int len, int encoding)
Definition: mbutils.c:750
char * pstrdup(const char *in)
Definition: mcxt.c:1580
void pfree(void *pointer)
Definition: mcxt.c:1405
const void size_t len
@ PG_SQL_ASCII
Definition: pg_wchar.h:226
@ PG_UTF8
Definition: pg_wchar.h:232
void plperl_return_next(SV *)
Definition: plperl.c:3245
HV * plperl_spi_exec(char *, int)
Definition: plperl.c:3133
void plperl_spi_cursor_close(char *)
Definition: plperl.c:3551
char * plperl_sv_to_literal(SV *, char *)
Definition: plperl.c:1444
void plperl_spi_rollback(void)
Definition: plperl.c:4017
SV * plperl_spi_query(char *)
Definition: plperl.c:3404
SV * plperl_spi_prepare(char *, int, SV **)
Definition: plperl.c:3567
SV * plperl_spi_query_prepared(char *, int, SV **)
Definition: plperl.c:3842
static SV * cstr2sv(const char *str)
Definition: plperl.h:147
HV * plperl_spi_exec_prepared(char *, HV *, int, SV **)
Definition: plperl.c:3715
static void croak_cstr(const char *str)
Definition: plperl.h:175
static char * utf_e2u(const char *str)
Definition: plperl.h:70
SV * plperl_spi_fetchrow(char *)
Definition: plperl.c:3476
static char * utf_u2e(char *utf8_str, size_t len)
Definition: plperl.h:51
static char * sv2cstr(SV *sv)
Definition: plperl.h:89
void plperl_util_elog(int level, SV *msg)
Definition: plperl.c:4054
void plperl_spi_commit(void)
Definition: plperl.c:3991
void plperl_spi_freeplan(char *)
Definition: plperl.c:3960
#define get_sv
Definition: ppport.h:12463
#define dTHX
Definition: ppport.h:11306
#define SvREFCNT_inc_simple_void(sv)
Definition: ppport.h:15412
#define isGV_with_GP(gv)
Definition: ppport.h:15703
#define croak_sv(sv)
Definition: ppport.h:14714