Line data Source code
1 : /*
2 : * This file was generated automatically by ExtUtils::ParseXS version 3.40 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 368 : XS_EUPXS(XS___aliased_constants)
194 : {
195 368 : dVAR; dXSARGS;
196 368 : dXSI32;
197 368 : if (items != 0)
198 0 : croak_xs_usage(cv, "");
199 : {
200 : int RETVAL;
201 368 : dXSTARG;
202 : #line 53 "Util.xs"
203 : /* uses the ALIAS value as the return value */
204 : RETVAL = ix;
205 : #line 206 "Util.c"
206 368 : XSprePUSH; PUSHi((IV)RETVAL);
207 : }
208 368 : XSRETURN(1);
209 : }
210 :
211 :
212 : XS_EUPXS(XS__elog); /* prototype to pass -Wmissing-prototypes */
213 368 : XS_EUPXS(XS__elog)
214 : {
215 368 : dVAR; dXSARGS;
216 368 : if (items != 2)
217 0 : croak_xs_usage(cv, "level, msg");
218 : {
219 368 : int level = (int)SvIV(ST(0))
220 : ;
221 368 : SV * msg = ST(1)
222 : ;
223 : #line 64 "Util.xs"
224 : if (level > ERROR) /* no PANIC allowed thanks */
225 : level = ERROR;
226 : if (level < DEBUG5)
227 : level = DEBUG5;
228 : plperl_util_elog(level, msg);
229 : #line 230 "Util.c"
230 : }
231 366 : XSRETURN_EMPTY;
232 : }
233 :
234 :
235 : XS_EUPXS(XS__quote_literal); /* prototype to pass -Wmissing-prototypes */
236 14 : XS_EUPXS(XS__quote_literal)
237 : {
238 14 : dVAR; dXSARGS;
239 14 : if (items != 1)
240 0 : croak_xs_usage(cv, "sv");
241 : {
242 14 : SV * sv = ST(0)
243 : ;
244 : SV * RETVAL;
245 : #line 74 "Util.xs"
246 : if (!sv || !SvOK(sv)) {
247 : RETVAL = &PL_sv_undef;
248 : }
249 : else {
250 : text *arg = sv2text(sv);
251 : text *quoted = DatumGetTextPP(DirectFunctionCall1(quote_literal, PointerGetDatum(arg)));
252 : char *str;
253 :
254 : pfree(arg);
255 : str = text_to_cstring(quoted);
256 : RETVAL = cstr2sv(str);
257 : pfree(str);
258 : }
259 : #line 260 "Util.c"
260 14 : RETVAL = sv_2mortal(RETVAL);
261 14 : ST(0) = RETVAL;
262 : }
263 14 : XSRETURN(1);
264 : }
265 :
266 :
267 : XS_EUPXS(XS__quote_nullable); /* prototype to pass -Wmissing-prototypes */
268 60 : XS_EUPXS(XS__quote_nullable)
269 : {
270 60 : dVAR; dXSARGS;
271 60 : if (items != 1)
272 0 : croak_xs_usage(cv, "sv");
273 : {
274 60 : SV * sv = ST(0)
275 : ;
276 : SV * RETVAL;
277 : #line 94 "Util.xs"
278 : if (!sv || !SvOK(sv))
279 : {
280 : RETVAL = cstr2sv("NULL");
281 : }
282 : else
283 : {
284 : text *arg = sv2text(sv);
285 : text *quoted = DatumGetTextPP(DirectFunctionCall1(quote_nullable, PointerGetDatum(arg)));
286 : char *str;
287 :
288 : pfree(arg);
289 : str = text_to_cstring(quoted);
290 : RETVAL = cstr2sv(str);
291 : pfree(str);
292 : }
293 : #line 294 "Util.c"
294 60 : RETVAL = sv_2mortal(RETVAL);
295 60 : ST(0) = RETVAL;
296 : }
297 60 : XSRETURN(1);
298 : }
299 :
300 :
301 : XS_EUPXS(XS__quote_ident); /* prototype to pass -Wmissing-prototypes */
302 16 : XS_EUPXS(XS__quote_ident)
303 : {
304 16 : dVAR; dXSARGS;
305 16 : if (items != 1)
306 0 : croak_xs_usage(cv, "sv");
307 : {
308 16 : SV * sv = ST(0)
309 : ;
310 : #line 116 "Util.xs"
311 : text *arg;
312 : text *quoted;
313 : char *str;
314 : #line 315 "Util.c"
315 : SV * RETVAL;
316 : #line 120 "Util.xs"
317 : arg = sv2text(sv);
318 : quoted = DatumGetTextPP(DirectFunctionCall1(quote_ident, PointerGetDatum(arg)));
319 :
320 : pfree(arg);
321 : str = text_to_cstring(quoted);
322 : RETVAL = cstr2sv(str);
323 : pfree(str);
324 : #line 325 "Util.c"
325 16 : RETVAL = sv_2mortal(RETVAL);
326 16 : ST(0) = RETVAL;
327 : }
328 16 : XSRETURN(1);
329 : }
330 :
331 :
332 : XS_EUPXS(XS__decode_bytea); /* prototype to pass -Wmissing-prototypes */
333 8 : XS_EUPXS(XS__decode_bytea)
334 : {
335 8 : dVAR; dXSARGS;
336 8 : if (items != 1)
337 0 : croak_xs_usage(cv, "sv");
338 : {
339 8 : SV * sv = ST(0)
340 : ;
341 : #line 134 "Util.xs"
342 : char *arg;
343 : text *ret;
344 : #line 345 "Util.c"
345 : SV * RETVAL;
346 : #line 137 "Util.xs"
347 : arg = SvPVbyte_nolen(sv);
348 : ret = DatumGetTextPP(DirectFunctionCall1(byteain, PointerGetDatum(arg)));
349 : /* not cstr2sv because this is raw bytes not utf8'able */
350 : RETVAL = newSVpvn(VARDATA_ANY(ret), VARSIZE_ANY_EXHDR(ret));
351 : #line 352 "Util.c"
352 8 : RETVAL = sv_2mortal(RETVAL);
353 8 : ST(0) = RETVAL;
354 : }
355 8 : XSRETURN(1);
356 : }
357 :
358 :
359 : XS_EUPXS(XS__encode_bytea); /* prototype to pass -Wmissing-prototypes */
360 10 : XS_EUPXS(XS__encode_bytea)
361 : {
362 10 : dVAR; dXSARGS;
363 10 : if (items != 1)
364 0 : croak_xs_usage(cv, "sv");
365 : {
366 10 : SV * sv = ST(0)
367 : ;
368 : #line 148 "Util.xs"
369 : text *arg;
370 : char *ret;
371 : STRLEN len;
372 : #line 373 "Util.c"
373 : SV * RETVAL;
374 : #line 152 "Util.xs"
375 : /* not sv2text because this is raw bytes not utf8'able */
376 : ret = SvPVbyte(sv, len);
377 : arg = cstring_to_text_with_len(ret, len);
378 : ret = DatumGetCString(DirectFunctionCall1(byteaout, PointerGetDatum(arg)));
379 : RETVAL = cstr2sv(ret);
380 : #line 381 "Util.c"
381 10 : RETVAL = sv_2mortal(RETVAL);
382 10 : ST(0) = RETVAL;
383 : }
384 10 : XSRETURN(1);
385 : }
386 :
387 :
388 : XS_EUPXS(XS__looks_like_number); /* prototype to pass -Wmissing-prototypes */
389 22 : XS_EUPXS(XS__looks_like_number)
390 : {
391 22 : dVAR; dXSARGS;
392 22 : if (items != 1)
393 0 : croak_xs_usage(cv, "sv");
394 : {
395 22 : SV * sv = ST(0)
396 : ;
397 : SV * RETVAL;
398 : #line 164 "Util.xs"
399 : if (!SvOK(sv))
400 : RETVAL = &PL_sv_undef;
401 : else if ( looks_like_number(sv) )
402 : RETVAL = &PL_sv_yes;
403 : else
404 : RETVAL = &PL_sv_no;
405 : #line 406 "Util.c"
406 22 : RETVAL = sv_2mortal(RETVAL);
407 22 : ST(0) = RETVAL;
408 : }
409 22 : XSRETURN(1);
410 : }
411 :
412 :
413 : XS_EUPXS(XS__encode_typed_literal); /* prototype to pass -Wmissing-prototypes */
414 32 : XS_EUPXS(XS__encode_typed_literal)
415 : {
416 32 : dVAR; dXSARGS;
417 32 : if (items != 2)
418 0 : croak_xs_usage(cv, "sv, typname");
419 : {
420 32 : SV * sv = ST(0)
421 : ;
422 32 : char * typname = (char *)SvPV_nolen(ST(1))
423 : ;
424 : #line 178 "Util.xs"
425 : char *outstr;
426 : #line 427 "Util.c"
427 : SV * RETVAL;
428 : #line 180 "Util.xs"
429 : outstr = plperl_sv_to_literal(sv, typname);
430 : if (outstr == NULL)
431 : RETVAL = &PL_sv_undef;
432 : else
433 : RETVAL = cstr2sv(outstr);
434 : #line 435 "Util.c"
435 30 : RETVAL = sv_2mortal(RETVAL);
436 30 : ST(0) = RETVAL;
437 : }
438 30 : XSRETURN(1);
439 : }
440 :
441 : #ifdef __cplusplus
442 : extern "C"
443 : #endif
444 : XS_EXTERNAL(boot_PostgreSQL__InServer__Util); /* prototype to pass -Wmissing-prototypes */
445 46 : XS_EXTERNAL(boot_PostgreSQL__InServer__Util)
446 : {
447 : #if PERL_VERSION_LE(5, 21, 5)
448 : dVAR; dXSARGS;
449 : #else
450 46 : dVAR; dXSBOOTARGSAPIVERCHK;
451 : #endif
452 : #if (PERL_REVISION == 5 && PERL_VERSION < 9)
453 : char* file = __FILE__;
454 : #else
455 46 : const char* file = __FILE__;
456 : #endif
457 :
458 : PERL_UNUSED_VAR(file);
459 :
460 : PERL_UNUSED_VAR(cv); /* -W */
461 : PERL_UNUSED_VAR(items); /* -W */
462 : #if PERL_VERSION_LE(5, 21, 5) && defined(XS_APIVERSION_BOOTCHECK)
463 : XS_APIVERSION_BOOTCHECK;
464 : #endif
465 :
466 46 : cv = newXSproto_portable("DEBUG", XS___aliased_constants, file, "");
467 46 : XSANY.any_i32 = DEBUG2;
468 46 : cv = newXSproto_portable("ERROR", XS___aliased_constants, file, "");
469 46 : XSANY.any_i32 = ERROR;
470 46 : cv = newXSproto_portable("INFO", XS___aliased_constants, file, "");
471 46 : XSANY.any_i32 = INFO;
472 46 : cv = newXSproto_portable("LOG", XS___aliased_constants, file, "");
473 46 : XSANY.any_i32 = LOG;
474 46 : cv = newXSproto_portable("NOTICE", XS___aliased_constants, file, "");
475 46 : XSANY.any_i32 = NOTICE;
476 46 : cv = newXSproto_portable("WARNING", XS___aliased_constants, file, "");
477 46 : XSANY.any_i32 = WARNING;
478 46 : cv = newXSproto_portable("_aliased_constants", XS___aliased_constants, file, "");
479 46 : XSANY.any_i32 = 0;
480 46 : (void)newXSproto_portable("elog", XS__elog, file, "$$");
481 46 : (void)newXSproto_portable("quote_literal", XS__quote_literal, file, "$");
482 46 : (void)newXSproto_portable("quote_nullable", XS__quote_nullable, file, "$");
483 46 : (void)newXSproto_portable("quote_ident", XS__quote_ident, file, "$");
484 46 : (void)newXSproto_portable("decode_bytea", XS__decode_bytea, file, "$");
485 46 : (void)newXSproto_portable("encode_bytea", XS__encode_bytea, file, "$");
486 46 : (void)newXSproto_portable("looks_like_number", XS__looks_like_number, file, "$");
487 46 : (void)newXSproto_portable("encode_typed_literal", XS__encode_typed_literal, file, "$$");
488 :
489 : /* Initialisation Section */
490 :
491 : #line 189 "Util.xs"
492 : items = 0; /* avoid 'unused variable' warning */
493 :
494 : #line 495 "Util.c"
495 :
496 : /* End of Initialisation Section */
497 :
498 : #if PERL_VERSION_LE(5, 21, 5)
499 : # if PERL_VERSION_GE(5, 9, 0)
500 : if (PL_unitcheckav)
501 : call_list(PL_scopestack_ix, PL_unitcheckav);
502 : # endif
503 : XSRETURN_YES;
504 : #else
505 46 : Perl_xs_boot_epilog(aTHX_ ax);
506 : #endif
507 46 : }
508 :
|
