#endif
#ifdef WIN32
typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*);
-typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*);
-typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*);
-typedef char* (*LPEnvVendorLibPath)(struct IPerlEnv*, const char*);
+typedef char* (*LPEnvLibPath)(struct IPerlEnv*, const char*,
+ STRLEN *const len);
+typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*,
+ STRLEN *const len);
+typedef char* (*LPEnvVendorLibPath)(struct IPerlEnv*, const char*,
+ STRLEN *const len);
typedef void (*LPEnvGetChildIO)(struct IPerlEnv*, child_IO_table*);
#endif
#ifdef WIN32
#define PerlEnv_os_id() \
(*PL_Env->pEnvOsID)(PL_Env)
-#define PerlEnv_lib_path(str) \
- (*PL_Env->pLibPath)(PL_Env,(str))
-#define PerlEnv_sitelib_path(str) \
- (*PL_Env->pSiteLibPath)(PL_Env,(str))
-#define PerlEnv_vendorlib_path(str) \
- (*PL_Env->pVendorLibPath)(PL_Env,(str))
+#define PerlEnv_lib_path(str, lenp) \
+ (*PL_Env->pLibPath)(PL_Env,(str),(lenp))
+#define PerlEnv_sitelib_path(str, lenp) \
+ (*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp))
+#define PerlEnv_vendorlib_path(str, lenp) \
+ (*PL_Env->pVendorLibPath)(PL_Env,(str),(lenp))
#define PerlEnv_get_child_IO(ptr) \
(*PL_Env->pGetChildIO)(PL_Env, ptr)
#endif
#ifdef WIN32
#define PerlEnv_os_id() win32_os_id()
-#define PerlEnv_lib_path(str) win32_get_privlib(str)
-#define PerlEnv_sitelib_path(str) win32_get_sitelib(str)
-#define PerlEnv_vendorlib_path(str) win32_get_vendorlib(str)
+#define PerlEnv_lib_path(str, lenp) win32_get_privlib(str, lenp)
+#define PerlEnv_sitelib_path(str, lenp) win32_get_sitelib(str, lenp)
+#define PerlEnv_vendorlib_path(str, lenp) win32_get_vendorlib(str, lenp)
#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
#define PerlEnv_clearenv() win32_clearenv()
#define PerlEnv_get_childenv() win32_get_childenv()
{
dVAR;
char *s;
+#ifdef WIN32
+ STRLEN len;
+#endif
+
if (!PL_tainting) {
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
#ifdef SITELIB_EXP
# if defined(WIN32)
/* this picks up sitearch as well */
- s = win32_get_sitelib(PERL_FS_VERSION);
+ s = win32_get_sitelib(PERL_FS_VERSION, &len);
if (s)
- incpush_use_sep(s, 0, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
# else
S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_EXP), INCPUSH_CAN_RELOCATE);
# endif
#ifdef PERL_VENDORLIB_EXP
# if defined(WIN32)
/* this picks up vendorarch as well */
- s = win32_get_vendorlib(PERL_FS_VERSION);
+ s = win32_get_vendorlib(PERL_FS_VERSION, &len);
if (s)
- incpush_use_sep(s, 0, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
# else
S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), INCPUSH_CAN_RELOCATE);
# endif
#endif
#if defined(WIN32)
- s = win32_get_privlib(PERL_FS_VERSION);
+ s = win32_get_privlib(PERL_FS_VERSION, &len);
if (s)
- incpush_use_sep(s, 0, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
+ incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE);
#else
S_incpush_use_sep(aTHX_ STR_WITH_LEN(PRIVLIB_EXP), INCPUSH_CAN_RELOCATE);
#endif
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.11.0")) /**/
+#define PRIVLIB_EXP (win32_get_privlib(PERL_VERSION_STRING, NULL)) /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* be tacked onto this variable to generate a list of directories to search.
*/
#define SITELIB "c:\\perl\\site\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.11.0")) /**/
+#define SITELIB_EXP (win32_get_sitelib(PERL_VERSION_STRING, NULL)) /**/
#define SITELIB_STEM "" /**/
/* Size_t_size:
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "\\Storage Card\\perl58m\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.11.0")) /**/
+#define PRIVLIB_EXP (win32_get_privlib(PERL_VERSION_STRING, NULL)) /**/
/* PTRSIZE:
* This symbol contains the size of a pointer, so that the C preprocessor
* be tacked onto this variable to generate a list of directories to search.
*/
#define SITELIB "\\Storage Card\\perl58m\\site\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.11.0")) /**/
+#define SITELIB_EXP (win32_get_sitelib(PERL_VERSION_STRING, NULL)) /**/
#define SITELIB_STEM "" /**/
/* Size_t_size:
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.11.0")) /**/
+#define PRIVLIB_EXP (win32_get_privlib(PERL_VERSION_STRING, NULL)) /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* be tacked onto this variable to generate a list of directories to search.
*/
#define SITELIB "c:\\perl\\site\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.11.0")) /**/
+#define SITELIB_EXP (win32_get_sitelib(PERL_VERSION_STRING, NULL)) /**/
#define SITELIB_STEM "" /**/
/* Size_t_size:
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.11.0")) /**/
+#define PRIVLIB_EXP (win32_get_privlib(PERL_VERSION_STRING, NULL)) /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* be tacked onto this variable to generate a list of directories to search.
*/
#define SITELIB "c:\\perl\\site\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.11.0")) /**/
+#define SITELIB_EXP (win32_get_sitelib(PERL_VERSION_STRING, NULL)) /**/
#define SITELIB_STEM "" /**/
/* Size_t_size:
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl\\lib" /**/
-#define PRIVLIB_EXP (win32_get_privlib("5.11.0")) /**/
+#define PRIVLIB_EXP (win32_get_privlib(PERL_VERSION_STRING, NULL)) /**/
/* CAN_PROTOTYPE:
* If defined, this macro indicates that the C compiler can handle
* be tacked onto this variable to generate a list of directories to search.
*/
#define SITELIB "c:\\perl\\site\\lib" /**/
-#define SITELIB_EXP (win32_get_sitelib("5.11.0")) /**/
+#define SITELIB_EXP (win32_get_sitelib(PERL_VERSION_STRING, NULL)) /**/
#define SITELIB_STEM "" /**/
/* Size_t_size:
s#/[ *\*]*\*/#/**/#;
if (/^\s*#define\s+(PRIVLIB|SITELIB|VENDORLIB)_EXP/)
{
- $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "($patchlevel))\t/**/\n";
+ $_ = "#define ". $1 . "_EXP (win32_get_". lc($1) . "(PERL_VERSION_STRING, NULL))\t/**/\n";
}
# incpush() handles archlibs, so disable them
elsif (/^\s*#define\s+(ARCHLIB|SITEARCH|VENDORARCH)_EXP/)
#endif
START_EXTERN_C
-extern char * g_win32_get_privlib(const char *pl);
-extern char * g_win32_get_sitelib(const char *pl);
-extern char * g_win32_get_vendorlib(const char *pl);
+extern char * g_win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * g_win32_get_sitelib(const char *pl, STRLEN *const len);
+extern char * g_win32_get_vendorlib(const char *pl,
+ STRLEN *const len);
extern char * g_getlogin(void);
END_EXTERN_C
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
{
- return g_win32_get_privlib(pl);
+ return g_win32_get_privlib(pl, len);
}
char*
-PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
{
- return g_win32_get_sitelib(pl);
+ return g_win32_get_sitelib(pl, len);
}
char*
-PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
+ STRLEN *const len)
{
- return g_win32_get_vendorlib(pl);
+ return g_win32_get_vendorlib(pl, len);
}
void
static BOOL has_shell_metachars(const char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
-static char * get_emd_part(SV **leading, char *trailing, ...);
+static char * get_emd_part(SV **leading, STRLEN *const len,
+ char *trailing, ...);
static void remove_dead_process(long deceased);
static long find_pid(int pid);
static char * qualified_path(const char *cmd);
static char * win32_get_xlib(const char *pl, const char *xlib,
- const char *libname);
+ const char *libname, STRLEN *const len);
static LRESULT win32_process_message(HWND hwnd, UINT msg,
WPARAM wParam, LPARAM lParam);
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
static char *
-get_emd_part(SV **prev_pathp, char *trailing_path, ...)
+get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
{
char base[10];
va_list ap;
else if (SvPVX(*prev_pathp))
sv_catpvn(*prev_pathp, ";", 1);
sv_catpv(*prev_pathp, mod_name);
+ if(len)
+ *len = SvCUR(*prev_pathp);
return SvPVX(*prev_pathp);
}
}
char *
-win32_get_privlib(const char *pl)
+win32_get_privlib(const char *pl, STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
(void)get_regstr(stdlib, &sv);
/* $stdlib .= ";$EMD/../../lib" */
- return get_emd_part(&sv, stdlib, ARCHNAME, "bin", NULL);
+ return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
}
static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname)
+win32_get_xlib(const char *pl, const char *xlib, const char *libname,
+ STRLEN *const len)
{
dTHX;
char regstr[40];
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
- (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, NULL);
+ (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
sprintf(pathstr, "%s/lib", libname);
- (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, NULL);
+ (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
if (!sv1 && !sv2)
return NULL;
- if (!sv1)
- return SvPVX(sv2);
- if (!sv2)
- return SvPVX(sv1);
-
- sv_catpvn(sv1, ";", 1);
- sv_catsv(sv1, sv2);
+ if (!sv1) {
+ sv1 = sv2;
+ } else if (sv2) {
+ sv_catpvn(sv1, ";", 1);
+ sv_catsv(sv1, sv2);
+ }
+ if (len)
+ *len = SvCUR(sv1);
return SvPVX(sv1);
}
char *
-win32_get_sitelib(const char *pl)
+win32_get_sitelib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "sitelib", "site");
+ return win32_get_xlib(pl, "sitelib", "site", len);
}
#ifndef PERL_VENDORLIB_NAME
#endif
char *
-win32_get_vendorlib(const char *pl)
+win32_get_vendorlib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
+ return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
}
static BOOL
#endif
extern int my_fclose(FILE *);
extern int my_fstat(int fd, Stat_t *sbufptr);
-extern char * win32_get_privlib(const char *pl);
-extern char * win32_get_sitelib(const char *pl);
-extern char * win32_get_vendorlib(const char *pl);
+extern char * win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * win32_get_sitelib(const char *pl, STRLEN *const len);
+extern char * win32_get_vendorlib(const char *pl, STRLEN *const len);
extern int IsWin95(void);
extern int IsWinNT(void);
static BOOL has_shell_metachars(char *ptr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
-static char * get_emd_part(SV **leading, char *trailing, ...);
+static char * get_emd_part(SV **leading, STRLEN *const len,
+ char *trailing, ...);
static void remove_dead_process(long deceased);
static long find_pid(int pid);
static char * qualified_path(const char *cmd);
static char * win32_get_xlib(const char *pl, const char *xlib,
- const char *libname);
+ const char *libname, STRLEN *const len);
#ifdef USE_ITHREADS
static void remove_dead_pseudo_process(long child);
/* *prev_pathp (if non-NULL) is expected to be POK (valid allocated SvPVX(sv)) */
static char *
-get_emd_part(SV **prev_pathp, char *trailing_path, ...)
+get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
{
char base[10];
va_list ap;
*prev_pathp = sv_2mortal(newSVpvn("",0));
sv_catpvn(*prev_pathp, ";", 1);
sv_catpv(*prev_pathp, mod_name);
+ if(len)
+ *len = SvCUR(*prev_pathp);
return SvPVX(*prev_pathp);
}
}
char *
-win32_get_privlib(const char *pl)
+win32_get_privlib(const char *pl, STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
(void)get_regstr(stdlib, &sv);
/* $stdlib .= ";$EMD/../../lib" */
- return get_emd_part(&sv, stdlib, ARCHNAME, "bin", NULL);
+ return get_emd_part(&sv, len, stdlib, ARCHNAME, "bin", NULL);
}
static char *
-win32_get_xlib(const char *pl, const char *xlib, const char *libname)
+win32_get_xlib(const char *pl, const char *xlib, const char *libname,
+ STRLEN *const len)
{
dTHX;
char regstr[40];
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/$]/lib"; */
sprintf(pathstr, "%s/%s/lib", libname, pl);
- (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, NULL);
+ (void)get_emd_part(&sv1, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
/* $HKCU{$xlib} || $HKLM{$xlib} . ---; */
(void)get_regstr(xlib, &sv2);
/* $xlib .=
* ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/$libname/lib"; */
sprintf(pathstr, "%s/lib", libname);
- (void)get_emd_part(&sv2, pathstr, ARCHNAME, "bin", pl, NULL);
+ (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL);
if (!sv1 && !sv2)
return NULL;
- if (!sv1)
- return SvPVX(sv2);
- if (!sv2)
- return SvPVX(sv1);
-
- sv_catpvn(sv1, ";", 1);
- sv_catsv(sv1, sv2);
+ if (!sv1) {
+ sv1 = sv2;
+ } else if (sv2) {
+ sv_catpvn(sv1, ";", 1);
+ sv_catsv(sv1, sv2);
+ }
+ if (len)
+ *len = SvCUR(sv1);
return SvPVX(sv1);
}
char *
-win32_get_sitelib(const char *pl)
+win32_get_sitelib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "sitelib", "site");
+ return win32_get_xlib(pl, "sitelib", "site", len);
}
#ifndef PERL_VENDORLIB_NAME
#endif
char *
-win32_get_vendorlib(const char *pl)
+win32_get_vendorlib(const char *pl, STRLEN *const len)
{
- return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME);
+ return win32_get_xlib(pl, "vendorlib", PERL_VENDORLIB_NAME, len);
}
static BOOL