I wanted to use sitecustomize.pl along with the relocatabe @INC feature and found out that they din't play well together.
When using userelocatableinc, the sitecustomize.pl file would be looked for in .../../lib/site_perl/$version/sitecustomize.pl. The relocation magic did not apply.
So I factored out the relocation code from S_incpush() (which does @INC) and had the sitecustomize.pl code also call it on the $sitelibexp it uses.
The patch "works for me" (Linux, Perl 5.14.2) with and without usethreads (that tripped me up for a while).
Could some wise monks take a look and make sure I didn't do something stupid. (while I read perldoc perlhack and try to do a proper submission)
You need to run `./regen/embed.pl` after applying the patch to regenerate embed.h and proto.h.
--- embed.fnc.orig 2011-09-26 02:44:34.000000000 -0700
+++ embed.fnc 2011-11-18 02:11:45.178987156 -0800
@@ -1665,6 +1665,8 @@
s |void |forbid_setid |const char flag|const bool suidscript
s |void |incpush |NN const char *const dir|STRLEN len \
|U32 flags
+s |SV* |mayberelocate |NN const char *const dir|STRLEN len \
+ |U32 flags
s |void |incpush_use_sep|NN const char *p|STRLEN len|U32 flags
s |void |init_interp
s |void |init_ids
--- perl.c.orig 2011-09-26 02:44:34.000000000 -0700
+++ perl.c 2011-11-18 02:11:45.174987101 -0800
@@ -1980,6 +1980,13 @@
}
}
+ /* Set $^X early so that it can be used for relocatable paths in
+@INC */
+ /* and for SITELIB_EXP in USE_SITECUSTOMIZE
+ */
+ assert (!PL_tainted);
+ TAINT;
+ S_set_caret_X(aTHX);
+ TAINT_NOT;
+
#if defined(USE_SITECUSTOMIZE)
if (!minus_f) {
/* The games with local $! are to avoid setting errno if there is
+ no
@@ -1995,10 +2002,16 @@
}
# else
/* SITELIB_EXP is a function call on Win32. */
- const char *const sitelib = SITELIB_EXP;
+ const char *const raw_sitelib = SITELIB_EXP;
+ /* process .../.. if PERL_RELOCATABLE_INC is defined */
+ SV *sitelib_sv = mayberelocate(raw_sitelib, strlen(raw_sitelib),
+ INCPUSH_CAN_RELOCATE);
+ const char *const sitelib = SvPVX(sitelib_sv);
(void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
Perl_newSVpvf(aTHX_
"BEGIN { do {local $!; -f '%s/sitecust
+omize.pl'} && do '%s/sitecustomize.pl' }", sitelib, sitelib));
+ assert (SvREFCNT(sitelib_sv) == 1);
+ SvREFCNT_dec(sitelib_sv);
# endif
}
#endif
@@ -2017,11 +2030,6 @@
scriptname = "-";
}
- /* Set $^X early so that it can be used for relocatable paths in
+@INC */
- assert (!PL_tainted);
- TAINT;
- S_set_caret_X(aTHX);
- TAINT_NOT;
init_perllib();
{
@@ -4384,45 +4392,15 @@
}
#endif
-STATIC void
-S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
+STATIC SV *
+S_mayberelocate(pTHX_ const char *const dir, STRLEN len, U32 flags)
{
- dVAR;
-#ifndef PERL_IS_MINIPERL
- const U8 using_sub_dirs
- = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS
- |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
- const U8 add_versioned_sub_dirs
- = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
- const U8 add_archonly_sub_dirs
- = (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS;
-#ifdef PERL_INC_VERSION_LIST
- const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS;
-#endif
-#endif
const U8 canrelocate = (U8)flags & INCPUSH_CAN_RELOCATE;
- const U8 unshift = (U8)flags & INCPUSH_UNSHIFT;
- const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
- AV *const inc = GvAVn(PL_incgv);
+ SV *libdir;
- PERL_ARGS_ASSERT_INCPUSH;
+ PERL_ARGS_ASSERT_MAYBERELOCATE;
assert(len > 0);
- /* Could remove this vestigial extra block, if we don't mind a lo
+t of
- re-indenting diff noise. */
- {
- SV *libdir;
- /* Change 20189146be79a0596543441fa369c6bf7f85103f, to fix RT#666
+5,
- arranged to unshift #! line -I onto the front of @INC. However
+,
- -I can add version and architecture specific libraries, and th
+ey
- need to go first. The old code assumed that it was always
- pushing. Hence to make it work, need to push the architecture
- (etc) libraries onto a temporary array, then "unshift" that on
+to
- the front of @INC. */
-#ifndef PERL_IS_MINIPERL
- AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NUL
+L;
-#endif
-
if (len) {
/* I am not convinced that this is valid when PERLLIB_MANGLE
+is
defined to so something (in os2/os2.c), but the code has b
+een
@@ -4548,6 +4526,50 @@
}
#endif
}
+ return libdir;
+
+}
+
+STATIC void
+S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
+{
+ dVAR;
+#ifndef PERL_IS_MINIPERL
+ const U8 using_sub_dirs
+ = (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS
+ |INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_ADD_OLD_VERS);
+ const U8 add_versioned_sub_dirs
+ = (U8)flags & INCPUSH_ADD_VERSIONED_SUB_DIRS;
+ const U8 add_archonly_sub_dirs
+ = (U8)flags & INCPUSH_ADD_ARCHONLY_SUB_DIRS;
+#ifdef PERL_INC_VERSION_LIST
+ const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS;
+#endif
+#endif
+ const U8 unshift = (U8)flags & INCPUSH_UNSHIFT;
+ const U8 push_basedir = (flags & INCPUSH_NOT_BASEDIR) ? 0 : 1;
+ AV *const inc = GvAVn(PL_incgv);
+
+ PERL_ARGS_ASSERT_INCPUSH;
+ assert(len > 0);
+
+ /* Could remove this vestigial extra block, if we don't mind a lo
+t of
+ re-indenting diff noise. */
+ {
+ SV *libdir;
+ /* Change 20189146be79a0596543441fa369c6bf7f85103f, to fix RT#666
+5,
+ arranged to unshift #! line -I onto the front of @INC. However
+,
+ -I can add version and architecture specific libraries, and th
+ey
+ need to go first. The old code assumed that it was always
+ pushing. Hence to make it work, need to push the architecture
+ (etc) libraries onto a temporary array, then "unshift" that on
+to
+ the front of @INC. */
+#ifndef PERL_IS_MINIPERL
+ AV *const av = (using_sub_dirs) ? (unshift ? newAV() : inc) : NUL
+L;
+#endif
+
+ libdir = mayberelocate(dir, len, flags);
+
#ifndef PERL_IS_MINIPERL
/*
* BEFORE pushing libdir onto @INC we may first push version- and
