#ifdef NETWARE
#include "nwutil.h"
-char *nw_get_sitelib(const char *pl);
#endif
/* XXX If this causes problems, set i_unistd=undef in the hint file. */
PL_stashcache = newHV();
- PL_patchlevel = Perl_newSVpvf(aTHX_ "v%d.%d.%d", (int)PERL_REVISION,
- (int)PERL_VERSION, (int)PERL_SUBVERSION);
+ PL_patchlevel = newSVpvs("v" PERL_VERSION_STRING);
#ifdef HAS_MMAP
if (!PL_mmap_page_size) {
{
dVAR;
char *s;
+#ifdef WIN32
+ STRLEN len;
+#endif
+
if (!PL_tainting) {
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
#else
if (s)
#endif
- incpush_use_sep(s, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
+ incpush_use_sep(s, 0, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
else if (!old_vers) {
s = PerlEnv_getenv("PERLLIB");
if (s)
- incpush_use_sep(s, 0);
+ incpush_use_sep(s, 0, 0);
}
#else /* VMS */
/* Treat PERL5?LIB as a possible search list logical name -- the
int idx = 0;
if (my_trnlnm("PERL5LIB",buf,0))
do {
- incpush_use_sep(buf, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
+ incpush_use_sep(buf, 0, old_vers ? old_vers : INCPUSH_ADD_SUB_DIRS);
} while (my_trnlnm("PERL5LIB",buf,++idx));
else if (!old_vers)
while (my_trnlnm("PERLLIB",buf,idx++))
- incpush_use_sep(buf, 0);
+ incpush_use_sep(buf, 0, 0);
#endif /* VMS */
}
*/
#ifdef APPLLIB_EXP
if (!old_vers) {
- incpush_use_sep(APPLLIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
} else {
- incpush_use_sep(APPLLIB_EXP, old_vers|INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), old_vers|INCPUSH_CAN_RELOCATE);
}
#endif
# ifdef ARCHLIB_EXP
if (!old_vers)
- incpush_use_sep(ARCHLIB_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE);
# endif
Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
- incpush_use_sep(SvPVX(privdir), INCPUSH_ADD_SUB_DIRS);
+ incpush_use_sep(SvPVX(privdir), SvCUR(privdir), INCPUSH_ADD_SUB_DIRS);
Perl_sv_setpvf(aTHX_ privdir, "%ssite_perl:", macperl);
- if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
+ if (PerlLIO_stat(SvPVX(privdir), SvCUR(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
incpush_use_sep(SvPVX(privdir), INCPUSH_ADD_SUB_DIRS);
SvREFCNT_dec(privdir);
/* sitearch is always relative to sitelib on Windows for
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
- incpush_use_sep(SITEARCH_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITEARCH_EXP), INCPUSH_CAN_RELOCATE);
# endif
#endif
#ifdef SITELIB_EXP
# if defined(WIN32)
/* this picks up sitearch as well */
- incpush_use_sep(SITELIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ s = win32_get_sitelib(PERL_FS_VERSION, &len);
+ if (s)
+ incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
# else
- incpush_use_sep(SITELIB_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_EXP), INCPUSH_CAN_RELOCATE);
# endif
#endif
}
#if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST)
/* Search for version-specific dirs below here */
- incpush_use_sep(SITELIB_STEM, old_vers|INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), old_vers|INCPUSH_CAN_RELOCATE);
#endif
if (!old_vers) {
/* vendorarch is always relative to vendorlib on Windows for
* DLL-based path intuition to work correctly */
# if !defined(WIN32)
- incpush_use_sep(PERL_VENDORARCH_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORARCH_EXP), INCPUSH_CAN_RELOCATE);
# endif
#endif
#ifdef PERL_VENDORLIB_EXP
# if defined(WIN32)
/* this picks up vendorarch as well */
- incpush_use_sep(PERL_VENDORLIB_EXP,
- INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ s = win32_get_vendorlib(PERL_FS_VERSION, &len);
+ if (s)
+ incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
# else
- incpush_use_sep(PERL_VENDORLIB_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), INCPUSH_CAN_RELOCATE);
# endif
#endif
}
#if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST)
/* Search for version-specific dirs below here */
- incpush_use_sep(PERL_VENDORLIB_STEM, old_vers|INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM), old_vers|INCPUSH_CAN_RELOCATE);
#endif
- if (!old_vers)
+ if (!old_vers) {
#ifdef ARCHLIB_EXP
- incpush_use_sep(ARCHLIB_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(ARCHLIB_EXP), INCPUSH_CAN_RELOCATE);
#endif
#ifndef PRIVLIB_EXP
#endif
#if defined(WIN32)
- incpush_use_sep(PRIVLIB_EXP, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ s = win32_get_privlib(PERL_FS_VERSION, &len);
+ if (s)
+ incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
#else
- incpush_use_sep(PRIVLIB_EXP, INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE);
#endif
+ }
#ifdef PERL_OTHERLIBDIRS
if (!old_vers) {
- incpush_use_sep(PERL_OTHERLIBDIRS, INCPUSH_ADD_SUB_DIRS
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), INCPUSH_ADD_SUB_DIRS
|INCPUSH_CAN_RELOCATE);
} else {
- incpush_use_sep(PERL_OTHERLIBDIRS, old_vers|INCPUSH_CAN_RELOCATE);
+ S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), old_vers|INCPUSH_CAN_RELOCATE);
}
#endif
S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
{
dVAR;
- const U8 addsubdirs = flags & INCPUSH_ADD_SUB_DIRS;
- const U8 addoldvers = flags & INCPUSH_ADD_OLD_VERS;
- const U8 canrelocate = flags & INCPUSH_CAN_RELOCATE;
- const U8 unshift = flags & INCPUSH_UNSHIFT;
+ const U8 addsubdirs = (U8)flags & INCPUSH_ADD_SUB_DIRS;
+ const U8 addoldvers = (U8)flags & INCPUSH_ADD_OLD_VERS;
+ 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;
SV *subdir = NULL;
AV *inc;
#endif
if (addsubdirs) {
#ifdef MACOS_TRADITIONAL
-#define PERL_AV_SUFFIX_FMT ""
-#define PERL_ARCH_FMT "%s:"
-#define PERL_ARCH_FMT_PATH PERL_FS_VER_FMT PERL_AV_SUFFIX_FMT
+#define PERL_ARCH_FMT_PREFIX ""
+#define PERL_ARCH_FMT_SUFFIX ":"
+#define PERL_ARCH_FMT_PATH PERL_FS_VERSION ""
#else
-#define PERL_AV_SUFFIX_FMT "/"
-#define PERL_ARCH_FMT "/%s"
-#define PERL_ARCH_FMT_PATH PERL_AV_SUFFIX_FMT PERL_FS_VER_FMT
+#define PERL_ARCH_FMT_PREFIX "/"
+#define PERL_ARCH_FMT_SUFFIX ""
+#define PERL_ARCH_FMT_PATH "/" PERL_FS_VERSION
#endif
/* .../version/archname if -d .../version/archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH PERL_ARCH_FMT,
- SVfARG(libdir),
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION, ARCHNAME);
+ sv_setsv(subdir, libdir);
+ sv_catpvs(subdir, PERL_ARCH_FMT_PATH \
+ PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
subdir = S_incpush_if_exists(aTHX_ av, subdir);
/* .../version if -d .../version */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH,
- SVfARG(libdir),
- (int)PERL_REVISION, (int)PERL_VERSION,
- (int)PERL_SUBVERSION);
+ sv_setsv(subdir, libdir);
+ sv_catpvs(subdir, PERL_ARCH_FMT_PATH);
subdir = S_incpush_if_exists(aTHX_ av, subdir);
/* .../archname if -d .../archname */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT,
- SVfARG(libdir), ARCHNAME);
+ sv_setsv(subdir, libdir);
+ sv_catpvs(subdir,
+ PERL_ARCH_FMT_PREFIX ARCHNAME PERL_ARCH_FMT_SUFFIX);
subdir = S_incpush_if_exists(aTHX_ av, subdir);
}
if (addoldvers) {
for (incver = incverlist; *incver; incver++) {
/* .../xxx if -d .../xxx */
- Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT,
+ Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PREFIX \
+ "%s" PERL_ARCH_FMT_SUFFIX,
SVfARG(libdir), *incver);
subdir = S_incpush_if_exists(aTHX_ av, subdir);
}
}
STATIC void
-S_incpush_use_sep(pTHX_ const char *p, U32 flags)
+S_incpush_use_sep(pTHX_ const char *p, STRLEN len, U32 flags)
{
+ const char *s;
+ const char *end;
/* This logic has been broken out from S_incpush(). It may be possible to
simplify it. */
PERL_ARGS_ASSERT_INCPUSH_USE_SEP;
+ if (!len)
+ len = strlen(p);
+
+ end = p + len;
+
/* Break at all separators */
- while (*p) {
- const char *s;
+ while ((s = (const char*)memchr(p, PERLLIB_SEP, end - p))) {
+ if (s == p) {
+ /* skip any consecutive separators */
- /* skip any consecutive separators */
- while ( *p == PERLLIB_SEP ) {
/* Uncomment the next line for PATH semantics */
+ /* But you'll need to write tests */
/* av_push(GvAVn(PL_incgv), newSVpvs(".")); */
- p++;
- }
-
- if ((s = strchr(p, PERLLIB_SEP)) != NULL ) {
+ } else {
incpush(p, (STRLEN)(s - p), flags);
- p = s + 1;
- }
- else {
- incpush(p, 0, flags);
- return;
}
+ p = s + 1;
}
+ if (p != end)
+ incpush(p, (STRLEN)(end - p), flags);
+
}
void
projects / p5sagit/p5-mst-13.2.git / blobdiff