Line data Source code
1 : /*
2 : * This file was generated automatically by ExtUtils::ParseXS version 3.45 from the
3 : * contents of Util.xs. Do not edit this file, edit Util.xs instead.
4 : *
5 : * ANY CHANGES MADE HERE WILL BE LOST!
6 : *
7 : */
8 :
9 : #line 1 "Util.xs"
10 : /**********************************************************************
11 : * PostgreSQL::InServer::Util
12 : *
13 : * src/pl/plperl/Util.xs
14 : *
15 : * Defines plperl interfaces for general-purpose utilities.
16 : * This module is bootstrapped as soon as an interpreter is initialized.
17 : * Currently doesn't define a PACKAGE= so all subs are in main:: to avoid
18 : * the need for explicit importing.
19 : *
20 : **********************************************************************/
21 :
22 : /* this must be first: */
23 : #include "postgres.h"
24 :
25 : #include "fmgr.h"
26 : #include "utils/builtins.h"
27 : #include "utils/bytea.h" /* for byteain & byteaout */
28 : #include "varatt.h"
29 :
30 : /* perl stuff */
31 : #define PG_NEED_PERL_XSUB_H
32 : #include "plperl.h"
33 :
34 :
35 : static text *
36 : sv2text(SV *sv)
37 : {
38 : char *str = sv2cstr(sv);
39 : text *text;
40 :
41 : text = cstring_to_text(str);
42 : pfree(str);
43 : return text;
44 : }
45 :
46 : #line 47 "Util.c"
47 : #ifndef PERL_UNUSED_VAR
48 : # define PERL_UNUSED_VAR(var) if (0) var = var
49 : #endif
50 :
51 : #ifndef dVAR
52 : # define dVAR dNOOP
53 : #endif
54 :
55 :
56 : /* This stuff is not part of the API! You have been warned. */
57 : #ifndef PERL_VERSION_DECIMAL
58 : # define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
59 : #endif
60 : #ifndef PERL_DECIMAL_VERSION
61 : # define PERL_DECIMAL_VERSION \
62 : PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
63 : #endif
64 : #ifndef PERL_VERSION_GE
65 : # define PERL_VERSION_GE(r,v,s) \
66 : (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
67 : #endif
68 : #ifndef PERL_VERSION_LE
69 : # define PERL_VERSION_LE(r,v,s) \
70 : (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
71 : #endif
72 :
73 : /* XS_INTERNAL is the explicit static-linkage variant of the default
74 : * XS macro.
75 : *
76 : * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
77 : * "STATIC", ie. it exports XSUB symbols. You probably don't want that
78 : * for anything but the BOOT XSUB.
79 : *
80 : * See XSUB.h in core!
81 : */
82 :
83 :
84 : /* TODO: This might be compatible further back than 5.10.0. */
85 : #if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
86 : # undef XS_EXTERNAL
87 : # undef XS_INTERNAL
88 : # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
89 : # define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
90 : # define XS_INTERNAL(name) STATIC XSPROTO(name)
91 : # endif
92 : # if defined(__SYMBIAN32__)
93 : # define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
94 : # define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
95 : # endif
96 : # ifndef XS_EXTERNAL
97 : # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
98 : # define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
99 : # define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
100 : # else
101 : # ifdef __cplusplus
102 : # define XS_EXTERNAL(name) extern "C" XSPROTO(name)
103 : # define XS_INTERNAL(name) static XSPROTO(name)
104 : # else
105 : # define XS_EXTERNAL(name) XSPROTO(name)
106 : # define XS_INTERNAL(name) STATIC XSPROTO(name)
107 : # endif
108 : # endif
109 : # endif
110 : #endif
111 :
112 : /* perl >= 5.10.0 && perl <= 5.15.1 */
113 :
114 :
115 : /* The XS_EXTERNAL macro is used for functions that must not be static
116 : * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
117 : * macro defined, the best we can do is assume XS is the same.
118 : * Dito for XS_INTERNAL.
119 : */
120 : #ifndef XS_EXTERNAL
121 : # define XS_EXTERNAL(name) XS(name)
122 : #endif
123 : #ifndef XS_INTERNAL
124 : # define XS_INTERNAL(name) XS(name)
125 : #endif
126 :
127 : /* Now, finally, after all this mess, we want an ExtUtils::ParseXS
128 : * internal macro that we're free to redefine for varying linkage due
129 : * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
130 : * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
131 : */
132 :
133 : #undef XS_EUPXS
134 : #if defined(PERL_EUPXS_ALWAYS_EXPORT)
135 : # define XS_EUPXS(name) XS_EXTERNAL(name)
136 : #else
137 : /* default to internal */
138 : # define XS_EUPXS(name) XS_INTERNAL(name)
139 : #endif
140 :
141 : #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
142 : #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
143 :
144 : /* prototype to pass -Wmissing-prototypes */
145 : STATIC void
146 : S_croak_xs_usage(const CV *const cv, const char *const params);
147 :
148 : STATIC void
149 : S_croak_xs_usage(const CV *const cv, const char *const params)
150 : {
151 : const GV *const gv = CvGV(cv);
152 :
153 : PERL_ARGS_ASSERT_CROAK_XS_USAGE;
154 :
155 : if (gv) {
156 : const char *const gvname = GvNAME(gv);
157 : const HV *const stash = GvSTASH(gv);
158 : const char *const hvname = stash ? HvNAME(stash) : NULL;
159 :
160 : if (hvname)
161 : Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
162 : else
163 : Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
164 : } else {
165 : /* Pants. I don't think that it should be possible to get here. */
166 : Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
167 : }
168 : }
169 : #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
170 :
171 : #define croak_xs_usage S_croak_xs_usage
172 :
173 : #endif
174 :
175 : /* NOTE: the prototype of newXSproto() is different in versions of perls,
176 : * so we define a portable version of newXSproto()
177 : */
178 : #ifdef newXS_flags
179 : #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
180 : #else
181 : #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
182 : #endif /* !defined(newXS_flags) */
183 :
184 : #if PERL_VERSION_LE(5, 21, 5)
185 : # define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
186 : #else
187 : # define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
188 : #endif
189 :
190 : #line 191 "Util.c"
191 :
192 : XS_EUPXS(XS___aliased_constants); /* prototype to pass -Wmissing-prototypes */
193 372 : XS_EUPXS(XS___aliased_constants)
194 : {
195 372 : dVAR; dXSARGS;
196 372 : dXSI32;
197 372 : if (items != 0)
198 0 : croak_xs_usage(cv, "");
199 : {
200 : int RETVAL;
201 372 : dXSTARG;
202 : #line 53 "Util.xs"
203 : /* uses the ALIAS value as the return value */
204 : RETVAL = ix;
205 : #line 206 "Util.c"
206 372 : XSprePUSH;
207 372 : PUSHi((IV)RETVAL);
208 : }
209 372 : XSRETURN(1);
210 : }
211 :
212 :
213 : XS_EUPXS(XS__elog); /* prototype to pass -Wmissing-prototypes */
214 372 : XS_EUPXS(XS__elog)
215 : {
216 372 : dVAR; dXSARGS;
217 372 : if (items != 2)
218 0 : croak_xs_usage(cv, "level, msg");
219 : {
220 372 : int level = (int)SvIV(ST(0))
221 : ;
222 372 : SV * msg = ST(1)
223 : ;
224 : #line 64 "Util.xs"
225 : if (level > ERROR) /* no PANIC allowed thanks */
226 : level = ERROR;
227 : if (level < DEBUG5)
228 : level = DEBUG5;
229 : plperl_util_elog(level, msg);
230 : #line 231 "Util.c"
231 : }
232 370 : XSRETURN_EMPTY;
233 : }
234 :
235 :
236 : XS_EUPXS(XS__quote_literal); /* prototype to pass -Wmissing-prototypes */
237 14 : XS_EUPXS(XS__quote_literal)
238 : {
239 14 : dVAR; dXSARGS;
240 14 : if (items != 1)
241 0 : croak_xs_usage(cv, "sv");
242 : {
243 14 : SV * sv = ST(0)
244 : ;
245 : SV * RETVAL;
246 : #line 74 "Util.xs"
247 : if (!sv || !SvOK(sv)) {
248 : RETVAL = &PL_sv_undef;
249 : }
250 : else {
251 : text *arg = sv2text(sv);
252 : text *quoted = DatumGetTextPP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg)));
253 : char *str;
254 :
255 : pfree(arg);
256 : str = text_to_cstring(quoted);
257 : RETVAL = cstr2sv(str);
258 : pfree(str);
259 : }
260 : #line 261 "Util.c"
261 14 : RETVAL = sv_2mortal(RETVAL);
262 14 : ST(0) = RETVAL;
263 : }
264 14 : XSRETURN(1);
265 : }
266 :
267 :
268 : XS_EUPXS(XS__quote_nullable); /* prototype to pass -Wmissing-prototypes */
269 60 : XS_EUPXS(XS__quote_nullable)
270 : {
271 60 : dVAR; dXSARGS;
272 60 : if (items != 1)
273 0 : croak_xs_usage(cv, "sv");
274 : {
275 60 : SV * sv = ST(0)
276 : ;
277 : SV * RETVAL;
278 : #line 94 "Util.xs"
279 : if (!sv || !SvOK(sv))
280 : {
281 : RETVAL = cstr2sv("NULL");
282 : }
283 : else
284 : {
285 : text *arg = sv2text(sv);
286 : text *quoted = DatumGetTextPP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg)));
287 : char *str;
288 :
289 : pfree(arg);
290 : str = text_to_cstring(quoted);
291 : RETVAL = cstr2sv(str);
292 : pfree(str);
293 : }
294 : #line 295 "Util.c"
295 60 : RETVAL = sv_2mortal(RETVAL);
296 60 : ST(0) = RETVAL;
297 : }
298 60 : XSRETURN(1);
299 : }
300 :
301 :
302 : XS_EUPXS(XS__quote_ident); /* prototype to pass -Wmissing-prototypes */
303 16 : XS_EUPXS(XS__quote_ident)
304 : {
305 16 : dVAR; dXSARGS;
306 16 : if (items != 1)
307 0 : croak_xs_usage(cv, "sv");
308 : {
309 16 : SV * sv = ST(0)
310 : ;
311 : #line 116 "Util.xs"
312 : text *arg;
313 : text *quoted;
314 : char *str;
315 : #line 316 "Util.c"
316 : SV * RETVAL;
317 : #line 120 "Util.xs"
318 : arg = sv2text(sv);
319 : quoted = DatumGetTextPP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg)));
320 :
321 : pfree(arg);
322 : str = text_to_cstring(quoted);
323 : RETVAL = cstr2sv(str);
324 : pfree(str);
325 : #line 326 "Util.c"
326 16 : RETVAL = sv_2mortal(RETVAL);
327 16 : ST(0) = RETVAL;
328 : }
329 16 : XSRETURN(1);
330 : }
331 :
332 :
333 : XS_EUPXS(XS__decode_bytea); /* prototype to pass -Wmissing-prototypes */
334 8 : XS_EUPXS(XS__decode_bytea)
335 : {
336 8 : dVAR; dXSARGS;
337 8 : if (items != 1)
338 0 : croak_xs_usage(cv, "sv");
339 : {
340 8 : SV * sv = ST(0)
341 : ;
342 : #line 134 "Util.xs"
343 : char *arg;
344 : text *ret;
345 : #line 346 "Util.c"
346 : SV * RETVAL;
347 : #line 137 "Util.xs"
348 : arg = SvPVbyte_nolen(sv);
349 : ret = DatumGetTextPP(DirectFunctionCall1(byteain, PointerGetDatum(arg)));
350 : /* not cstr2sv because this is raw bytes not utf8'able */
351 : RETVAL = newSVpvn(VARDATA_ANY(ret), VARSIZE_ANY_EXHDR(ret));
352 : #line 353 "Util.c"
353 8 : RETVAL = sv_2mortal(RETVAL);
354 8 : ST(0) = RETVAL;
355 : }
356 8 : XSRETURN(1);
357 : }
358 :
359 :
360 : XS_EUPXS(XS__encode_bytea); /* prototype to pass -Wmissing-prototypes */
361 10 : XS_EUPXS(XS__encode_bytea)
362 : {
363 10 : dVAR; dXSARGS;
364 10 : if (items != 1)
365 0 : croak_xs_usage(cv, "sv");
366 : {
367 10 : SV * sv = ST(0)
368 : ;
369 : #line 148 "Util.xs"
370 : text *arg;
371 : char *ret;
372 : STRLEN len;
373 : #line 374 "Util.c"
374 : SV * RETVAL;
375 : #line 152 "Util.xs"
376 : /* not sv2text because this is raw bytes not utf8'able */
377 : ret = SvPVbyte(sv, len);
378 : arg = cstring_to_text_with_len(ret, len);
379 : ret = DatumGetCString(DirectFunctionCall1(byteaout, PointerGetDatum(arg)));
380 : RETVAL = cstr2sv(ret);
381 : #line 382 "Util.c"
382 10 : RETVAL = sv_2mortal(RETVAL);
383 10 : ST(0) = RETVAL;
384 : }
385 10 : XSRETURN(1);
386 : }
387 :
388 :
389 : XS_EUPXS(XS__looks_like_number); /* prototype to pass -Wmissing-prototypes */
390 22 : XS_EUPXS(XS__looks_like_number)
391 : {
392 22 : dVAR; dXSARGS;
393 22 : if (items != 1)
394 0 : croak_xs_usage(cv, "sv");
395 : {
396 22 : SV * sv = ST(0)
397 : ;
398 : SV * RETVAL;
399 : #line 164 "Util.xs"
400 : if (!SvOK(sv))
401 : RETVAL = &PL_sv_undef;
402 : else if ( looks_like_number(sv) )
403 : RETVAL = &PL_sv_yes;
404 : else
405 : RETVAL = &PL_sv_no;
406 : #line 407 "Util.c"
407 22 : RETVAL = sv_2mortal(RETVAL);
408 22 : ST(0) = RETVAL;
409 : }
410 22 : XSRETURN(1);
411 : }
412 :
413 :
414 : XS_EUPXS(XS__encode_typed_literal); /* prototype to pass -Wmissing-prototypes */
415 32 : XS_EUPXS(XS__encode_typed_literal)
416 : {
417 32 : dVAR; dXSARGS;
418 32 : if (items != 2)
419 0 : croak_xs_usage(cv, "sv, typname");
420 : {
421 32 : SV * sv = ST(0)
422 : ;
423 32 : char * typname = (char *)SvPV_nolen(ST(1))
424 : ;
425 : #line 178 "Util.xs"
426 : char *outstr;
427 : #line 428 "Util.c"
428 : SV * RETVAL;
429 : #line 180 "Util.xs"
430 : outstr = plperl_sv_to_literal(sv, typname);
431 : if (outstr == NULL)
432 : RETVAL = &PL_sv_undef;
433 : else
434 : RETVAL = cstr2sv(outstr);
435 : #line 436 "Util.c"
436 30 : RETVAL = sv_2mortal(RETVAL);
437 30 : ST(0) = RETVAL;
438 : }
439 30 : XSRETURN(1);
440 : }
441 :
442 : #ifdef __cplusplus
443 : extern "C"
444 : #endif
445 : XS_EXTERNAL(boot_PostgreSQL__InServer__Util); /* prototype to pass -Wmissing-prototypes */
446 48 : XS_EXTERNAL(boot_PostgreSQL__InServer__Util)
447 : {
448 : #if PERL_VERSION_LE(5, 21, 5)
449 : dVAR; dXSARGS;
450 : #else
451 48 : dVAR; dXSBOOTARGSAPIVERCHK;
452 : #endif
453 : #if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
454 : char* file = __FILE__;
455 : #else
456 48 : const char* file = __FILE__;
457 : #endif
458 :
459 : PERL_UNUSED_VAR(file);
460 :
461 : PERL_UNUSED_VAR(cv); /* -W */
462 : PERL_UNUSED_VAR(items); /* -W */
463 : #if PERL_VERSION_LE(5, 21, 5) && defined(XS_APIVERSION_BOOTCHECK)
464 : XS_APIVERSION_BOOTCHECK;
465 : #endif
466 :
467 48 : cv = newXSproto_portable("DEBUG", XS___aliased_constants, file, "");
468 48 : XSANY.any_i32 = DEBUG2;
469 48 : cv = newXSproto_portable("ERROR", XS___aliased_constants, file, "");
470 48 : XSANY.any_i32 = ERROR;
471 48 : cv = newXSproto_portable("INFO", XS___aliased_constants, file, "");
472 48 : XSANY.any_i32 = INFO;
473 48 : cv = newXSproto_portable("LOG", XS___aliased_constants, file, "");
474 48 : XSANY.any_i32 = LOG;
475 48 : cv = newXSproto_portable("NOTICE", XS___aliased_constants, file, "");
476 48 : XSANY.any_i32 = NOTICE;
477 48 : cv = newXSproto_portable("WARNING", XS___aliased_constants, file, "");
478 48 : XSANY.any_i32 = WARNING;
479 48 : cv = newXSproto_portable("_aliased_constants", XS___aliased_constants, file, "");
480 48 : XSANY.any_i32 = 0;
481 48 : (void)newXSproto_portable("elog", XS__elog, file, "$$");
482 48 : (void)newXSproto_portable("quote_literal", XS__quote_literal, file, "$");
483 48 : (void)newXSproto_portable("quote_nullable", XS__quote_nullable, file, "$");
484 48 : (void)newXSproto_portable("quote_ident", XS__quote_ident, file, "$");
485 48 : (void)newXSproto_portable("decode_bytea", XS__decode_bytea, file, "$");
486 48 : (void)newXSproto_portable("encode_bytea", XS__encode_bytea, file, "$");
487 48 : (void)newXSproto_portable("looks_like_number", XS__looks_like_number, file, "$");
488 48 : (void)newXSproto_portable("encode_typed_literal", XS__encode_typed_literal, file, "$$");
489 :
490 : /* Initialisation Section */
491 :
492 : #line 189 "Util.xs"
493 : items = 0; /* avoid 'unused variable' warning */
494 :
495 : #line 496 "Util.c"
496 :
497 : /* End of Initialisation Section */
498 :
499 : #if PERL_VERSION_LE(5, 21, 5)
500 : # if PERL_VERSION_GE(5, 9, 0)
501 : if (PL_unitcheckav)
502 : call_list(PL_scopestack_ix, PL_unitcheckav);
503 : # endif
504 : XSRETURN_YES;
505 : #else
506 48 : Perl_xs_boot_epilog(aTHX_ ax);
507 : #endif
508 48 : }
509 :
|
