[p5sagit/p5-mst-13.2.git] / win32 / ipstdio.c

/*

	ipstdio.c
	Interface for perl stdio functions

*/

#include "ipstdiowin.h"
#include <stdio.h>

class CPerlStdIO : public IPerlStdIOWin
{
public:
	CPerlStdIO()
	{
		pPerl = NULL;
		pSock = NULL;
		w32_platform = -1;
		ZeroMemory(bSocketTable, sizeof(bSocketTable));
	};
	virtual PerlIO* Stdin(void);
	virtual PerlIO* Stdout(void);
	virtual PerlIO* Stderr(void);
	virtual PerlIO* Open(const char *, const char *, int &err);
	virtual int Close(PerlIO*, int &err);
	virtual int Eof(PerlIO*, int &err);
	virtual int Error(PerlIO*, int &err);
	virtual void Clearerr(PerlIO*, int &err);
	virtual int Getc(PerlIO*, int &err);
	virtual char* GetBase(PerlIO *, int &err);
	virtual int GetBufsiz(PerlIO *, int &err);
	virtual int GetCnt(PerlIO *, int &err);
	virtual char* GetPtr(PerlIO *, int &err);
	virtual int Putc(PerlIO*, int, int &err);
	virtual int Puts(PerlIO*, const char *, int &err);
	virtual int Flush(PerlIO*, int &err);
	virtual int Ungetc(PerlIO*,int, int &err);
	virtual int Fileno(PerlIO*, int &err);
	virtual PerlIO* Fdopen(int, const char *, int &err);
	virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err);
	virtual SSize_t Read(PerlIO*,void *,Size_t, int &err);
	virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err);
	virtual void SetBuf(PerlIO *, char*, int &err);
	virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err);
	virtual void SetCnt(PerlIO *, int, int &err);
	virtual void SetPtrCnt(PerlIO *, char *, int, int& err);
	virtual void Setlinebuf(PerlIO*, int &err);
	virtual int Printf(PerlIO*, int &err, const char *,...);
	virtual int Vprintf(PerlIO*, int &err, const char *, va_list);
	virtual long Tell(PerlIO*, int &err);
	virtual int Seek(PerlIO*, off_t, int, int &err);
	virtual void Rewind(PerlIO*, int &err);
	virtual PerlIO*	Tmpfile(int &err);
	virtual int Getpos(PerlIO*, Fpos_t *, int &err);
	virtual int Setpos(PerlIO*, const Fpos_t *, int &err);
	virtual void Init(int &err);
	virtual void InitOSExtras(void* p);
	virtual int OpenOSfhandle(long osfhandle, int flags);
	virtual int GetOSfhandle(int filenum);

	void ShutDown(void);

	inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
	inline void SetSockCtl(CPerlSock *p) { pSock = p; };
protected:
	inline int IsWin95(void)
	{
		return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
	};
	inline int IsWinNT(void)
	{
		return (os_id() == VER_PLATFORM_WIN32_NT);
	};
	inline void AddToSocketTable(int fh)
	{
		if(fh < _NSTREAM_)
			bSocketTable[fh] = TRUE;
	};
	inline BOOL InSocketTable(int fh)
	{
		if(fh < _NSTREAM_)
			return bSocketTable[fh];
		return FALSE;
	};
	inline void RemoveFromSocketTable(int fh)
	{
		if(fh < _NSTREAM_)
			bSocketTable[fh] = FALSE;
	};
	DWORD os_id(void)
	{
		if((-1) == w32_platform)
		{
			OSVERSIONINFO osver;

			memset(&osver, 0, sizeof(OSVERSIONINFO));
			osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
			GetVersionEx(&osver);
			w32_platform = osver.dwPlatformId;
		}
		return (w32_platform);
	};


	CPerlObj *pPerl;
	CPerlSock *pSock;
	DWORD w32_platform;
	BOOL bSocketTable[_NSTREAM_];
};

void CPerlStdIO::ShutDown(void)
{
	int i, err;
	for(i = 0; i < _NSTREAM_; ++i)
	{
		if(InSocketTable(i))
			pSock->CloseSocket(i, err);
	}
};

#ifdef _X86_
extern "C" int __cdecl _alloc_osfhnd(void);
extern "C" int __cdecl _set_osfhnd(int fh, long value);
extern "C" void __cdecl _unlock(int);

#if (_MSC_VER >= 1000)
typedef struct
{
	long osfhnd;    /* underlying OS file HANDLE */
	char osfile;    /* attributes of file (e.g., open in text mode?) */
	char pipech;    /* one char buffer for handles opened on pipes */
}	ioinfo;
extern "C" ioinfo * __pioinfo[];
#define IOINFO_L2E			5
#define IOINFO_ARRAY_ELTS	(1 << IOINFO_L2E)
#define _pioinfo(i)	(__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
#define _osfile(i)	(_pioinfo(i)->osfile)
#else
extern "C" extern char _osfile[];
#endif	// (_MSC_VER >= 1000)

#define FOPEN			0x01	// file handle open
#define FAPPEND			0x20	// file handle opened O_APPEND
#define FDEV			0x40	// file handle refers to device
#define FTEXT			0x80	// file handle is in text mode

#define _STREAM_LOCKS   26		// Table of stream locks
#define _LAST_STREAM_LOCK  (_STREAM_LOCKS+_NSTREAM_-1)	// Last stream lock
#define _FH_LOCKS          (_LAST_STREAM_LOCK+1)		// Table of fh locks
#endif	// _X86_

int CPerlStdIO::OpenOSfhandle(long osfhandle, int flags)
{
	int fh;

#ifdef _X86_
	if(IsWin95())
	{
		// all this is here to handle Win95's GetFileType bug.
		char fileflags;		// _osfile flags 

		// copy relevant flags from second parameter 
		fileflags = FDEV;

		if(flags & _O_APPEND)
			fileflags |= FAPPEND;

		if(flags & _O_TEXT)
			fileflags |= FTEXT;

		// attempt to allocate a C Runtime file handle
		if((fh = _alloc_osfhnd()) == -1)
		{
			errno = EMFILE;		// too many open files 
			_doserrno = 0L;		// not an OS error
			return -1;			// return error to caller
		}

		// the file is open. now, set the info in _osfhnd array
		_set_osfhnd(fh, osfhandle);

		fileflags |= FOPEN;			// mark as open

#if (_MSC_VER >= 1000)
		_osfile(fh) = fileflags;	// set osfile entry
#else
		_osfile[fh] = fileflags;	// set osfile entry
#endif
	}
	else
#endif	// _X86_
	fh = _open_osfhandle(osfhandle, flags);

	if(fh >= 0)
		AddToSocketTable(fh);

	return fh;					// return handle
}

int CPerlStdIO::GetOSfhandle(int filenum)
{
	return _get_osfhandle(filenum);
}

PerlIO* CPerlStdIO::Stdin(void)
{
    return (PerlIO*)(&_iob[0]);
}

PerlIO* CPerlStdIO::Stdout(void)
{
    return (PerlIO*)(&_iob[1]);
}

PerlIO* CPerlStdIO::Stderr(void)
{
    return (PerlIO*)(&_iob[2]);
}

PerlIO* CPerlStdIO::Open(const char *path, const char *mode, int &err)
{
	PerlIO* ret = NULL;
	if(*path != '\0')
	{
	    if(stricmp(path, "/dev/null") == 0)
			ret = (PerlIO*)fopen("NUL", mode);
		else
			ret = (PerlIO*)fopen(path, mode);

		if(errno)
			err = errno;
	}
	else
		err = EINVAL;		
	return ret;
}

extern "C" int _free_osfhnd(int fh);
int CPerlStdIO::Close(PerlIO* pf, int &err)
{
	int ret = 0, fileNo = fileno((FILE*)pf);
	if(InSocketTable(fileNo))
	{
		RemoveFromSocketTable(fileNo);
		pSock->CloseSocket(fileNo, err);
		_free_osfhnd(fileNo);
		fclose((FILE*)pf);
	}
	else
		ret = fclose((FILE*)pf);

	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Eof(PerlIO* pf, int &err)
{
	int ret = feof((FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Error(PerlIO* pf, int &err)
{
	int ret = ferror((FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

void CPerlStdIO::Clearerr(PerlIO* pf, int &err)
{
	clearerr((FILE*)pf);
	err = 0;
}

int CPerlStdIO::Getc(PerlIO* pf, int &err)
{
	int ret = fgetc((FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Putc(PerlIO* pf, int c, int &err)
{
	int ret = fputc(c, (FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Puts(PerlIO* pf, const char *s, int &err)
{
	int ret = fputs(s, (FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Flush(PerlIO* pf, int &err)
{
	int ret = fflush((FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Ungetc(PerlIO* pf,int c, int &err)
{
	int ret = ungetc(c, (FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Fileno(PerlIO* pf, int &err)
{
	int ret = fileno((FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

PerlIO* CPerlStdIO::Fdopen(int fh, const char *mode, int &err)
{
	PerlIO* ret = (PerlIO*)fdopen(fh, mode);
	if(errno)
		err = errno;
	return ret;
}

PerlIO* CPerlStdIO::Reopen(const char* filename, const char* mode, PerlIO* pf, int &err)
{
	PerlIO* ret = (PerlIO*)freopen(filename, mode, (FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

SSize_t CPerlStdIO::Read(PerlIO* pf, void * buffer, Size_t count, int &err)
{
	size_t ret = fread(buffer, 1, count, (FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

SSize_t CPerlStdIO::Write(PerlIO* pf, const void * buffer, Size_t count, int &err)
{
	size_t ret = fwrite(buffer, 1, count, (FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

void CPerlStdIO::Setlinebuf(PerlIO*pf, int &err)
{
    setvbuf((FILE*)pf, NULL, _IOLBF, 0);
}

int CPerlStdIO::Printf(PerlIO* pf, int &err, const char *format, ...)
{
	va_list(arglist);
	va_start(arglist, format);
	int ret = Vprintf(pf, err, format, arglist);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Vprintf(PerlIO* pf, int &err, const char * format, va_list arg)
{
	int ret = vfprintf((FILE*)pf, format, arg);
	if(errno)
		err = errno;
	return ret;
}

long CPerlStdIO::Tell(PerlIO* pf, int &err)
{
	long ret = ftell((FILE*)pf);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Seek(PerlIO* pf, off_t offset, int origin, int &err)
{
	int ret = fseek((FILE*)pf, offset, origin);
	if(errno)
		err = errno;
	return ret;
}

void CPerlStdIO::Rewind(PerlIO* pf, int &err)
{
	rewind((FILE*)pf);
}

PerlIO*	CPerlStdIO::Tmpfile(int &err)
{
	return (PerlIO*)tmpfile();
}

int CPerlStdIO::Getpos(PerlIO* pf, Fpos_t *p, int &err)
{
	int ret = fgetpos((FILE*)pf, (fpos_t*)p);
	if(errno)
		err = errno;
	return ret;
}

int CPerlStdIO::Setpos(PerlIO* pf, const Fpos_t *p, int &err)
{
	int ret = fsetpos((FILE*)pf, (fpos_t*)p);
	if(errno)
		err = errno;
	return ret;
}

char* CPerlStdIO::GetBase(PerlIO *pf, int &err)
{
	return ((FILE*)pf)->_base;
}

int CPerlStdIO::GetBufsiz(PerlIO *pf, int &err)
{
	return ((FILE*)pf)->_bufsiz;
}

int CPerlStdIO::GetCnt(PerlIO *pf, int &err)
{
	return ((FILE*)pf)->_cnt;
}

char* CPerlStdIO::GetPtr(PerlIO *pf, int &err)
{
	return ((FILE*)pf)->_ptr;
}

void CPerlStdIO::SetBuf(PerlIO *pf, char* buffer, int &err)
{
    setbuf((FILE*)pf, buffer);
}

int CPerlStdIO::SetVBuf(PerlIO *pf, char* buffer, int type, Size_t size, int &err)
{
    return setvbuf((FILE*)pf, buffer, type, size);
}

void CPerlStdIO::SetCnt(PerlIO *pf, int n, int &err)
{
	((FILE*)pf)->_cnt = n;
}

void CPerlStdIO::SetPtrCnt(PerlIO *pf, char *ptr, int n, int& err)
{
	((FILE*)pf)->_ptr = ptr;
	((FILE*)pf)->_cnt = n;
}

void CPerlStdIO::Init(int &err)
{
}


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 szBuffer[128];
    DWORD size = sizeof(szBuffer);
    if (GetUserName(szBuffer, &size)) {
	/* size includes NULL */
	ST(0) = sv_2mortal(newSVpv(szBuffer,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;
	OSVERSIONINFO osver;
	memset(&osver, 0, sizeof(OSVERSIONINFO));
	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
	GetVersionEx(&osver);
    XSRETURN_IV(VER_PLATFORM_WIN32_NT == osver.dwPlatformId);
}

static
XS(w32_IsWin95)
{
    dXSARGS;
	OSVERSIONINFO osver;
	memset(&osver, 0, sizeof(OSVERSIONINFO));
	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
	GetVersionEx(&osver);
    XSRETURN_IV(VER_PLATFORM_WIN32_WINDOWS == osver.dwPlatformId);
}

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;
    DWORD len;

    if(items != 1)
	croak("usage: Win32::GetShortPathName($longPathName)");

    shortpath = sv_mortalcopy(ST(0));
    SvUPGRADE(shortpath, SVt_PV);
    /* 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);
	ST(0) = shortpath;
    }
    else
	ST(0) = &sv_undef;
    XSRETURN(1);
}


void CPerlStdIO::InitOSExtras(void* p)
{
    char *file = __FILE__;
    dXSUB_SYS;

    /* 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);

}
Commit	Line	Data
76e3520e	1	/*
	2
	3	ipstdio.c
	4	Interface for perl stdio functions
	5
	6	*/
	7
	8	#include "ipstdiowin.h"
	9	#include <stdio.h>
	10
	11	class CPerlStdIO : public IPerlStdIOWin
	12	{
	13	public:
	14	CPerlStdIO()
	15	{
	16	pPerl = NULL;
	17	pSock = NULL;
	18	w32_platform = -1;
565764a8	19	ZeroMemory(bSocketTable, sizeof(bSocketTable));
76e3520e	20	};
	21	virtual PerlIO* Stdin(void);
	22	virtual PerlIO* Stdout(void);
	23	virtual PerlIO* Stderr(void);
	24	virtual PerlIO* Open(const char , const char , int &err);
	25	virtual int Close(PerlIO*, int &err);
	26	virtual int Eof(PerlIO*, int &err);
	27	virtual int Error(PerlIO*, int &err);
	28	virtual void Clearerr(PerlIO*, int &err);
	29	virtual int Getc(PerlIO*, int &err);
	30	virtual char* GetBase(PerlIO *, int &err);
	31	virtual int GetBufsiz(PerlIO *, int &err);
	32	virtual int GetCnt(PerlIO *, int &err);
	33	virtual char* GetPtr(PerlIO *, int &err);
	34	virtual int Putc(PerlIO*, int, int &err);
	35	virtual int Puts(PerlIO, const char , int &err);
	36	virtual int Flush(PerlIO*, int &err);
	37	virtual int Ungetc(PerlIO*,int, int &err);
	38	virtual int Fileno(PerlIO*, int &err);
	39	virtual PerlIO* Fdopen(int, const char *, int &err);
565764a8	40	virtual PerlIO* Reopen(const char, const char, PerlIO*, int &err);
76e3520e	41	virtual SSize_t Read(PerlIO,void ,Size_t, int &err);
76e3520e	42	virtual SSize_t Write(PerlIO,const void ,Size_t, int &err);
565764a8	43	virtual void SetBuf(PerlIO , char, int &err);
565764a8	44	virtual int SetVBuf(PerlIO , char, int, Size_t, int &err);
76e3520e	45	virtual void SetCnt(PerlIO *, int, int &err);
	46	virtual void SetPtrCnt(PerlIO , char , int, int& err);
	47	virtual void Setlinebuf(PerlIO*, int &err);
	48	virtual int Printf(PerlIO, int &err, const char ,...);
	49	virtual int Vprintf(PerlIO, int &err, const char , va_list);
	50	virtual long Tell(PerlIO*, int &err);
	51	virtual int Seek(PerlIO*, off_t, int, int &err);
	52	virtual void Rewind(PerlIO*, int &err);
	53	virtual PerlIO* Tmpfile(int &err);
	54	virtual int Getpos(PerlIO, Fpos_t , int &err);
	55	virtual int Setpos(PerlIO, const Fpos_t , int &err);
	56	virtual void Init(int &err);
	57	virtual void InitOSExtras(void* p);
	58	virtual int OpenOSfhandle(long osfhandle, int flags);
	59	virtual int GetOSfhandle(int filenum);
	60
	61	void ShutDown(void);
	62
	63	inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
	64	inline void SetSockCtl(CPerlSock *p) { pSock = p; };
	65	protected:
	66	inline int IsWin95(void)
	67	{
	68	return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
	69	};
	70	inline int IsWinNT(void)
	71	{
	72	return (os_id() == VER_PLATFORM_WIN32_NT);
	73	};
	74	inline void AddToSocketTable(int fh)
	75	{
	76	if(fh < _NSTREAM_)
	77	bSocketTable[fh] = TRUE;
	78	};
	79	inline BOOL InSocketTable(int fh)
	80	{
	81	if(fh < _NSTREAM_)
	82	return bSocketTable[fh];
	83	return FALSE;
	84	};
	85	inline void RemoveFromSocketTable(int fh)
	86	{
	87	if(fh < _NSTREAM_)
	88	bSocketTable[fh] = FALSE;
	89	};
	90	DWORD os_id(void)
	91	{
	92	if((-1) == w32_platform)
	93	{
	94	OSVERSIONINFO osver;
	95
	96	memset(&osver, 0, sizeof(OSVERSIONINFO));
	97	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
	98	GetVersionEx(&osver);
	99	w32_platform = osver.dwPlatformId;
	100	}
	101	return (w32_platform);
	102	};
	103
	104
	105	CPerlObj *pPerl;
	106	CPerlSock *pSock;
	107	DWORD w32_platform;
	108	BOOL bSocketTable[_NSTREAM_];
109	};
110
111	void CPerlStdIO::ShutDown(void)
112	{
113	int i, err;
114	for(i = 0; i < _NSTREAM_; ++i)
115	{
116	if(InSocketTable(i))
117	pSock->CloseSocket(i, err);
118	}
119	};
120
121	#ifdef _X86_
122	extern "C" int __cdecl _alloc_osfhnd(void);
123	extern "C" int __cdecl _set_osfhnd(int fh, long value);
124	extern "C" void __cdecl _unlock(int);
125
126	#if (_MSC_VER >= 1000)
127	typedef struct
128	{
129	long osfhnd; /* underlying OS file HANDLE */
130	char osfile; /* attributes of file (e.g., open in text mode?) */
131	char pipech; /* one char buffer for handles opened on pipes */
132	} ioinfo;
133	extern "C" ioinfo * __pioinfo[];
134	#define IOINFO_L2E 5
135	#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E)
136	#define _pioinfo(i) (__pioinfo[i >> IOINFO_L2E] + (i & (IOINFO_ARRAY_ELTS - 1)))
137	#define _osfile(i) (_pioinfo(i)->osfile)
138	#else
139	extern "C" extern char _osfile[];
140	#endif // (_MSC_VER >= 1000)
141
142	#define FOPEN 0x01 // file handle open
143	#define FAPPEND 0x20 // file handle opened O_APPEND
144	#define FDEV 0x40 // file handle refers to device
145	#define FTEXT 0x80 // file handle is in text mode
146
147	#define _STREAM_LOCKS 26 // Table of stream locks
148	#define _LAST_STREAM_LOCK (_STREAM_LOCKS+_NSTREAM_-1) // Last stream lock
149	#define _FH_LOCKS (_LAST_STREAM_LOCK+1) // Table of fh locks
150	#endif // _X86_
151
152	int CPerlStdIO::OpenOSfhandle(long osfhandle, int flags)
153	{
154	int fh;
155
156	#ifdef _X86_
157	if(IsWin95())
158	{
159	// all this is here to handle Win95's GetFileType bug.
160	char fileflags; // _osfile flags
161
162	// copy relevant flags from second parameter
163	fileflags = FDEV;
164
165	if(flags & _O_APPEND)
166	fileflags \|= FAPPEND;
167
168	if(flags & _O_TEXT)
169	fileflags \|= FTEXT;
170
171	// attempt to allocate a C Runtime file handle
172	if((fh = _alloc_osfhnd()) == -1)
173	{
174	errno = EMFILE; // too many open files
175	_doserrno = 0L; // not an OS error
176	return -1; // return error to caller
177	}
178
179	// the file is open. now, set the info in _osfhnd array
180	_set_osfhnd(fh, osfhandle);
181
182	fileflags \|= FOPEN; // mark as open
183
184	#if (_MSC_VER >= 1000)
185	_osfile(fh) = fileflags; // set osfile entry
186	#else
187	_osfile[fh] = fileflags; // set osfile entry
188	#endif
189	}
190	else
191	#endif // _X86_
192	fh = _open_osfhandle(osfhandle, flags);
193
194	if(fh >= 0)
195	AddToSocketTable(fh);
196
197	return fh; // return handle
198	}
199
200	int CPerlStdIO::GetOSfhandle(int filenum)
201	{
202	return _get_osfhandle(filenum);
203	}
204
205	PerlIO* CPerlStdIO::Stdin(void)
206	{
207	return (PerlIO*)(&_iob[0]);
208	}
209
210	PerlIO* CPerlStdIO::Stdout(void)
211	{
212	return (PerlIO*)(&_iob[1]);
213	}
214
215	PerlIO* CPerlStdIO::Stderr(void)
216	{
217	return (PerlIO*)(&_iob[2]);
218	}
219
220	PerlIO* CPerlStdIO::Open(const char path, const char mode, int &err)
221	{
222	PerlIO* ret = NULL;
223	if(*path != '\0')
224	{
565764a8	225	if(stricmp(path, "/dev/null") == 0)
	226	ret = (PerlIO*)fopen("NUL", mode);
	227	else
	228	ret = (PerlIO*)fopen(path, mode);
	229
76e3520e	230	if(errno)
	231	err = errno;
	232	}
	233	else
	234	err = EINVAL;
	235	return ret;
	236	}
	237
	238	extern "C" int _free_osfhnd(int fh);
	239	int CPerlStdIO::Close(PerlIO* pf, int &err)
	240	{
	241	int ret = 0, fileNo = fileno((FILE*)pf);
	242	if(InSocketTable(fileNo))
	243	{
	244	RemoveFromSocketTable(fileNo);
	245	pSock->CloseSocket(fileNo, err);
	246	_free_osfhnd(fileNo);
	247	fclose((FILE*)pf);
	248	}
	249	else
	250	ret = fclose((FILE*)pf);
	251
	252	if(errno)
	253	err = errno;
	254	return ret;
	255	}
	256
	257	int CPerlStdIO::Eof(PerlIO* pf, int &err)
	258	{
	259	int ret = feof((FILE*)pf);
	260	if(errno)
	261	err = errno;
	262	return ret;
	263	}
	264
	265	int CPerlStdIO::Error(PerlIO* pf, int &err)
	266	{
	267	int ret = ferror((FILE*)pf);
	268	if(errno)
	269	err = errno;
	270	return ret;
	271	}
	272
	273	void CPerlStdIO::Clearerr(PerlIO* pf, int &err)
	274	{
	275	clearerr((FILE*)pf);
	276	err = 0;
	277	}
	278
	279	int CPerlStdIO::Getc(PerlIO* pf, int &err)
	280	{
	281	int ret = fgetc((FILE*)pf);
	282	if(errno)
	283	err = errno;
	284	return ret;
	285	}
	286
	287	int CPerlStdIO::Putc(PerlIO* pf, int c, int &err)
	288	{
	289	int ret = fputc(c, (FILE*)pf);
	290	if(errno)
	291	err = errno;
	292	return ret;
	293	}
294
295	int CPerlStdIO::Puts(PerlIO* pf, const char *s, int &err)
296	{
297	int ret = fputs(s, (FILE*)pf);
298	if(errno)
299	err = errno;
300	return ret;
301	}
302
303	int CPerlStdIO::Flush(PerlIO* pf, int &err)
304	{
305	int ret = fflush((FILE*)pf);
306	if(errno)
307	err = errno;
308	return ret;
309	}
310
311	int CPerlStdIO::Ungetc(PerlIO* pf,int c, int &err)
312	{
313	int ret = ungetc(c, (FILE*)pf);
314	if(errno)
315	err = errno;
316	return ret;
317	}
318
319	int CPerlStdIO::Fileno(PerlIO* pf, int &err)
320	{
321	int ret = fileno((FILE*)pf);
322	if(errno)
323	err = errno;
324	return ret;
325	}
326
327	PerlIO* CPerlStdIO::Fdopen(int fh, const char *mode, int &err)
328	{
329	PerlIO* ret = (PerlIO*)fdopen(fh, mode);
330	if(errno)
331	err = errno;
332	return ret;
333	}
334
565764a8	335	PerlIO* CPerlStdIO::Reopen(const char* filename, const char* mode, PerlIO* pf, int &err)
	336	{
	337	PerlIO* ret = (PerlIO)freopen(filename, mode, (FILE)pf);
	338	if(errno)
	339	err = errno;
	340	return ret;
	341	}
	342
76e3520e	343	SSize_t CPerlStdIO::Read(PerlIO* pf, void * buffer, Size_t count, int &err)
	344	{
	345	size_t ret = fread(buffer, 1, count, (FILE*)pf);
	346	if(errno)
	347	err = errno;
	348	return ret;
	349	}
	350
	351	SSize_t CPerlStdIO::Write(PerlIO* pf, const void * buffer, Size_t count, int &err)
	352	{
	353	size_t ret = fwrite(buffer, 1, count, (FILE*)pf);
	354	if(errno)
	355	err = errno;
	356	return ret;
	357	}
	358
565764a8	359	void CPerlStdIO::Setlinebuf(PerlIO*pf, int &err)
76e3520e	360	{
565764a8	361	setvbuf((FILE*)pf, NULL, _IOLBF, 0);
76e3520e	362	}
	363
	364	int CPerlStdIO::Printf(PerlIO* pf, int &err, const char *format, ...)
	365	{
	366	va_list(arglist);
	367	va_start(arglist, format);
	368	int ret = Vprintf(pf, err, format, arglist);
	369	if(errno)
	370	err = errno;
	371	return ret;
	372	}
	373
	374	int CPerlStdIO::Vprintf(PerlIO* pf, int &err, const char * format, va_list arg)
	375	{
	376	int ret = vfprintf((FILE*)pf, format, arg);
	377	if(errno)
	378	err = errno;
	379	return ret;
	380	}
	381
	382	long CPerlStdIO::Tell(PerlIO* pf, int &err)
	383	{
	384	long ret = ftell((FILE*)pf);
	385	if(errno)
	386	err = errno;
	387	return ret;
	388	}
	389
	390	int CPerlStdIO::Seek(PerlIO* pf, off_t offset, int origin, int &err)
	391	{
	392	int ret = fseek((FILE*)pf, offset, origin);
	393	if(errno)
	394	err = errno;
	395	return ret;
	396	}
	397
	398	void CPerlStdIO::Rewind(PerlIO* pf, int &err)
	399	{
	400	rewind((FILE*)pf);
	401	}
	402
	403	PerlIO* CPerlStdIO::Tmpfile(int &err)
	404	{
	405	return (PerlIO*)tmpfile();
	406	}
	407
	408	int CPerlStdIO::Getpos(PerlIO* pf, Fpos_t *p, int &err)
	409	{
	410	int ret = fgetpos((FILE)pf, (fpos_t)p);
	411	if(errno)
	412	err = errno;
	413	return ret;
	414	}
	415
	416	int CPerlStdIO::Setpos(PerlIO* pf, const Fpos_t *p, int &err)
	417	{
	418	int ret = fsetpos((FILE)pf, (fpos_t)p);
	419	if(errno)
	420	err = errno;
	421	return ret;
	422	}
	423
	424	char* CPerlStdIO::GetBase(PerlIO *pf, int &err)
	425	{
426	return ((FILE*)pf)->_base;
427	}
428
429	int CPerlStdIO::GetBufsiz(PerlIO *pf, int &err)
430	{
431	return ((FILE*)pf)->_bufsiz;
432	}
433
434	int CPerlStdIO::GetCnt(PerlIO *pf, int &err)
435	{
436	return ((FILE*)pf)->_cnt;
437	}
438
439	char* CPerlStdIO::GetPtr(PerlIO *pf, int &err)
440	{
441	return ((FILE*)pf)->_ptr;
442	}
443
565764a8	444	void CPerlStdIO::SetBuf(PerlIO pf, char buffer, int &err)
	445	{
	446	setbuf((FILE*)pf, buffer);
	447	}
	448
	449	int CPerlStdIO::SetVBuf(PerlIO pf, char buffer, int type, Size_t size, int &err)
	450	{
	451	return setvbuf((FILE*)pf, buffer, type, size);
	452	}
	453
76e3520e	454	void CPerlStdIO::SetCnt(PerlIO *pf, int n, int &err)
	455	{
	456	((FILE*)pf)->_cnt = n;
	457	}
	458
	459	void CPerlStdIO::SetPtrCnt(PerlIO pf, char ptr, int n, int& err)
	460	{
	461	((FILE*)pf)->_ptr = ptr;
	462	((FILE*)pf)->_cnt = n;
	463	}
	464
	465	void CPerlStdIO::Init(int &err)
	466	{
	467	}
	468
9d8a25dc	469
	470	static
	471	XS(w32_GetCwd)
	472	{
	473	dXSARGS;
	474	SV *sv = sv_newmortal();
	475	/* Make one call with zero size - return value is required size */
	476	DWORD len = GetCurrentDirectory((DWORD)0,NULL);
	477	SvUPGRADE(sv,SVt_PV);
	478	SvGROW(sv,len);
	479	SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
	480	/*
	481	* If result != 0
	482	* then it worked, set PV valid,
	483	* else leave it 'undef'
	484	*/
	485	if (SvCUR(sv))
	486	SvPOK_on(sv);
	487	EXTEND(sp,1);
	488	ST(0) = sv;
	489	XSRETURN(1);
	490	}
	491
	492	static
	493	XS(w32_SetCwd)
	494	{
	495	dXSARGS;
	496	if (items != 1)
	497	croak("usage: Win32::SetCurrentDirectory($cwd)");
	498	if (SetCurrentDirectory(SvPV(ST(0),na)))
	499	XSRETURN_YES;
	500
	501	XSRETURN_NO;
	502	}
	503
	504	static
	505	XS(w32_GetNextAvailDrive)
	506	{
	507	dXSARGS;
	508	char ix = 'C';
	509	char root[] = "_:\\";
	510	while (ix <= 'Z') {
	511	root[0] = ix++;
	512	if (GetDriveType(root) == 1) {
	513	root[2] = '\0';
	514	XSRETURN_PV(root);
	515	}
	516	}
	517	XSRETURN_UNDEF;
	518	}
	519
	520	static
	521	XS(w32_GetLastError)
	522	{
	523	dXSARGS;
	524	XSRETURN_IV(GetLastError());
	525	}
	526
	527	static
	528	XS(w32_LoginName)
	529	{
	530	dXSARGS;
	531	char szBuffer[128];
	532	DWORD size = sizeof(szBuffer);
533	if (GetUserName(szBuffer, &size)) {
534	/* size includes NULL */
535	ST(0) = sv_2mortal(newSVpv(szBuffer,size-1));
536	XSRETURN(1);
537	}
538	XSRETURN_UNDEF;
539	}
540
541	static
542	XS(w32_NodeName)
543	{
544	dXSARGS;
545	char name[MAX_COMPUTERNAME_LENGTH+1];
546	DWORD size = sizeof(name);
547	if (GetComputerName(name,&size)) {
548	/* size does NOT include NULL :-( */
549	ST(0) = sv_2mortal(newSVpv(name,size));
550	XSRETURN(1);
551	}
552	XSRETURN_UNDEF;
553	}
554
555
556	static
557	XS(w32_DomainName)
558	{
559	dXSARGS;
560	char name[256];
561	DWORD size = sizeof(name);
562	if (GetUserName(name,&size)) {
563	char sid[1024];
564	DWORD sidlen = sizeof(sid);
565	char dname[256];
566	DWORD dnamelen = sizeof(dname);
567	SID_NAME_USE snu;
568	if (LookupAccountName(NULL, name, &sid, &sidlen,
569	dname, &dnamelen, &snu)) {
570	XSRETURN_PV(dname); /* all that for this */
571	}
572	}
573	XSRETURN_UNDEF;
574	}
575
576	static
577	XS(w32_FsType)
578	{
579	dXSARGS;
580	char fsname[256];
581	DWORD flags, filecomplen;
582	if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
583	&flags, fsname, sizeof(fsname))) {
584	if (GIMME == G_ARRAY) {
585	XPUSHs(sv_2mortal(newSVpv(fsname,0)));
586	XPUSHs(sv_2mortal(newSViv(flags)));
587	XPUSHs(sv_2mortal(newSViv(filecomplen)));
588	PUTBACK;
589	return;
590	}
591	XSRETURN_PV(fsname);
592	}
593	XSRETURN_UNDEF;
594	}
595
596	static
597	XS(w32_GetOSVersion)
598	{
599	dXSARGS;
600	OSVERSIONINFO osver;
601
602	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
603	if (GetVersionEx(&osver)) {
604	XPUSHs(newSVpv(osver.szCSDVersion, 0));
605	XPUSHs(newSViv(osver.dwMajorVersion));
606	XPUSHs(newSViv(osver.dwMinorVersion));
607	XPUSHs(newSViv(osver.dwBuildNumber));
608	XPUSHs(newSViv(osver.dwPlatformId));
609	PUTBACK;
610	return;
611	}
612	XSRETURN_UNDEF;
613	}
614
615	static
616	XS(w32_IsWinNT)
617	{
618	dXSARGS;
619	OSVERSIONINFO osver;
620	memset(&osver, 0, sizeof(OSVERSIONINFO));
621	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
622	GetVersionEx(&osver);
623	XSRETURN_IV(VER_PLATFORM_WIN32_NT == osver.dwPlatformId);
624	}
625
626	static
627	XS(w32_IsWin95)
628	{
629	dXSARGS;
630	OSVERSIONINFO osver;
631	memset(&osver, 0, sizeof(OSVERSIONINFO));
632	osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
633	GetVersionEx(&osver);
634	XSRETURN_IV(VER_PLATFORM_WIN32_WINDOWS == osver.dwPlatformId);
635	}
636
637	static
638	XS(w32_FormatMessage)
639	{
640	dXSARGS;
641	DWORD source = 0;
642	char msgbuf[1024];
643
644	if (items != 1)
645	croak("usage: Win32::FormatMessage($errno)");
646
647	if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
648	&source, SvIV(ST(0)), 0,
649	msgbuf, sizeof(msgbuf)-1, NULL))
650	XSRETURN_PV(msgbuf);
651
652	XSRETURN_UNDEF;
653	}
654
655	static
656	XS(w32_Spawn)
657	{
658	dXSARGS;
659	char cmd, args;
660	PROCESS_INFORMATION stProcInfo;
661	STARTUPINFO stStartInfo;
662	BOOL bSuccess = FALSE;
663
664	if(items != 3)
665	croak("usage: Win32::Spawn($cmdName, $args, $PID)");
666
667	cmd = SvPV(ST(0),na);
668	args = SvPV(ST(1), na);
669
670	memset(&stStartInfo, 0, sizeof(stStartInfo)); /* Clear the block */
671	stStartInfo.cb = sizeof(stStartInfo); /* Set the structure size */
672	stStartInfo.dwFlags = STARTF_USESHOWWINDOW; /* Enable wShowWindow control */
673	stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE; /* Start min (normal) */
674
675	if(CreateProcess(
676	cmd, /* Image path */
677	args, /* Arguments for command line */
678	NULL, /* Default process security */
679	NULL, /* Default thread security */
680	FALSE, /* Must be TRUE to use std handles */
681	NORMAL_PRIORITY_CLASS, /* No special scheduling */
682	NULL, /* Inherit our environment block */
683	NULL, /* Inherit our currrent directory */
684	&stStartInfo, /* -> Startup info */
685	&stProcInfo)) /* <- Process info (if OK) */
686	{
687	CloseHandle(stProcInfo.hThread);/* library source code does this. */
688	sv_setiv(ST(2), stProcInfo.dwProcessId);
689	bSuccess = TRUE;
690	}
691	XSRETURN_IV(bSuccess);
692	}
693
694	static
695	XS(w32_GetTickCount)
696	{
697	dXSARGS;
698	XSRETURN_IV(GetTickCount());
699	}
700
701	static
702	XS(w32_GetShortPathName)
703	{
704	dXSARGS;
705	SV *shortpath;
706	DWORD len;
707
708	if(items != 1)
709	croak("usage: Win32::GetShortPathName($longPathName)");
710
711	shortpath = sv_mortalcopy(ST(0));
712	SvUPGRADE(shortpath, SVt_PV);
713	/* src == target is allowed */
714	do {
715	len = GetShortPathName(SvPVX(shortpath),
716	SvPVX(shortpath),
717	SvLEN(shortpath));
718	} while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
719	if (len) {
720	SvCUR_set(shortpath,len);
721	ST(0) = shortpath;
722	}
723	else
724	ST(0) = &sv_undef;
725	XSRETURN(1);
726	}
727
728
76e3520e	729	void CPerlStdIO::InitOSExtras(void* p)
76e3520e	730	{
9d8a25dc	731	char *file = __FILE__;
	732	dXSUB_SYS;
	733
	734	/* XXX should be removed after checking with Nick */
	735	newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
	736
	737	/* these names are Activeware compatible */
	738	newXS("Win32::GetCwd", w32_GetCwd, file);
	739	newXS("Win32::SetCwd", w32_SetCwd, file);
	740	newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
	741	newXS("Win32::GetLastError", w32_GetLastError, file);
	742	newXS("Win32::LoginName", w32_LoginName, file);
	743	newXS("Win32::NodeName", w32_NodeName, file);
	744	newXS("Win32::DomainName", w32_DomainName, file);
	745	newXS("Win32::FsType", w32_FsType, file);
	746	newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
	747	newXS("Win32::IsWinNT", w32_IsWinNT, file);
	748	newXS("Win32::IsWin95", w32_IsWin95, file);
	749	newXS("Win32::FormatMessage", w32_FormatMessage, file);
	750	newXS("Win32::Spawn", w32_Spawn, file);
	751	newXS("Win32::GetTickCount", w32_GetTickCount, file);
	752	newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
	753
76e3520e	754	}
	755
	756