void Perl_set_caret_X(pTHX) { GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */ SV *const caret_x = GvSV(tmpgv); #if defined(OS2) sv_setpv(caret_x, os2_execname(aTHX)); #elif defined(USE_KERN_PROC_PATHNAME) size_t size = 0; int mib[4]; mib[0] = CTL_KERN; mib[1] = KERN_PROC; mib[2] = KERN_PROC_PATHNAME; mib[3] = -1; if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0 && size > 0 && size < MAXPATHLEN * MAXPATHLEN) { sv_grow(caret_x, size); if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0 && size > 2) { SvPOK_only(caret_x); SvCUR_set(caret_x, size - 1); SvTAINT(caret_x); return; } } #elif defined(USE_NSGETEXECUTABLEPATH) char buf[1]; uint32_t size = sizeof(buf); _NSGetExecutablePath(buf, &size); if (size < MAXPATHLEN * MAXPATHLEN) { sv_grow(caret_x, size); if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) { char *const tidied = realpath(SvPVX(caret_x), NULL); if (tidied) { sv_setpv(caret_x, tidied); free(tidied); } else { SvPOK_only(caret_x); SvCUR_set(caret_x, size); } return; } } #elif defined(HAS_PROCSELFEXE) char buf[MAXPATHLEN]; SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, * it is impossible to know whether the result was truncated. */ if (len != -1) { buf[len] = '\0'; } /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe) includes a spurious NUL which will cause $^X to fail in system or backticks (this will prevent extensions from being built and many tests from working). readlink is not meant to add a NUL. Normal readlink works fine. */ if (len > 0 && buf[len-1] == '\0') { len--; } /* FreeBSD's implementation is acknowledged to be imperfect, sometimes returning the text "unknown" from the readlink rather than the path to the executable (or returning an error from the readlink). Any valid path has a '/' in it somewhere, so use that to validate the result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703 */ if (len > 0 && memchr(buf, '/', len)) { sv_setpvn(caret_x, buf, len); return; } #elif defined(WIN32) char *ansi; WCHAR widename[MAX_PATH]; GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR)); ansi = win32_ansipath(widename); sv_setpv(caret_x, ansi); win32_free(ansi); return; #else /* Fallback to this: */ sv_setpv(caret_x, PL_origargv[0]); #endif }
void my_xsinit(pTHX) { dVAR; static const char file[] = __FILE__; #ifdef USE_CTRLX GV *ctrlXgv; SV *ctrlX; #endif #ifdef USE_SUBFILE if (PL_preprocess) croak("Can't use -P with pl2exe"); #endif #ifdef NEED_INIT_WIN32CORE init_Win32CORE(aTHX); #endif #ifdef USE_ZIP pl2exe_boot_zip(aTHX); #endif #ifdef NEED_PREAMBLE newXS("ExtUtils::PerlToExe::preamble", XS_ExtUtils_PerlToExe_preamble, file); if (!PL_preambleav) PL_preambleav = newAV(); av_push(PL_preambleav, newSVpvs("BEGIN { ExtUtils::PerlToExe::preamble() }")); #endif #ifdef NEED_TAINT TAINT; TAINT_PROPER("appended " TAINT_TYPE); TAINT_NOT; #endif #ifdef USE_CTRLX ctrlXgv = gv_fetchpvs("\030", GV_NOTQUAL, SVt_PV); ctrlX = GvSV(ctrlXgv); /* * We can't reopen PL_rsfp yet as it hasn't been set (the file is * open, it's just in an auto variable in S_parse_body). However, * it's easier to fixup the name here, before gv_fetch_file gets * called on it. */ PL_origfilename = savepv(SvPV_nolen(ctrlX)); CopFILE_free(PL_curcop); CopFILE_set(PL_curcop, PL_origfilename); sv_setpv(ctrlX, CTRL_X); SvTAINTED_on(ctrlX); #endif #ifdef USE_ZIP pl2exe_load_zip(aTHX_ PL_origfilename); #endif real_xsinit(aTHX); }