4 Interface for perl stdio functions
8 #include "ipstdiowin.h"
11 class CPerlStdIO : public IPerlStdIOWin
19 ZeroMemory(bSocketTable, sizeof(bSocketTable));
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);
40 virtual PerlIO* Reopen(const char*, const char*, PerlIO*, int &err);
41 virtual SSize_t Read(PerlIO*,void *,Size_t, int &err);
42 virtual SSize_t Write(PerlIO*,const void *,Size_t, int &err);
43 virtual void SetBuf(PerlIO *, char*, int &err);
44 virtual int SetVBuf(PerlIO *, char*, int, Size_t, int &err);
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);
63 inline void SetPerlObj(CPerlObj *p) { pPerl = p; };
64 inline void SetSockCtl(CPerlSock *p) { pSock = p; };
66 inline int IsWin95(void)
68 return (os_id() == VER_PLATFORM_WIN32_WINDOWS);
70 inline int IsWinNT(void)
72 return (os_id() == VER_PLATFORM_WIN32_NT);
74 inline void AddToSocketTable(int fh)
77 bSocketTable[fh] = TRUE;
79 inline BOOL InSocketTable(int fh)
82 return bSocketTable[fh];
85 inline void RemoveFromSocketTable(int fh)
88 bSocketTable[fh] = FALSE;
92 if((-1) == w32_platform)
96 memset(&osver, 0, sizeof(OSVERSIONINFO));
97 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
99 w32_platform = osver.dwPlatformId;
101 return (w32_platform);
108 BOOL bSocketTable[_NSTREAM_];
111 void CPerlStdIO::ShutDown(void)
114 for(i = 0; i < _NSTREAM_; ++i)
117 pSock->CloseSocket(i, err);
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);
126 #if (_MSC_VER >= 1000)
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 */
133 extern "C" ioinfo * __pioinfo[];
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)
139 extern "C" extern char _osfile[];
140 #endif // (_MSC_VER >= 1000)
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
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
152 int CPerlStdIO::OpenOSfhandle(long osfhandle, int flags)
159 // all this is here to handle Win95's GetFileType bug.
160 char fileflags; // _osfile flags
162 // copy relevant flags from second parameter
165 if(flags & _O_APPEND)
166 fileflags |= FAPPEND;
171 // attempt to allocate a C Runtime file handle
172 if((fh = _alloc_osfhnd()) == -1)
174 errno = EMFILE; // too many open files
175 _doserrno = 0L; // not an OS error
176 return -1; // return error to caller
179 // the file is open. now, set the info in _osfhnd array
180 _set_osfhnd(fh, osfhandle);
182 fileflags |= FOPEN; // mark as open
184 #if (_MSC_VER >= 1000)
185 _osfile(fh) = fileflags; // set osfile entry
187 _osfile[fh] = fileflags; // set osfile entry
192 fh = _open_osfhandle(osfhandle, flags);
195 AddToSocketTable(fh);
197 return fh; // return handle
200 int CPerlStdIO::GetOSfhandle(int filenum)
202 return _get_osfhandle(filenum);
205 PerlIO* CPerlStdIO::Stdin(void)
207 return (PerlIO*)(&_iob[0]);
210 PerlIO* CPerlStdIO::Stdout(void)
212 return (PerlIO*)(&_iob[1]);
215 PerlIO* CPerlStdIO::Stderr(void)
217 return (PerlIO*)(&_iob[2]);
220 PerlIO* CPerlStdIO::Open(const char *path, const char *mode, int &err)
225 if(stricmp(path, "/dev/null") == 0)
226 ret = (PerlIO*)fopen("NUL", mode);
228 ret = (PerlIO*)fopen(path, mode);
238 extern "C" int _free_osfhnd(int fh);
239 int CPerlStdIO::Close(PerlIO* pf, int &err)
241 int ret = 0, fileNo = fileno((FILE*)pf);
242 if(InSocketTable(fileNo))
244 RemoveFromSocketTable(fileNo);
245 pSock->CloseSocket(fileNo, err);
246 _free_osfhnd(fileNo);
250 ret = fclose((FILE*)pf);
257 int CPerlStdIO::Eof(PerlIO* pf, int &err)
259 int ret = feof((FILE*)pf);
265 int CPerlStdIO::Error(PerlIO* pf, int &err)
267 int ret = ferror((FILE*)pf);
273 void CPerlStdIO::Clearerr(PerlIO* pf, int &err)
279 int CPerlStdIO::Getc(PerlIO* pf, int &err)
281 int ret = fgetc((FILE*)pf);
287 int CPerlStdIO::Putc(PerlIO* pf, int c, int &err)
289 int ret = fputc(c, (FILE*)pf);
295 int CPerlStdIO::Puts(PerlIO* pf, const char *s, int &err)
297 int ret = fputs(s, (FILE*)pf);
303 int CPerlStdIO::Flush(PerlIO* pf, int &err)
305 int ret = fflush((FILE*)pf);
311 int CPerlStdIO::Ungetc(PerlIO* pf,int c, int &err)
313 int ret = ungetc(c, (FILE*)pf);
319 int CPerlStdIO::Fileno(PerlIO* pf, int &err)
321 int ret = fileno((FILE*)pf);
327 PerlIO* CPerlStdIO::Fdopen(int fh, const char *mode, int &err)
329 PerlIO* ret = (PerlIO*)fdopen(fh, mode);
335 PerlIO* CPerlStdIO::Reopen(const char* filename, const char* mode, PerlIO* pf, int &err)
337 PerlIO* ret = (PerlIO*)freopen(filename, mode, (FILE*)pf);
343 SSize_t CPerlStdIO::Read(PerlIO* pf, void * buffer, Size_t count, int &err)
345 size_t ret = fread(buffer, 1, count, (FILE*)pf);
351 SSize_t CPerlStdIO::Write(PerlIO* pf, const void * buffer, Size_t count, int &err)
353 size_t ret = fwrite(buffer, 1, count, (FILE*)pf);
359 void CPerlStdIO::Setlinebuf(PerlIO*pf, int &err)
361 setvbuf((FILE*)pf, NULL, _IOLBF, 0);
364 int CPerlStdIO::Printf(PerlIO* pf, int &err, const char *format, ...)
367 va_start(arglist, format);
368 int ret = Vprintf(pf, err, format, arglist);
374 int CPerlStdIO::Vprintf(PerlIO* pf, int &err, const char * format, va_list arg)
376 int ret = vfprintf((FILE*)pf, format, arg);
382 long CPerlStdIO::Tell(PerlIO* pf, int &err)
384 long ret = ftell((FILE*)pf);
390 int CPerlStdIO::Seek(PerlIO* pf, off_t offset, int origin, int &err)
392 int ret = fseek((FILE*)pf, offset, origin);
398 void CPerlStdIO::Rewind(PerlIO* pf, int &err)
403 PerlIO* CPerlStdIO::Tmpfile(int &err)
405 return (PerlIO*)tmpfile();
408 int CPerlStdIO::Getpos(PerlIO* pf, Fpos_t *p, int &err)
410 int ret = fgetpos((FILE*)pf, (fpos_t*)p);
416 int CPerlStdIO::Setpos(PerlIO* pf, const Fpos_t *p, int &err)
418 int ret = fsetpos((FILE*)pf, (fpos_t*)p);
424 char* CPerlStdIO::GetBase(PerlIO *pf, int &err)
426 return ((FILE*)pf)->_base;
429 int CPerlStdIO::GetBufsiz(PerlIO *pf, int &err)
431 return ((FILE*)pf)->_bufsiz;
434 int CPerlStdIO::GetCnt(PerlIO *pf, int &err)
436 return ((FILE*)pf)->_cnt;
439 char* CPerlStdIO::GetPtr(PerlIO *pf, int &err)
441 return ((FILE*)pf)->_ptr;
444 void CPerlStdIO::SetBuf(PerlIO *pf, char* buffer, int &err)
446 setbuf((FILE*)pf, buffer);
449 int CPerlStdIO::SetVBuf(PerlIO *pf, char* buffer, int type, Size_t size, int &err)
451 return setvbuf((FILE*)pf, buffer, type, size);
454 void CPerlStdIO::SetCnt(PerlIO *pf, int n, int &err)
456 ((FILE*)pf)->_cnt = n;
459 void CPerlStdIO::SetPtrCnt(PerlIO *pf, char *ptr, int n, int& err)
461 ((FILE*)pf)->_ptr = ptr;
462 ((FILE*)pf)->_cnt = n;
465 void CPerlStdIO::Init(int &err)
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);
479 SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
482 * then it worked, set PV valid,
483 * else leave it 'undef'
497 croak("usage: Win32::SetCurrentDirectory($cwd)");
498 if (SetCurrentDirectory(SvPV(ST(0),na)))
505 XS(w32_GetNextAvailDrive)
509 char root[] = "_:\\";
512 if (GetDriveType(root) == 1) {
524 XSRETURN_IV(GetLastError());
532 DWORD size = sizeof(szBuffer);
533 if (GetUserName(szBuffer, &size)) {
534 /* size includes NULL */
535 ST(0) = sv_2mortal(newSVpv(szBuffer,size-1));
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));
561 DWORD size = sizeof(name);
562 if (GetUserName(name,&size)) {
564 DWORD sidlen = sizeof(sid);
566 DWORD dnamelen = sizeof(dname);
568 if (LookupAccountName(NULL, name, &sid, &sidlen,
569 dname, &dnamelen, &snu)) {
570 XSRETURN_PV(dname); /* all that for this */
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)));
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));
620 memset(&osver, 0, sizeof(OSVERSIONINFO));
621 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
622 GetVersionEx(&osver);
623 XSRETURN_IV(VER_PLATFORM_WIN32_NT == osver.dwPlatformId);
631 memset(&osver, 0, sizeof(OSVERSIONINFO));
632 osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
633 GetVersionEx(&osver);
634 XSRETURN_IV(VER_PLATFORM_WIN32_WINDOWS == osver.dwPlatformId);
638 XS(w32_FormatMessage)
645 croak("usage: Win32::FormatMessage($errno)");
647 if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
648 &source, SvIV(ST(0)), 0,
649 msgbuf, sizeof(msgbuf)-1, NULL))
660 PROCESS_INFORMATION stProcInfo;
661 STARTUPINFO stStartInfo;
662 BOOL bSuccess = FALSE;
665 croak("usage: Win32::Spawn($cmdName, $args, $PID)");
667 cmd = SvPV(ST(0),na);
668 args = SvPV(ST(1), na);
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) */
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) */
687 CloseHandle(stProcInfo.hThread);/* library source code does this. */
688 sv_setiv(ST(2), stProcInfo.dwProcessId);
691 XSRETURN_IV(bSuccess);
698 XSRETURN_IV(GetTickCount());
702 XS(w32_GetShortPathName)
709 croak("usage: Win32::GetShortPathName($longPathName)");
711 shortpath = sv_mortalcopy(ST(0));
712 SvUPGRADE(shortpath, SVt_PV);
713 /* src == target is allowed */
715 len = GetShortPathName(SvPVX(shortpath),
718 } while (len >= SvLEN(shortpath) && sv_grow(shortpath,len+1));
720 SvCUR_set(shortpath,len);
729 void CPerlStdIO::InitOSExtras(void* p)
731 char *file = __FILE__;
734 /* XXX should be removed after checking with Nick */
735 newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
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);