4 * by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * 'I do not know clearly,' said Frodo; 'but the path climbs, I think,
13 * up into the mountains on the northern side of that vale where the old
14 * city stands. It goes up to a high cleft and so down to -- that which
16 * 'Do you know the name of that high pass?' said Faramir.
18 * [p.691 of _The Lord of the Rings_, IV/xi: "The Forbidden Pool"]
21 /* This file contains a single function, set_caret_X, to set the $^X
22 * variable. It's only used in perl.c, but has various OS dependencies,
23 * so its been moved to its own file to reduce header pollution.
24 * See RT 120314 for details.
27 #if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE)
28 # define USE_SITECUSTOMIZE
39 #ifdef USE_KERN_PROC_PATHNAME
40 # include <sys/sysctl.h>
43 #ifdef USE_NSGETEXECUTABLEPATH
44 # include <mach-o/dyld.h>
47 /* Note: Functions in this file must not have bool parameters. When
48 PERL_BOOL_AS_CHAR is #defined, mach-o/dyld.h overrides it in this file
49 by #including stdbool.h, so the function parameters here would conflict
50 with those in proto.h.
54 Perl_set_caret_X(pTHX) {
55 GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
57 SV *const caret_x = GvSV(tmpgv);
59 sv_setpv(caret_x, os2_execname(aTHX));
61 # ifdef USE_KERN_PROC_PATHNAME
66 mib[2] = KERN_PROC_PATHNAME;
69 if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0
70 && size > 0 && size < MAXPATHLEN * MAXPATHLEN) {
71 sv_grow(caret_x, size);
73 if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0
76 SvCUR_set(caret_x, size - 1);
81 # elif defined(USE_NSGETEXECUTABLEPATH)
83 uint32_t size = sizeof(buf);
85 _NSGetExecutablePath(buf, &size);
86 if (size < MAXPATHLEN * MAXPATHLEN) {
87 sv_grow(caret_x, size);
88 if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) {
89 char *const tidied = realpath(SvPVX(caret_x), NULL);
91 sv_setpv(caret_x, tidied);
95 SvCUR_set(caret_x, size);
100 # elif defined(HAS_PROCSELFEXE)
101 char buf[MAXPATHLEN];
102 int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
104 /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
105 includes a spurious NUL which will cause $^X to fail in system
106 or backticks (this will prevent extensions from being built and
107 many tests from working). readlink is not meant to add a NUL.
108 Normal readlink works fine.
110 if (len > 0 && buf[len-1] == '\0') {
114 /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
115 returning the text "unknown" from the readlink rather than the path
116 to the executable (or returning an error from the readlink). Any
117 valid path has a '/' in it somewhere, so use that to validate the
118 result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
120 if (len > 0 && memchr(buf, '/', len)) {
121 sv_setpvn(caret_x, buf, len);
125 /* Fallback to this: */
126 sv_setpv(caret_x, PL_origargv[0]);
133 * c-indentation-style: bsd
135 * indent-tabs-mode: nil
138 * ex: set ts=8 sts=4 sw=4 et: