1 #define PERL_NO_GET_CONTEXT
2 #define WIN32_LEAN_AND_MEAN
3 #define WIN32IO_IS_STDIO
23 /* Bottom-most level for Win32 case */
27 struct _PerlIO base; /* The generic part */
28 HANDLE h; /* OS level handle */
29 IV refcnt; /* REFCNT for the "fd" this represents */
30 int fd; /* UNIX like file descriptor - index into fdtable */
33 PerlIOWin32 *fdtable[256];
37 PerlIOWin32_popped(pTHX_ PerlIO *f)
39 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
42 *f = PerlIOBase(f)->next;
45 fdtable[s->fd] = NULL;
50 PerlIOWin32_fileno(pTHX_ PerlIO *f)
52 return PerlIOSelf(f,PerlIOWin32)->fd;
56 PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
58 IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab);
61 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
62 s->fd = PerlIO_fileno(PerlIONext(f));
64 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
69 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)
71 const char *tmode = mode;
72 HANDLE h = INVALID_HANDLE_VALUE;
75 /* Close if already open */
76 if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
77 (*PerlIOBase(f)->tab->Close)(aTHX_ f);
81 char *path = SvPV_nolen(*args);
85 DWORD attr = FILE_ATTRIBUTE_NORMAL;
88 /* sysopen - imode is UNIX-like O_RDONLY etc.
89 - do_open has converted that back to string form in mode as well
90 - perm is UNIX like permissions
96 /* Normal open - decode mode string */
101 access = GENERIC_READ;
102 create = OPEN_EXISTING;
105 access |= GENERIC_WRITE;
106 create = OPEN_ALWAYS;
112 access = GENERIC_WRITE;
113 create = TRUNCATE_EXISTING;
116 access |= GENERIC_READ;
122 access = GENERIC_WRITE;
123 create = OPEN_ALWAYS;
126 access |= GENERIC_READ;
135 else if (*mode == 't')
139 if (*mode || create == -1)
141 //FIX-ME: SETERRNO(EINVAL,LIB$_INVARG);
142 XCEMessageBoxA(NULL, "NEED TO IMPLEMENT a place in ../wince/win32io.c", "Perl(developer)", 0);
145 if (!(access & GENERIC_WRITE))
146 share = FILE_SHARE_READ;
147 h = CreateFileW(path,access,share,NULL,create,attr,NULL);
148 if (h == INVALID_HANDLE_VALUE)
150 if (create == TRUNCATE_EXISTING)
151 h = CreateFileW(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL);
157 h = INVALID_HANDLE_VALUE;
158 if (fd >= 0 && fd <= max_open_fd)
160 PerlIOWin32 *s = fdtable[fd];
165 f = PerlIO_allocate(aTHX);
176 h = XCEGetStdHandle(STD_INPUT_HANDLE);
179 h = XCEGetStdHandle(STD_OUTPUT_HANDLE);
182 h = XCEGetStdHandle(STD_ERROR_HANDLE);
187 if (h != INVALID_HANDLE_VALUE)
188 fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
193 f = PerlIO_allocate(aTHX);
194 s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32);
201 if (fd > max_open_fd)
208 /* FIXME: pop layers ??? */
214 PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
216 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
218 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
220 if (ReadFile(s->h,vbuf,count,&len,NULL))
226 if (GetLastError() != NO_ERROR)
228 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
229 PerlIO_save_errno(f);
235 PerlIOBase(f)->flags |= PERLIO_F_EOF;
242 PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
244 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
246 if (WriteFile(s->h,vbuf,count,&len,NULL))
252 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
253 PerlIO_save_errno(f);
259 PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
261 static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END };
262 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
263 DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0;
264 DWORD low = (DWORD) offset;
265 DWORD res = SetFilePointer(s->h,low,&high,where[whence]);
266 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
277 PerlIOWin32_tell(pTHX_ PerlIO *f)
279 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
281 DWORD res = SetFilePointer(s->h,0,&high,FILE_CURRENT);
282 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
284 return ((Off_t) high << 32) | res;
290 PerlIOWin32_close(pTHX_ PerlIO *f)
292 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
297 /* This does not do pipes etc. correctly */
298 if (!CloseHandle(s->h))
300 s->h = INVALID_HANDLE_VALUE;
304 PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
305 return win32_close(s->fd);
312 PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
314 PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
315 HANDLE proc = GetCurrentProcess();
317 if (DuplicateHandle(proc, os->h, proc, &new, 0, FALSE, DUPLICATE_SAME_ACCESS))
320 int fd = win32_open_osfhandle((intptr_t) new, PerlIOUnix_oflags(PerlIO_modestr(o,mode)));
323 f = PerlIOBase_dup(aTHX_ f, o, params, flags);
326 PerlIOWin32 *fs = PerlIOSelf(f,PerlIOWin32);
331 if (fd > max_open_fd)
347 PerlIO_funcs PerlIO_win32 = {
348 sizeof(PerlIO_funcs),
365 PerlIOBase_noop_ok, /* flush */
366 PerlIOBase_noop_fail, /* fill */
370 PerlIOBase_setlinebuf,
372 NULL, /* get_bufsiz */
375 NULL, /* set_ptrcnt */