Second patch from:

Subject: [PATCH] Move Win32::* functions from win32/win32.c to ext/Win32/Win32.xs
Message-ID: <lc9kn2tb0p5sdd4q69rbc7067r4imar59r@4ax.com>

p4raw-id: //depot/perl@29510

1 files changed, 30 insertions, 503 deletions

diff --git a/win32/win32.c b/win32/win32.c
index a7c409fb9c..16bf51ec20 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -121,8 +121,6 @@ END_EXTERN_C
 
 static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
 
-#define ONE_K_BUFSIZE	1024
-
 #ifdef __BORLANDC__
 /* Silence STDERR grumblings from Borland's math library. */
 DllExport int
@@ -4270,498 +4268,38 @@ win32_dynaload(const char* filename)
     return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH);
 }
 
-/*
- * Extras.
- */
-
-static
-XS(w32_SetChildShowWindow)
-{
-    dXSARGS;
-    BOOL use_showwindow = w32_use_showwindow;
-    /* use "unsigned short" because Perl has redefined "WORD" */
-    unsigned short showwindow = w32_showwindow;
-
-    if (items > 1)
-	Perl_croak(aTHX_ "usage: Win32::SetChildShowWindow($showwindow)");
-
-    if (items == 0 || !SvOK(ST(0)))
-        w32_use_showwindow = FALSE;
-    else {
-        w32_use_showwindow = TRUE;
-        w32_showwindow = (unsigned short)SvIV(ST(0));
-    }
-
-    EXTEND(SP, 1);
-    if (use_showwindow)
-        ST(0) = sv_2mortal(newSViv(showwindow));
-    else
-        ST(0) = &PL_sv_undef;
-    XSRETURN(1);
-}
-
-static
-XS(w32_GetCwd)
-{
-    dXSARGS;
-    /* Make the host for current directory */
-    char* ptr = PerlEnv_get_childdir();
-    /*
-     * If ptr != Nullch
-     *   then it worked, set PV valid,
-     *   else return 'undef'
-     */
-    if (ptr) {
-	SV *sv = sv_newmortal();
-	sv_setpv(sv, ptr);
-	PerlEnv_free_childdir(ptr);
-
-#ifndef INCOMPLETE_TAINTS
-	SvTAINTED_on(sv);
-#endif
-
-	EXTEND(SP,1);
-	SvPOK_on(sv);
-	ST(0) = sv;
-	XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_SetCwd)
-{
-    dXSARGS;
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)");
-    if (!PerlDir_chdir(SvPV_nolen(ST(0))))
-	XSRETURN_YES;
-
-    XSRETURN_NO;
-}
-
-static
-XS(w32_GetNextAvailDrive)
-{
-    dXSARGS;
-    char ix = 'C';
-    char root[] = "_:\\";
-
-    EXTEND(SP,1);
-    while (ix <= 'Z') {
-	root[0] = ix++;
-	if (GetDriveType(root) == 1) {
-	    root[2] = '\0';
-	    XSRETURN_PV(root);
-	}
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetLastError)
-{
-    dXSARGS;
-    EXTEND(SP,1);
-    XSRETURN_IV(GetLastError());
-}
-
-static
-XS(w32_SetLastError)
-{
-    dXSARGS;
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::SetLastError($error)");
-    SetLastError(SvIV(ST(0)));
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_LoginName)
-{
-    dXSARGS;
-    char *name = w32_getlogin_buffer;
-    DWORD size = sizeof(w32_getlogin_buffer);
-    EXTEND(SP,1);
-    if (GetUserName(name,&size)) {
-	/* size includes NULL */
-	ST(0) = sv_2mortal(newSVpvn(name,size-1));
-	XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_NodeName)
-{
-    dXSARGS;
-    char name[MAX_COMPUTERNAME_LENGTH+1];
-    DWORD size = sizeof(name);
-    EXTEND(SP,1);
-    if (GetComputerName(name,&size)) {
-	/* size does NOT include NULL :-( */
-	ST(0) = sv_2mortal(newSVpvn(name,size));
-	XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-
-static
-XS(w32_DomainName)
-{
-    dXSARGS;
-    HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll");
-    DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer);
-    DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level,
-					  void *bufptr);
-
-    if (hNetApi32) {
-	pfnNetApiBufferFree = (DWORD (__stdcall *)(void *))
-	    GetProcAddress(hNetApi32, "NetApiBufferFree");
-	pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *))
-	    GetProcAddress(hNetApi32, "NetWkstaGetInfo");
-    }
-    EXTEND(SP,1);
-    if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) {
-	/* this way is more reliable, in case user has a local account. */
-	char dname[256];
-	DWORD dnamelen = sizeof(dname);
-	struct {
-	    DWORD   wki100_platform_id;
-	    LPWSTR  wki100_computername;
-	    LPWSTR  wki100_langroup;
-	    DWORD   wki100_ver_major;
-	    DWORD   wki100_ver_minor;
-	} *pwi;
-	/* NERR_Success *is* 0*/
-	if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) {
-	    if (pwi->wki100_langroup && *(pwi->wki100_langroup)) {
-		WideCharToMultiByte(CP_ACP, 0, pwi->wki100_langroup,
-				    -1, (LPSTR)dname, dnamelen, NULL, NULL);
-	    }
-	    else {
-		WideCharToMultiByte(CP_ACP, 0, pwi->wki100_computername,
-				    -1, (LPSTR)dname, dnamelen, NULL, NULL);
-	    }
-	    pfnNetApiBufferFree(pwi);
-	    FreeLibrary(hNetApi32);
-	    XSRETURN_PV(dname);
-	}
-	FreeLibrary(hNetApi32);
-    }
-    else {
-	/* Win95 doesn't have NetWksta*(), so do it the old way */
-	char name[256];
-	DWORD size = sizeof(name);
-	if (hNetApi32)
-	    FreeLibrary(hNetApi32);
-	if (GetUserName(name,&size)) {
-	    char sid[ONE_K_BUFSIZE];
-	    DWORD sidlen = sizeof(sid);
-	    char dname[256];
-	    DWORD dnamelen = sizeof(dname);
-	    SID_NAME_USE snu;
-	    if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen,
-				  dname, &dnamelen, &snu)) {
-		XSRETURN_PV(dname);		/* all that for this */
-	    }
-	}
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_FsType)
-{
-    dXSARGS;
-    char fsname[256];
-    DWORD flags, filecomplen;
-    if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
-			 &flags, fsname, sizeof(fsname))) {
-	if (GIMME_V == G_ARRAY) {
-	    XPUSHs(sv_2mortal(newSVpvn(fsname,strlen(fsname))));
-	    XPUSHs(sv_2mortal(newSViv(flags)));
-	    XPUSHs(sv_2mortal(newSViv(filecomplen)));
-	    PUTBACK;
-	    return;
-	}
-	EXTEND(SP,1);
-	XSRETURN_PV(fsname);
-    }
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_GetOSVersion)
-{
-    dXSARGS;
-    /* Use explicit struct definition because wSuiteMask and
-     * wProductType are not defined in the VC++ 6.0 headers.
-     * WORD type has been replaced by unsigned short because
-     * WORD is already used by Perl itself.
-     */
-    struct {
-        DWORD dwOSVersionInfoSize;
-        DWORD dwMajorVersion;
-        DWORD dwMinorVersion;
-        DWORD dwBuildNumber;
-        DWORD dwPlatformId;
-        CHAR  szCSDVersion[128];
-        unsigned short wServicePackMajor;
-        unsigned short wServicePackMinor;
-        unsigned short wSuiteMask;
-        BYTE  wProductType;
-        BYTE  wReserved;
-    }   osver;
-    BOOL bEx = TRUE;
-
-    osver.dwOSVersionInfoSize = sizeof(osver);
-    if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
-        bEx = FALSE;
-        osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
-        if (!GetVersionExA((OSVERSIONINFOA*)&osver)) {
-            XSRETURN_EMPTY;
-        }
-    }
-    if (GIMME_V == G_SCALAR) {
-        XSRETURN_IV(osver.dwPlatformId);
-    }
-    XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
-
-    XPUSHs(newSViv(osver.dwMajorVersion));
-    XPUSHs(newSViv(osver.dwMinorVersion));
-    XPUSHs(newSViv(osver.dwBuildNumber));
-    XPUSHs(newSViv(osver.dwPlatformId));
-    if (bEx) {
-        XPUSHs(newSViv(osver.wServicePackMajor));
-        XPUSHs(newSViv(osver.wServicePackMinor));
-        XPUSHs(newSViv(osver.wSuiteMask));
-        XPUSHs(newSViv(osver.wProductType));
-    }
-    PUTBACK;
-}
-
-static
-XS(w32_IsWinNT)
-{
-    dXSARGS;
-    EXTEND(SP,1);
-    XSRETURN_IV(IsWinNT());
-}
-
-static
-XS(w32_IsWin95)
-{
-    dXSARGS;
-    EXTEND(SP,1);
-    XSRETURN_IV(IsWin95());
-}
-
-static
-XS(w32_FormatMessage)
-{
-    dXSARGS;
-    DWORD source = 0;
-    char msgbuf[ONE_K_BUFSIZE];
-
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)");
-
-    if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
-                       &source, SvIV(ST(0)), 0,
-                       msgbuf, sizeof(msgbuf)-1, NULL))
-    {
-        XSRETURN_PV(msgbuf);
-    }
-
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_Spawn)
-{
-    dXSARGS;
-    char *cmd, *args;
-    void *env;
-    char *dir;
-    PROCESS_INFORMATION stProcInfo;
-    STARTUPINFO stStartInfo;
-    BOOL bSuccess = FALSE;
-
-    if (items != 3)
-	Perl_croak(aTHX_ "usage: Win32::Spawn($cmdName, $args, $PID)");
-
-    cmd = SvPV_nolen(ST(0));
-    args = SvPV_nolen(ST(1));
-
-    env = PerlEnv_get_childenv();
-    dir = PerlEnv_get_childdir();
-
-    memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
-    stStartInfo.cb = sizeof(stStartInfo);	    /* Set the structure size */
-    stStartInfo.dwFlags = STARTF_USESHOWWINDOW;	    /* Enable wShowWindow control */
-    stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
-
-    if (CreateProcess(
-		cmd,			/* Image path */
-		args,	 		/* Arguments for command line */
-		NULL,			/* Default process security */
-		NULL,			/* Default thread security */
-		FALSE,			/* Must be TRUE to use std handles */
-		NORMAL_PRIORITY_CLASS,	/* No special scheduling */
-		env,			/* Inherit our environment block */
-		dir,			/* Inherit our currrent directory */
-		&stStartInfo,		/* -> Startup info */
-		&stProcInfo))		/* <- Process info (if OK) */
-    {
-	int pid = (int)stProcInfo.dwProcessId;
-	if (IsWin95() && pid < 0)
-	    pid = -pid;
-	sv_setiv(ST(2), pid);
-	CloseHandle(stProcInfo.hThread);/* library source code does this. */
-	bSuccess = TRUE;
-    }
-    PerlEnv_free_childenv(env);
-    PerlEnv_free_childdir(dir);
-    XSRETURN_IV(bSuccess);
-}
-
-static
-XS(w32_GetTickCount)
-{
-    dXSARGS;
-    DWORD msec = GetTickCount();
-    EXTEND(SP,1);
-    if ((IV)msec > 0)
-	XSRETURN_IV(msec);
-    XSRETURN_NV(msec);
-}
-
-static
-XS(w32_GetShortPathName)
-{
-    dXSARGS;
-    SV *shortpath;
-    DWORD len;
-
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::GetShortPathName($longPathName)");
-
-    shortpath = sv_mortalcopy(ST(0));
-    SvUPGRADE(shortpath, SVt_PV);
-    if (!SvPVX(shortpath) || !SvLEN(shortpath))
-        XSRETURN_UNDEF;
-
-    /* src == target is allowed */
-    do {
-	len = GetShortPathName(SvPVX(shortpath),
-			       SvPVX(shortpath),
-			       SvLEN(shortpath));
-    } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
-    if (len) {
-	SvCUR_set(shortpath,len);
-	*SvEND(shortpath) = '\0';
-	ST(0) = shortpath;
-	XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetFullPathName)
-{
-    dXSARGS;
-    SV *filename;
-    SV *fullpath;
-    char *filepart;
-    DWORD len;
-    STRLEN filename_len;
-    char *filename_p;
-
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
-
-    filename = ST(0);
-    filename_p = SvPV(filename, filename_len);
-    fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
-    if (!SvPVX(fullpath) || !SvLEN(fullpath))
-        XSRETURN_UNDEF;
-
-    do {
-	len = GetFullPathName(SvPVX(filename),
-			      SvLEN(fullpath),
-			      SvPVX(fullpath),
-			      &filepart);
-    } while (len >= SvLEN(fullpath) && sv_grow(fullpath,len+1));
-    if (len) {
-	if (GIMME_V == G_ARRAY) {
-	    EXTEND(SP,1);
-	    if (filepart) {
-		XST_mPV(1,filepart);
-		len = filepart - SvPVX(fullpath);
-	    }
-	    else {
-		XST_mPVN(1,"",0);
-	    }
-	    items = 2;
-	}
-	SvCUR_set(fullpath,len);
-	*SvEND(fullpath) = '\0';
-	ST(0) = fullpath;
-	XSRETURN(items);
-    }
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_GetLongPathName)
-{
-    dXSARGS;
-    SV *path;
-    char tmpbuf[MAX_PATH+1];
-    char *pathstr;
-    STRLEN len;
-
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::GetLongPathName($pathname)");
-
-    path = ST(0);
-    pathstr = SvPV(path,len);
-    strcpy(tmpbuf, pathstr);
-    pathstr = win32_longpath(tmpbuf);
-    if (pathstr) {
-	ST(0) = sv_2mortal(newSVpvn(pathstr, strlen(pathstr)));
-	XSRETURN(1);
-    }
-    XSRETURN_EMPTY;
-}
-
-static
-XS(w32_Sleep)
-{
-    dXSARGS;
-    if (items != 1)
-	Perl_croak(aTHX_ "usage: Win32::Sleep($milliseconds)");
-    Sleep(SvIV(ST(0)));
-    XSRETURN_YES;
-}
-
-static
-XS(w32_CopyFile)
+static void
+forward(pTHX_ const char *function)
 {
     dXSARGS;
-    BOOL bResult;
-    char szSourceFile[MAX_PATH+1];
-
-    if (items != 3)
-	Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)");
-    strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0))));
-    bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2)));
-    if (bResult)
-	XSRETURN_YES;
-    XSRETURN_NO;
-}
+    Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("Win32",5), NULL);
+    PUSHMARK(SP-items);
+    call_pv(function, GIMME_V);
+}
+
+#define FORWARD(function) XS(w32_##function){ forward(aTHX_ "Win32::"#function); }
+FORWARD(GetCwd)
+FORWARD(SetCwd)
+FORWARD(GetNextAvailDrive)
+FORWARD(GetLastError)
+FORWARD(SetLastError)
+FORWARD(LoginName)
+FORWARD(NodeName)
+FORWARD(DomainName)
+FORWARD(FsType)
+FORWARD(GetOSVersion)
+FORWARD(IsWinNT)
+FORWARD(IsWin95)
+FORWARD(FormatMessage)
+FORWARD(Spawn)
+FORWARD(GetTickCount)
+FORWARD(GetShortPathName)
+FORWARD(GetFullPathName)
+FORWARD(GetLongPathName)
+FORWARD(CopyFile)
+FORWARD(Sleep)
+FORWARD(SetChildShowWindow)
+#undef FORWARD
 
 void
 Perl_init_os_extras(void)
@@ -4792,17 +4330,6 @@ Perl_init_os_extras(void)
     newXS("Win32::CopyFile", w32_CopyFile, file);
     newXS("Win32::Sleep", w32_Sleep, file);
     newXS("Win32::SetChildShowWindow", w32_SetChildShowWindow, file);
-
-    /* XXX Bloat Alert! The following Activeware preloads really
-     * ought to be part of Win32::Sys::*, so they're not included
-     * here.
-     */
-    /* LookupAccountName
-     * LookupAccountSID
-     * InitiateSystemShutdown
-     * AbortSystemShutdown
-     * ExpandEnvrironmentStrings
-     */
 }
 
 void *