X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fperllib.c;h=c24941f11133cce3e0a1bbd98eaf0724702ea83d;hb=bbc8f9de328519d89fa89d8fca21fe808800d6a2;hp=0f63938f5c4e5e3cf58058e9fdb76552085f9f46;hpb=7bac28a0157dcaf170649e8928f053f76dda4253;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/perllib.c b/win32/perllib.c index 0f63938..c24941f 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -2,21 +2,11 @@ * "The Road goes ever on and on, down from the door where it began." */ -#ifdef __cplusplus -extern "C" { -#endif #include "EXTERN.h" #include "perl.h" #include "XSUB.h" -#ifdef __cplusplus -} -# define EXTERN_C extern "C" -#else -# define EXTERN_C extern -#endif - static void xs_init _((void)); __declspec(dllexport) int @@ -24,9 +14,10 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem) { int exitstatus; PerlInterpreter *my_perl; - void *pOldIOSubsystem; - pOldIOSubsystem = SetIOSubSystem(iosubsystem); +#ifdef USE_THREADS + MUTEX_INIT(&malloc_mutex); +#endif PERL_SYS_INIT(&argc,&argv); @@ -47,8 +38,6 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem) PERL_SYS_TERM(); - SetIOSubSystem(pOldIOSubsystem); - return (exitstatus); } @@ -66,10 +55,10 @@ DllMain(HANDLE hModule, /* DLL module handle */ case DLL_PROCESS_ATTACH: /* #define DEFAULT_BINMODE */ #ifdef DEFAULT_BINMODE - _setmode( _fileno( stdin ), _O_BINARY ); - _setmode( _fileno( stdout ), _O_BINARY ); - _setmode( _fileno( stderr ), _O_BINARY ); - _fmode = _O_BINARY; + setmode( fileno( stdin ), O_BINARY ); + setmode( fileno( stdout ), O_BINARY ); + setmode( fileno( stderr ), O_BINARY ); + _fmode = O_BINARY; #endif PerlDllHandle = hModule; break; @@ -103,284 +92,11 @@ char *staticlinkmodules[] = { EXTERN_C void boot_DynaLoader _((CV* cv)); -static -XS(w32_GetCwd) -{ - dXSARGS; - SV *sv = sv_newmortal(); - /* Make one call with zero size - return value is required size */ - DWORD len = GetCurrentDirectory((DWORD)0,NULL); - SvUPGRADE(sv,SVt_PV); - SvGROW(sv,len); - SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv)); - /* - * If result != 0 - * then it worked, set PV valid, - * else leave it 'undef' - */ - if (SvCUR(sv)) - SvPOK_on(sv); - EXTEND(sp,1); - ST(0) = sv; - XSRETURN(1); -} - -static -XS(w32_SetCwd) -{ - dXSARGS; - if (items != 1) - croak("usage: Win32::SetCurrentDirectory($cwd)"); - if (SetCurrentDirectory(SvPV(ST(0),na))) - XSRETURN_YES; - - XSRETURN_NO; -} - -static -XS(w32_GetNextAvailDrive) -{ - dXSARGS; - char ix = 'C'; - char root[] = "_:\\"; - while (ix <= 'Z') { - root[0] = ix++; - if (GetDriveType(root) == 1) { - root[2] = '\0'; - XSRETURN_PV(root); - } - } - XSRETURN_UNDEF; -} - -static -XS(w32_GetLastError) -{ - dXSARGS; - XSRETURN_IV(GetLastError()); -} - -static -XS(w32_LoginName) -{ - dXSARGS; - char name[256]; - DWORD size = sizeof(name); - if (GetUserName(name,&size)) { - /* size includes NULL */ - ST(0) = sv_2mortal(newSVpv(name,size-1)); - XSRETURN(1); - } - XSRETURN_UNDEF; -} - -static -XS(w32_NodeName) -{ - dXSARGS; - char name[MAX_COMPUTERNAME_LENGTH+1]; - DWORD size = sizeof(name); - if (GetComputerName(name,&size)) { - /* size does NOT include NULL :-( */ - ST(0) = sv_2mortal(newSVpv(name,size)); - XSRETURN(1); - } - XSRETURN_UNDEF; -} - - -static -XS(w32_DomainName) -{ - dXSARGS; - char name[256]; - DWORD size = sizeof(name); - if (GetUserName(name,&size)) { - char sid[1024]; - DWORD sidlen = sizeof(sid); - char dname[256]; - DWORD dnamelen = sizeof(dname); - SID_NAME_USE snu; - if (LookupAccountName(NULL, name, &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 == G_ARRAY) { - XPUSHs(sv_2mortal(newSVpv(fsname,0))); - XPUSHs(sv_2mortal(newSViv(flags))); - XPUSHs(sv_2mortal(newSViv(filecomplen))); - PUTBACK; - return; - } - XSRETURN_PV(fsname); - } - XSRETURN_UNDEF; -} - -static -XS(w32_GetOSVersion) -{ - dXSARGS; - OSVERSIONINFO osver; - - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - if (GetVersionEx(&osver)) { - XPUSHs(newSVpv(osver.szCSDVersion, 0)); - XPUSHs(newSViv(osver.dwMajorVersion)); - XPUSHs(newSViv(osver.dwMinorVersion)); - XPUSHs(newSViv(osver.dwBuildNumber)); - XPUSHs(newSViv(osver.dwPlatformId)); - PUTBACK; - return; - } - XSRETURN_UNDEF; -} - -static -XS(w32_IsWinNT) -{ - dXSARGS; - XSRETURN_IV(IsWinNT()); -} - -static -XS(w32_IsWin95) -{ - dXSARGS; - XSRETURN_IV(IsWin95()); -} - -static -XS(w32_FormatMessage) -{ - dXSARGS; - DWORD source = 0; - char msgbuf[1024]; - - if (items != 1) - croak("usage: Win32::FormatMessage($errno)"); - - if (FormatMessage(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; - PROCESS_INFORMATION stProcInfo; - STARTUPINFO stStartInfo; - BOOL bSuccess = FALSE; - - if(items != 3) - croak("usage: Win32::Spawn($cmdName, $args, $PID)"); - - cmd = SvPV(ST(0),na); - args = SvPV(ST(1), na); - - 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 */ - NULL, /* Inherit our environment block */ - NULL, /* Inherit our currrent directory */ - &stStartInfo, /* -> Startup info */ - &stProcInfo)) /* <- Process info (if OK) */ - { - CloseHandle(stProcInfo.hThread);/* library source code does this. */ - sv_setiv(ST(2), stProcInfo.dwProcessId); - bSuccess = TRUE; - } - XSRETURN_IV(bSuccess); -} - -static -XS(w32_GetTickCount) -{ - dXSARGS; - XSRETURN_IV(GetTickCount()); -} - -static -XS(w32_GetShortPathName) -{ - dXSARGS; - SV *shortpath; - - if(items != 1) - croak("usage: Win32::GetShortPathName($longPathName)"); - - shortpath = sv_mortalcopy(ST(0)); - SvUPGRADE(shortpath, SVt_PV); - /* src == target is allowed */ - if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath))) - ST(0) = shortpath; - else - ST(0) = &sv_undef; - XSRETURN(1); -} - static void xs_init() { char *file = __FILE__; dXSUB_SYS; newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); - - /* XXX should be removed after checking with Nick */ - newXS("Win32::GetCurrentDirectory", w32_GetCwd, file); - - /* these names are Activeware compatible */ - newXS("Win32::GetCwd", w32_GetCwd, file); - newXS("Win32::SetCwd", w32_SetCwd, file); - newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file); - newXS("Win32::GetLastError", w32_GetLastError, file); - newXS("Win32::LoginName", w32_LoginName, file); - newXS("Win32::NodeName", w32_NodeName, file); - newXS("Win32::DomainName", w32_DomainName, file); - newXS("Win32::FsType", w32_FsType, file); - newXS("Win32::GetOSVersion", w32_GetOSVersion, file); - newXS("Win32::IsWinNT", w32_IsWinNT, file); - newXS("Win32::IsWin95", w32_IsWin95, file); - newXS("Win32::FormatMessage", w32_FormatMessage, file); - newXS("Win32::Spawn", w32_Spawn, file); - newXS("Win32::GetTickCount", w32_GetTickCount, file); - newXS("Win32::GetShortPathName", w32_GetShortPathName, 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 - */ }