1 #define PERL_NO_GET_CONTEXT
2 #define WIN32_LEAN_AND_MEAN
3 #define WIN32IO_IS_STDIO
22 /* Bottom-most level for Win32 case */
26 struct _PerlIO base; /* The generic part */
27 HANDLE h; /* OS level handle */
28 IV refcnt; /* REFCNT for the "fd" this represents */
29 int fd; /* UNIX like file descriptor - index into fdtable */
32 PerlIOWin32 *fdtable[256];
36 PerlIOWin32_popped(pTHX_ PerlIO *f)
38 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
41 *f = PerlIOBase(f)->next;
44 fdtable[s->fd] = NULL;
49 PerlIOWin32_fileno(pTHX_ PerlIO *f)
51 return PerlIOSelf(f,PerlIOWin32)->fd;
55 PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
57 IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab);
60 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
61 s->fd = PerlIO_fileno(PerlIONext(f));
63 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
65 Perl_ck_warner_d(aTHX_
66 packWARN(WARN_EXPERIMENTAL__WIN32_PERLIO),
67 "PerlIO layer ':win32' is experimental");
73 PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args)
75 const char *tmode = mode;
76 HANDLE h = INVALID_HANDLE_VALUE;
79 /* Close if already open */
80 if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
81 (*PerlIOBase(f)->tab->Close)(aTHX_ f);
85 char *path = SvPV_nolen(*args);
87 /* CRT uses _SH_DENYNO for open(), this the Win32 equivelent */
88 DWORD share = FILE_SHARE_READ | FILE_SHARE_WRITE;
90 DWORD attr = FILE_ATTRIBUTE_NORMAL;
91 if (stricmp(path, "/dev/null")==0)
95 /* sysopen - imode is UNIX-like O_RDONLY etc.
96 - do_open has converted that back to string form in mode as well
97 - perm is UNIX like permissions
103 /* Normal open - decode mode string */
108 access = GENERIC_READ;
109 create = OPEN_EXISTING;
112 access |= GENERIC_WRITE;
113 create = OPEN_ALWAYS;
119 access = GENERIC_WRITE;
120 create = TRUNCATE_EXISTING;
123 access |= GENERIC_READ;
129 access = GENERIC_WRITE;
130 create = OPEN_ALWAYS;
133 access |= GENERIC_READ;
142 else if (*mode == 't')
146 if (*mode || create == -1)
148 SETERRNO(EINVAL,LIB$_INVARG);
151 h = CreateFile(path,access,share,NULL,create,attr,NULL);
152 if (h == INVALID_HANDLE_VALUE)
154 if (create == TRUNCATE_EXISTING)
155 h = CreateFile(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL);
161 h = INVALID_HANDLE_VALUE;
162 if (inRANGE(fd, 0, max_open_fd))
164 PerlIOWin32 *s = fdtable[fd];
169 f = PerlIO_allocate(aTHX);
180 h = GetStdHandle(STD_INPUT_HANDLE);
183 h = GetStdHandle(STD_OUTPUT_HANDLE);
186 h = GetStdHandle(STD_ERROR_HANDLE);
191 if (h != INVALID_HANDLE_VALUE)
192 fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
197 f = PerlIO_allocate(aTHX);
198 s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32);
205 if (fd > max_open_fd)
212 /* FIXME: pop layers ??? */
218 PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
220 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
222 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
224 if (ReadFile(s->h,vbuf,count,&len,NULL))
230 if (GetLastError() != NO_ERROR)
232 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
233 PerlIO_save_errno(f);
239 PerlIOBase(f)->flags |= PERLIO_F_EOF;
246 PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
248 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
250 if (WriteFile(s->h,vbuf,count,&len,NULL))
256 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
257 PerlIO_save_errno(f);
263 PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
265 static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END };
266 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
268 DWORD high = (DWORD)(offset >> 32);
272 DWORD low = (DWORD) offset;
273 DWORD res = SetFilePointer(s->h,(LONG)low,(LONG *)&high,where[whence]);
274 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
285 PerlIOWin32_tell(pTHX_ PerlIO *f)
287 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
289 DWORD res = SetFilePointer(s->h,0,(LONG *)&high,FILE_CURRENT);
290 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
293 return ((Off_t) high << 32) | res;
302 PerlIOWin32_close(pTHX_ PerlIO *f)
304 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
309 /* This does not do pipes etc. correctly */
310 if (!CloseHandle(s->h))
312 s->h = INVALID_HANDLE_VALUE;
316 PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
317 return win32_close(s->fd);
324 PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
326 PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
327 HANDLE proc = GetCurrentProcess();
329 if (DuplicateHandle(proc, os->h, proc, &new_h, 0, FALSE, DUPLICATE_SAME_ACCESS))
332 int fd = win32_open_osfhandle((intptr_t) new_h, PerlIOUnix_oflags(PerlIO_modestr(o,mode)));
335 f = PerlIOBase_dup(aTHX_ f, o, params, flags);
338 PerlIOWin32 *fs = PerlIOSelf(f,PerlIOWin32);
343 if (fd > max_open_fd)
359 PERLIO_FUNCS_DECL(PerlIO_win32) = {
360 sizeof(PerlIO_funcs),
377 PerlIOBase_noop_ok, /* flush */
378 PerlIOBase_noop_fail, /* fill */
382 PerlIOBase_setlinebuf,
384 NULL, /* get_bufsiz */
387 NULL, /* set_ptrcnt */