mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

Add a parameter to win32_get_{priv,site,vendor}lib(), to return the length,

Browse Source 
as we already know it, and use it in S_init_perllib() to save a strlen() in
S_incpush_use_sep().
This commit is contained in:
Nicholas Clark 2009-02-20 20:09:16 +00:00
parent fd2c5c6c39
commit e6a0bbf8b4
12 changed files with 98 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
iperlsys.h
View File

@ -476,9 +476,12 @@ typedef char* (*LPENVGetenv_len)(struct IPerlEnv*,
#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
@ -544,12 +547,12 @@ struct IPerlEnvInfo
#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
@ -570,9 +573,9 @@ struct IPerlEnvInfo
#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()

16
perl.c
View File

@ -4094,6 +4094,10 @@ S_init_perllib(pTHX_ U32 old_vers)
{
dVAR;
char *s;
#ifdef WIN32
STRLEN len;
#endif
if (!PL_tainting) {
#ifndef VMS
s = PerlEnv_getenv("PERL5LIB");
@ -4178,9 +4182,9 @@ S_init_perllib(pTHX_ U32 old_vers)
#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
@ -4204,9 +4208,9 @@ S_init_perllib(pTHX_ U32 old_vers)
#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
@ -4228,9 +4232,9 @@ S_init_perllib(pTHX_ U32 old_vers)
#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

4
win32/config_H.bc
View File

@ -2618,7 +2618,7 @@
* 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
@ -2734,7 +2734,7 @@
* 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:

4
win32/config_H.ce
View File

@ -3361,7 +3361,7 @@
* 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
@ -3492,7 +3492,7 @@
* 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:

4
win32/config_H.gc
View File

@ -2638,7 +2638,7 @@
* 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
@ -2754,7 +2754,7 @@
* 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:

4
win32/config_H.vc
View File

@ -2634,7 +2634,7 @@
* 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
@ -2750,7 +2750,7 @@
* 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:

4
win32/config_H.vc64
View File

@ -2618,7 +2618,7 @@
* 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
@ -2734,7 +2734,7 @@
* 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:

2
win32/config_h.PL
View File

@ -64,7 +64,7 @@ while (<SH>)
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/)

20
win32/perlhost.h
View File

@ -26,9 +26,10 @@
#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
@ -517,21 +518,22 @@ PerlEnvOsId(struct IPerlEnv* piPerl)
}
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

39
win32/win32.c
View File

@ -123,12 +123,13 @@ static int do_spawn2(pTHX_ const char *cmd, int exectype);
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);
@ -308,7 +309,7 @@ get_regstr(const char *valuename, SV **svp)
/* *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;
@ -365,6 +366,8 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
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);
}
@ -372,7 +375,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
}
char *
win32_get_privlib(const char *pl)
win32_get_privlib(const char *pl, STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
@ -385,11 +388,12 @@ win32_get_privlib(const char *pl)
(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];
@ -404,7 +408,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
/* $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);
@ -412,25 +416,26 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
/* $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);
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
@ -438,9 +443,9 @@ win32_get_sitelib(const char *pl)
#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

6
win32/win32.h
View File

@ -345,9 +345,9 @@ extern FILE * my_fdopen(int, char *);
#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);

39
win32/wince.c
View File

@ -70,12 +70,13 @@ static int do_spawn2(pTHX_ char *cmd, int exectype);
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);
@ -171,7 +172,7 @@ get_regstr(const char *valuename, SV **svp)
/* *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;
@ -228,6 +229,8 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
*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);
}
@ -235,7 +238,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
}
char *
win32_get_privlib(const char *pl)
win32_get_privlib(const char *pl, STRLEN *const len)
{
dTHX;
char *stdlib = "lib";
@ -248,11 +251,12 @@ win32_get_privlib(const char *pl)
(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];
@ -269,7 +273,7 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
/* $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);
@ -277,25 +281,26 @@ win32_get_xlib(const char *pl, const char *xlib, const char *libname)
/* $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);
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
@ -303,9 +308,9 @@ win32_get_sitelib(const char *pl)
#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