public:
virtual char* Getenv(const char *varname, int &err) = 0;
virtual int Putenv(const char *envstring, int &err) = 0;
- virtual char* LibPath(char *sfx, ...) =0;
+ virtual char* LibPath(char *patchlevel) =0;
+ virtual char* SiteLibPath(char *patchlevel) =0;
};
#endif /* __Inc__IPerlEnv___ */
push(@m, "ppd:\n");
push(@m, "\t\@\$(PERL) -e \"print qq{<SOFTPKG NAME=\\\"$self->{DISTNAME}\\\" VERSION=\\\"$pack_ver\\\">\\n}");
push(@m, ". qq{\\t<TITLE>$self->{DISTNAME}</TITLE>\\n}");
- push(@m, ". qq{\\t<ABSTRACT>$self->{ABSTRACT}</ABSTRACT>\\n}");
+ my $abstract = $self->{ABSTRACT};
+ $abstract =~ s/</</g;
+ $abstract =~ s/>/>/g;
+ push(@m, ". qq{\\t<ABSTRACT>$abstract</ABSTRACT>\\n}");
my ($author) = $self->{AUTHOR};
$author =~ s/@/\\@/g;
push(@m, ". qq{\\t<AUTHOR>$author</AUTHOR>\\n}");
#ifndef PRIVLIB_EXP
#define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
#endif
+#if defined(WIN32)
+ incpush(PRIVLIB_EXP, TRUE);
+#else
incpush(PRIVLIB_EXP, FALSE);
+#endif
#ifdef SITEARCH_EXP
incpush(SITEARCH_EXP, FALSE);
#endif
#ifdef SITELIB_EXP
+#if defined(WIN32)
+ incpush(SITELIB_EXP, TRUE);
+#else
incpush(SITELIB_EXP, FALSE);
#endif
+#endif
if (!tainting)
incpush(".", FALSE);
}
#include "ipenv.h"
-#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo())
-#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo())
-#define PerlEnv_lib_path piENV->LibPath
+#define PerlEnv_putenv(str) piENV->Putenv((str), ErrorNo())
+#define PerlEnv_getenv(str) piENV->Getenv((str), ErrorNo())
+#ifdef WIN32
+#define PerlEnv_lib_path(str) piENV->LibPath((str))
+#define PerlEnv_sitelib_path(str) piENV->SiteLibPath((str))
+#endif
#else
#define PerlEnv_putenv(str) putenv((str))
#define PerlEnv_getenv(str) getenv((str))
alignbytes='8'
aphostname=''
ar='tlib /P128'
-archlib='~INST_TOP~\lib\~archname~'
-archlibexp='~INST_TOP~\lib\~archname~'
+archlib=''
+archlibexp=''
archname='MSWin32'
archobjs=''
awk='awk'
d_Gconvert='gcvt((x),(n),(b))'
d_access='define'
d_alarm='undef'
-d_archlib='define'
+d_archlib='undef'
d_attribut='undef'
d_bcmp='undef'
d_bcopy='undef'
i_vfork='undef'
incpath=''
inews=''
-installarchlib='~INST_TOP~\lib\~archname~'
+installarchlib=''
installbin='~INST_TOP~\bin'
installman1dir='~INST_TOP~\man\man1'
installman3dir='~INST_TOP~\man\man3'
installprivlib='~INST_TOP~\lib'
installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site\~archname~'
+installsitearch=''
installsitelib='~INST_TOP~\lib\site'
intsize='4'
known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
sig_name_init='"ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "USR1", "USR2", "USR3", "BREAK", "ABRT", 0'
sig_num='0, 2, 4, 8, 11, 15, 16, 17, 20, 21, 22, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site\~archname~'
-sitearchexp='~INST_TOP~\lib\site\~archname~'
+sitearch=''
+sitearchexp=''
sitelib='~INST_TOP~\lib\site'
sitelibexp='~INST_TOP~\lib\site'
sizetype='size_t'
alignbytes='8'
aphostname=''
ar='ar'
-archlib='~INST_TOP~\lib\~archname~'
-archlibexp='~INST_TOP~\lib\~archname~'
+archlib=''
+archlibexp=''
archname='MSWin32'
archobjs=''
awk='awk'
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
d_access='define'
d_alarm='undef'
-d_archlib='define'
+d_archlib='undef'
d_attribut='define'
d_bcmp='undef'
d_bcopy='undef'
i_vfork='undef'
incpath=''
inews=''
-installarchlib='~INST_TOP~\lib\~archname~'
+installarchlib=''
installbin='~INST_TOP~\bin'
installman1dir='~INST_TOP~\man\man1'
installman3dir='~INST_TOP~\man\man3'
installprivlib='~INST_TOP~\lib'
installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site\~archname~'
+installsitearch=''
installsitelib='~INST_TOP~\lib\site'
intsize='4'
known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
sig_name_init='"ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "BREAK", "ABRT", 0'
sig_num='0, 2, 4, 8, 11, 15, 21, 22, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site\~archname~'
-sitearchexp='~INST_TOP~\lib\site\~archname~'
+sitearch=''
+sitearchexp=''
sitelib='~INST_TOP~\lib\site'
sitelibexp='~INST_TOP~\lib\site'
sizetype='size_t'
alignbytes='8'
aphostname=''
ar='lib'
-archlib='~INST_TOP~\lib\~archname~'
+archlib=''
archlibexp='~INST_TOP~\lib\~archname~'
archname='MSWin32'
archobjs=''
d_Gconvert='sprintf((b),"%.*g",(n),(x))'
d_access='define'
d_alarm='undef'
-d_archlib='define'
+d_archlib='undef'
d_attribut='undef'
d_bcmp='undef'
d_bcopy='undef'
incpath=''
inews=''
installarchlib='~INST_TOP~\lib\~archname~'
-installbin='~INST_TOP~\bin'
+installbin='~INST_TOP~\bin\~archname~'
installman1dir='~INST_TOP~\man\man1'
installman3dir='~INST_TOP~\man\man3'
installprivlib='~INST_TOP~\lib'
installscript='~INST_TOP~\bin'
-installsitearch='~INST_TOP~\lib\site\~archname~'
-installsitelib='~INST_TOP~\lib\site'
+installsitearch='~INST_TOP~\..\site\~VERSION~\lib\~archname~'
+installsitelib='~INST_TOP~\..\site\~VERSION~\lib'
intsize='4'
known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread'
ksh=''
path_sep=';'
perl='perl'
perladmin=''
-perlpath='~INST_TOP~\bin\perl.exe'
+perlpath='~INST_TOP~\bin\~archname~\perl.exe'
pg=''
phostname='hostname'
pidtype='int'
sig_name_init='"ZERO", "INT", "ILL", "FPE", "SEGV", "TERM", "BREAK", "ABRT", 0'
sig_num='0, 2, 4, 8, 11, 15, 21, 22, 0'
signal_t='void'
-sitearch='~INST_TOP~\lib\site\~archname~'
-sitearchexp='~INST_TOP~\lib\site\~archname~'
-sitelib='~INST_TOP~\lib\site'
-sitelibexp='~INST_TOP~\lib\site'
+sitearch=''
+sitearchexp=''
+sitelib='~INST_TOP~\..\site\~VERSION~\lib'
+sitelibexp='~INST_TOP~\..\site\~VERSION~\lib'
sizetype='size_t'
sleep=''
smail=''
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
-#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
+/* #define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
+/* #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
/* CAT2:
* This macro catenates 2 tokens together.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl5004.5x\\lib" /**/
-#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/
+#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
-#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
+/* #define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
+/* #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/
-#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/
+#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
-#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
+/* #define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
+/* #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
/* CAT2:
* This macro catenates 2 tokens together.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl5004.5x\\lib" /**/
-#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/
+#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
-#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
+/* #define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
+/* #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/
-#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/
+#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
#ifndef _config_h_
#define _config_h_
-#ifdef PERL_OBJECT
-#ifdef PERL_GLOBAL_STRUCT
-#error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT
-#endif
-#define win32_perllib_path PerlEnv_lib_path
-#endif
-
/* LOC_SED:
* This symbol holds the complete pathname to the sed program.
*/
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
-#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
+/* #define ARCHLIB "c:\\perl5004.5x\\lib\\MSWin32-x86" /**/
+/* #define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL)) /**/
/* CAT2:
* This macro catenates 2 tokens together.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define PRIVLIB "c:\\perl5004.5x\\lib" /**/
-#define PRIVLIB_EXP (win32_perllib_path(NULL)) /**/
+#define PRIVLIB_EXP (win32_get_stdlib(patchlevel)) /**/
/* SIG_NAME:
* This symbol contains a list of signal names in order of
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
-#define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
+/* #define SITEARCH "c:\\perl5004.5x\\lib\\site\\MSWin32-x86" /**/
+/* #define SITEARCH_EXP (win32_perllib_path("site",ARCHNAME,NULL)) /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
#define SITELIB "c:\\perl5004.5x\\lib\\site" /**/
-#define SITELIB_EXP (win32_perllib_path("site",NULL)) /**/
+#define SITELIB_EXP (win32_get_sitelib(patchlevel)) /**/
/* DLSYM_NEEDS_UNDERSCORE:
* This symbol, if defined, indicates that we need to prepend an
munge();
s/\\\$/\$/g;
s#/[ *\*]*\*/#/**/#;
- if (/^\s*#define\s+ARCHLIB_EXP/)
- {
- $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n";
- }
+ # if (/^\s*#define\s+ARCHLIB_EXP/)
+ # {
+ # $_ = "#define ARCHLIB_EXP (win32_perllib_path(ARCHNAME,NULL))\t/**/\n";
+ # }
if (/^\s*#define\s+PRIVLIB_EXP/)
{
- $_ = "#define PRIVLIB_EXP (win32_perllib_path(NULL))\t/**/\n"
- }
- if (/^\s*#define\s+SITEARCH_EXP/)
- {
- $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n";
+ $_ = "#define PRIVLIB_EXP (win32_get_stdlib(patchlevel))\t/**/\n"
}
+ # if (/^\s*#define\s+SITEARCH_EXP/)
+ # {
+ # $_ = "#define SITEARCH_EXP (win32_perllib_path(\"site\",ARCHNAME,NULL))\t/**/\n";
+ # }
if (/^\s*#define\s+SITELIB_EXP/)
{
- $_ = "#define SITELIB_EXP (win32_perllib_path(\"site\",NULL))\t/**/\n";
+ $_ = "#define SITELIB_EXP (win32_get_sitelib(patchlevel))\t/**/\n";
}
print H;
}
$opt{SUBVERSION} = $2 || '00';
}
+$opt{VERSION} = $];
$opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'};
$opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0]
unless $opt{'cf_email'};
};
-extern char * g_win32_perllib_path(char *sfx,...);
+extern char * g_win32_get_stdlib(char *pl);
+extern char * g_win32_get_sitelib(char *pl);
class CPerlEnv : public IPerlEnv
{
public:
{
return putenv(envstring);
};
- virtual char* LibPath(char *sfx, ...)
- {
- LPSTR ptr1, ptr2, ptr3, ptr4, ptr5;
- va_list ap;
- va_start(ap,sfx);
- ptr1 = va_arg(ap,char *);
- ptr2 = va_arg(ap,char *);
- ptr3 = va_arg(ap,char *);
- ptr4 = va_arg(ap,char *);
- ptr5 = va_arg(ap,char *);
- return g_win32_perllib_path(sfx, ptr1, ptr2, ptr3, ptr4, ptr5);
+ virtual char* LibPath(char *pl)
+ {
+ return g_win32_get_stdlib(pl);
+ };
+ virtual char* SiteLibPath(char *pl)
+ {
+ return g_win32_get_sitelib(pl);
};
};
#define EXECF_SPAWN_NOWAIT 3
#if defined(PERL_OBJECT)
-#undef win32_perllib_path
-#define win32_perllib_path g_win32_perllib_path
+#undef win32_get_stdlib
+#define win32_get_stdlib g_win32_get_stdlib
+#undef win32_get_sitelib
+#define win32_get_sitelib g_win32_get_sitelib
#undef do_aspawn
#define do_aspawn g_do_aspawn
#undef do_spawn
return (os_id() == VER_PLATFORM_WIN32_NT);
}
+char*
+GetRegStrFromKey(HKEY hkey, const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{ /* Retrieve a REG_SZ or REG_EXPAND_SZ from the registry */
+ HKEY handle;
+ DWORD type;
+ const char *subkey = "Software\\Perl";
+ long retval;
+
+ retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
+ if(retval == ERROR_SUCCESS){
+ retval = RegQueryValueEx(handle, lpszValueName, 0, &type, NULL, lpDataLen);
+ if(retval == ERROR_SUCCESS && type == REG_SZ) {
+ if(*ptr != NULL) {
+ Renew(*ptr, *lpDataLen, char);
+ }
+ else {
+ New(1312, *ptr, *lpDataLen, char);
+ }
+ retval = RegQueryValueEx(handle, lpszValueName, 0, NULL, (PBYTE)*ptr, lpDataLen);
+ if(retval != ERROR_SUCCESS) {
+ Safefree(ptr);
+ ptr = NULL;
+ }
+ }
+ RegCloseKey(handle);
+ }
+ return *ptr;
+}
+
+char*
+GetRegStr(const char *lpszValueName, char** ptr, DWORD* lpDataLen)
+{
+ *ptr = GetRegStrFromKey(HKEY_CURRENT_USER, lpszValueName, ptr, lpDataLen);
+ if(*ptr == NULL)
+ {
+ *ptr = GetRegStrFromKey(HKEY_LOCAL_MACHINE, lpszValueName, ptr, lpDataLen);
+ }
+ return *ptr;
+}
+
char *
-win32_perllib_path(char *sfx,...)
+win32_get_stdlib(char *pl)
{
- va_list ap;
- char *end;
- va_start(ap,sfx);
- GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE)
- ? GetModuleHandle(NULL)
- : w32_perldll_handle,
- w32_perllib_root,
- sizeof(w32_perllib_root));
- *(end = strrchr(w32_perllib_root, '\\')) = '\0';
- if (stricmp(end-4,"\\bin") == 0)
- end -= 4;
- strcpy(end,"\\lib");
- while (sfx)
- {
- strcat(end,"\\");
- strcat(end,sfx);
- sfx = va_arg(ap,char *);
- }
- va_end(ap);
- return (w32_perllib_root);
+ static char szStdLib[] = "lib";
+ int len = 0, newSize;
+ char szBuffer[MAX_PATH+1];
+ char szModuleName[MAX_PATH];
+ int result;
+ DWORD dwDataLen;
+ char *lpPath = NULL;
+ char *ptr;
+
+ /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */
+ sprintf(szBuffer, "%s-%s", szStdLib, pl);
+ lpPath = GetRegStr(szBuffer, &lpPath, &dwDataLen);
+ if(lpPath == NULL)
+ lpPath = GetRegStr(szStdLib, &lpPath, &dwDataLen);
+
+ /* $stdlib .= ";$EMD/../../lib" */
+ GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
+ ptr = strrchr(szModuleName, '\\');
+ if(ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ if(ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ }
+ }
+ if(ptr == NULL)
+ {
+ ptr = szModuleName;
+ *ptr = '\\';
+ }
+ strcpy(++ptr, szStdLib);
+
+ /* check that this path exists */
+ GetCurrentDirectory(sizeof(szBuffer), szBuffer);
+ result = SetCurrentDirectory(szModuleName);
+ SetCurrentDirectory(szBuffer);
+ if(result == 0)
+ {
+ GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
+ ptr = strrchr(szModuleName, '\\');
+ if(ptr != NULL)
+ strcpy(++ptr, szStdLib);
+ }
+
+ newSize = strlen(szModuleName) + 1;
+ if(lpPath != NULL)
+ {
+ len = strlen(lpPath);
+ newSize += len + 1; /* plus 1 for ';' */
+ lpPath = Renew(lpPath, newSize, char);
+ }
+ else
+ New(1310, lpPath, newSize, char);
+
+ if(lpPath != NULL)
+ {
+ if(len != 0)
+ lpPath[len++] = ';';
+ strcpy(&lpPath[len], szModuleName);
+ }
+ return lpPath;
+}
+
+char *
+get_sitelib_part(char* lpRegStr, char* lpPathStr)
+{
+ char szBuffer[MAX_PATH+1];
+ char szModuleName[MAX_PATH];
+ DWORD dwDataLen;
+ int len = 0;
+ int result;
+ char *lpPath = NULL;
+ char *ptr;
+
+ lpPath = GetRegStr(lpRegStr, &lpPath, &dwDataLen);
+
+ /* $sitelib .= ";$EMD/../../../<lpPathStr>" */
+ GetModuleFileName(GetModuleHandle(NULL), szModuleName, sizeof(szModuleName));
+ ptr = strrchr(szModuleName, '\\');
+ if(ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ if(ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ if(ptr != NULL)
+ {
+ *ptr = '\0';
+ ptr = strrchr(szModuleName, '\\');
+ }
+ }
+ }
+ if(ptr == NULL)
+ {
+ ptr = szModuleName;
+ *ptr = '\\';
+ }
+ strcpy(++ptr, lpPathStr);
+
+ /* check that this path exists */
+ GetCurrentDirectory(sizeof(szBuffer), szBuffer);
+ result = SetCurrentDirectory(szModuleName);
+ SetCurrentDirectory(szBuffer);
+
+ if(result)
+ {
+ int newSize = strlen(szModuleName) + 1;
+ if(lpPath != NULL)
+ {
+ len = strlen(lpPath);
+ newSize += len + 1; /* plus 1 for ';' */
+ lpPath = Renew(lpPath, newSize, char);
+ }
+ else
+ New(1311, lpPath, newSize, char);
+
+ if(lpPath != NULL)
+ {
+ if(len != 0)
+ lpPath[len++] = ';';
+ strcpy(&lpPath[len], szModuleName);
+ }
+ }
+ return lpPath;
+}
+
+char *
+win32_get_sitelib(char *pl)
+{
+ static char szSiteLib[] = "sitelib";
+ char szRegStr[40];
+ char szPathStr[MAX_PATH];
+ char *lpPath1;
+ char *lpPath2;
+
+ /* $HKCU{"sitelib-$]"} || $HKLM{"sitelib-$]"} . ---; */
+ sprintf(szRegStr, "%s-%s", szSiteLib, pl);
+ sprintf(szPathStr, "site\\%s\\lib", pl);
+ lpPath1 = get_sitelib_part(szRegStr, szPathStr);
+
+ /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */
+ lpPath2 = get_sitelib_part(szSiteLib, "site\\lib");
+ if(lpPath1 == NULL)
+ return lpPath2;
+
+ if(lpPath2 == NULL)
+ return lpPath1;
+
+ int len = strlen(lpPath1);
+ int newSize = len + strlen(lpPath2) + 2; /* plus one for ';' */
+
+ lpPath1 = Renew(lpPath1, newSize, char);
+ if(lpPath1 != NULL)
+ {
+ lpPath1[len++] = ';';
+ strcpy(&lpPath1[len], lpPath2);
+ }
+ Safefree(lpPath2);
+ return lpPath1;
}
#ifndef USE_WIN32_RTL_ENV
-BOOL GetRegStr(HKEY hkey, const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen)
-{ // Retrieve a REG_SZ or REG_EXPAND_SZ from the registry
- HKEY handle;
- DWORD type, dwDataLen = *lpdwDataLen;
- const char *subkey = "Software\\Perl";
- char szBuffer[MAX_PATH+1];
- long retval;
-
- retval = RegOpenKeyEx(hkey, subkey, 0, KEY_READ, &handle);
- if(retval == ERROR_SUCCESS)
- {
- retval = RegQueryValueEx(handle, lpszValueName, 0, &type, (LPBYTE)lpszData, &dwDataLen);
- RegCloseKey(handle);
- if(retval == ERROR_SUCCESS && (type == REG_SZ || type == REG_EXPAND_SZ))
- {
- if(type != REG_EXPAND_SZ)
- {
- *lpdwDataLen = dwDataLen;
- return TRUE;
- }
- strcpy(szBuffer, lpszData);
- dwDataLen = ExpandEnvironmentStrings(szBuffer, lpszData, *lpdwDataLen);
- if(dwDataLen < *lpdwDataLen)
- {
- *lpdwDataLen = dwDataLen;
- return TRUE;
- }
- }
- }
-
- strcpy(lpszData, lpszDefault);
- return FALSE;
-}
-
-char* GetRegStr(const char *lpszValueName, char *lpszDefault, char *lpszData, unsigned long *lpdwDataLen)
-{
- if(!GetRegStr(HKEY_CURRENT_USER, lpszValueName, lpszDefault, lpszData, lpdwDataLen))
- {
- GetRegStr(HKEY_LOCAL_MACHINE, lpszValueName, lpszDefault, lpszData, lpdwDataLen);
- }
- if(*lpszData == '\0')
- lpszData = NULL;
- return lpszData;
-}
-
DllExport char *
win32_getenv(const char *name)
{
}
if(curitem == NULL)
{
- unsigned long dwDataLen = curlen;
if(strcmp("PERL5DB", name) == 0)
- curitem = GetRegStr(name, "", curitem, &dwDataLen);
+ curitem = GetRegStr(name, &curitem, &curlen);
}
return curitem;
}
#ifdef PERL_GLOBAL_STRUCT
#error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT
#endif
-#define win32_perllib_path PerlEnv_lib_path
+#define win32_get_stdlib PerlEnv_lib_path
+#define win32_get_sitelib PerlEnv_sitelib_path
#endif
#ifdef __GNUC__
extern int do_spawn(char *cmd);
extern int do_spawn_nowait(char *cmd);
extern char do_exec(char *cmd);
-extern char * win32_perllib_path(char *sfx,...);
+extern char * win32_get_stdlib(char *pl);
+extern char * win32_get_sitelib(char *pl);
extern int IsWin95(void);
extern int IsWinNT(void);
projects / p5sagit/p5-mst-13.2.git / commitdiff