1 #define PERL_NO_GET_CONTEXT
2 #define WIN32_LEAN_AND_MEAN
3 #define WIN32IO_IS_STDIO
18 /* Bottom-most level for Win32 case */
22 struct _PerlIO base; /* The generic part */
23 HANDLE h; /* OS level handle */
24 IV refcnt; /* REFCNT for the "fd" this represents */
25 int fd; /* UNIX like file descriptor - index into fdtable */
28 PerlIOWin32 *fdtable[256];
32 PerlIOWin32_popped(PerlIO *f)
34 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
37 *f = PerlIOBase(f)->next;
40 fdtable[s->fd] = NULL;
45 PerlIOWin32_fileno(PerlIO *f)
47 return PerlIOSelf(f,PerlIOWin32)->fd;
51 PerlIOWin32_pushed(PerlIO *f, const char *mode, SV *arg)
53 IV code = PerlIOBase_pushed(f,mode,arg);
56 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
57 s->fd = PerlIO_fileno(PerlIONext(f));
59 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
64 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)
66 const char *tmode = mode;
67 HANDLE h = INVALID_HANDLE_VALUE;
70 /* Close if already open */
71 if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
72 (*PerlIOBase(f)->tab->Close)(f);
76 char *path = SvPV_nolen(*args);
80 DWORD attr = FILE_ATTRIBUTE_NORMAL;
83 /* sysopen - imode is UNIX-like O_RDONLY etc.
84 - do_open has converted that back to string form in mode as well
85 - perm is UNIX like permissions
91 /* Normal open - decode mode string */
96 access = GENERIC_READ;
97 create = OPEN_EXISTING;
100 access |= GENERIC_WRITE;
101 create = OPEN_ALWAYS;
107 access = GENERIC_WRITE;
108 create = TRUNCATE_EXISTING;
111 access |= GENERIC_READ;
117 access = GENERIC_WRITE;
118 create = OPEN_ALWAYS;
121 access |= GENERIC_READ;
130 else if (*mode == 't')
134 if (*mode || create == -1)
136 SETERRNO(EINVAL,LIB$_INVARG);
139 if (!(access & GENERIC_WRITE))
140 share = FILE_SHARE_READ;
141 h = CreateFile(path,access,share,NULL,create,attr,NULL);
142 if (h == INVALID_HANDLE_VALUE)
144 if (create == TRUNCATE_EXISTING)
145 h = CreateFile(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL);
151 h = INVALID_HANDLE_VALUE;
152 if (fd >= 0 && fd <= max_open_fd)
154 PerlIOWin32 *s = fdtable[fd];
159 f = PerlIO_allocate(aTHX);
170 h = GetStdHandle(STD_INPUT_HANDLE);
173 h = GetStdHandle(STD_OUTPUT_HANDLE);
176 h = GetStdHandle(STD_ERROR_HANDLE);
181 if (h != INVALID_HANDLE_VALUE)
182 fd = win32_open_osfhandle((long) h, PerlIOUnix_oflags(tmode));
187 f = PerlIO_allocate(aTHX);
188 s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32);
195 if (fd > max_open_fd)
202 /* FIXME: pop layers ??? */
208 PerlIOWin32_read(PerlIO *f, void *vbuf, Size_t count)
210 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
212 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
214 if (ReadFile(s->h,vbuf,count,&len,NULL))
220 if (GetLastError() != NO_ERROR)
222 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
228 PerlIOBase(f)->flags |= PERLIO_F_EOF;
235 PerlIOWin32_write(PerlIO *f, const void *vbuf, Size_t count)
237 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
239 if (WriteFile(s->h,vbuf,count,&len,NULL))
245 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
251 PerlIOWin32_seek(PerlIO *f, Off_t offset, int whence)
253 static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END };
254 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
255 DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0;
256 DWORD low = (DWORD) offset;
257 DWORD res = SetFilePointer(s->h,low,&high,where[whence]);
258 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
269 PerlIOWin32_tell(PerlIO *f)
271 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
273 DWORD res = SetFilePointer(s->h,0,&high,FILE_CURRENT);
274 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
276 return ((Off_t) high << 32) | res;
282 PerlIOWin32_close(PerlIO *f)
284 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
287 if (CloseHandle(s->h))
289 s->h = INVALID_HANDLE_VALUE;
293 PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
298 PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params)
300 /* Almost certainly needs more work */
301 return PerlIOBase_dup(aTHX_ f, o, params);
304 PerlIO_funcs PerlIO_win32 = {
320 PerlIOBase_noop_ok, /* flush */
321 PerlIOBase_noop_fail, /* fill */
325 PerlIOBase_setlinebuf,
327 NULL, /* get_bufsiz */
330 NULL, /* set_ptrcnt */