Regenerate META.yml
[p5sagit/p5-mst-13.2.git] / win32 / win32ceio.c
CommitLineData
18f68570 1#define PERL_NO_GET_CONTEXT
2#define WIN32_LEAN_AND_MEAN
3#define WIN32IO_IS_STDIO
4#include <tchar.h>
5#ifdef __GNUC__
6#define Win32_Winsock
7#endif
8#include <windows.h>
9#include <cewin32.h>
10
11#include <sys/stat.h>
12#include "EXTERN.h"
13#include "perl.h"
14
15#ifdef PERLIO_LAYERS
16
17#include "perliol.h"
18
19#define NO_XSLOCKS
20#include "XSUB.h"
21
22
23/* Bottom-most level for Win32 case */
24
25typedef struct
26{
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 */
31} PerlIOWin32;
32
33PerlIOWin32 *fdtable[256];
34IV max_open_fd = -1;
35
36IV
37PerlIOWin32_popped(pTHX_ PerlIO *f)
38{
39 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
40 if (--s->refcnt > 0)
41 {
42 *f = PerlIOBase(f)->next;
43 return 1;
44 }
45 fdtable[s->fd] = NULL;
46 return 0;
47}
48
49IV
50PerlIOWin32_fileno(pTHX_ PerlIO *f)
51{
52 return PerlIOSelf(f,PerlIOWin32)->fd;
53}
54
55IV
aebd5ec7 56PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
18f68570 57{
aebd5ec7 58 IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab);
18f68570 59 if (*PerlIONext(f))
60 {
61 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
62 s->fd = PerlIO_fileno(PerlIONext(f));
63 }
64 PerlIOBase(f)->flags |= PERLIO_F_OPEN;
65 return code;
66}
67
68PerlIO *
69PerlIOWin32_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)
70{
71 const char *tmode = mode;
72 HANDLE h = INVALID_HANDLE_VALUE;
73 if (f)
74 {
75 /* Close if already open */
76 if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
77 (*PerlIOBase(f)->tab->Close)(aTHX_ f);
78 }
79 if (narg > 0)
80 {
81 char *path = SvPV_nolen(*args);
82 DWORD access = 0;
83 DWORD share = 0;
84 DWORD create = -1;
85 DWORD attr = FILE_ATTRIBUTE_NORMAL;
86 if (*mode == '#')
87 {
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
91 */
92 mode++;
93 }
94 else
95 {
96 /* Normal open - decode mode string */
97 }
98 switch(*mode)
99 {
100 case 'r':
101 access = GENERIC_READ;
102 create = OPEN_EXISTING;
103 if (*++mode == '+')
104 {
105 access |= GENERIC_WRITE;
106 create = OPEN_ALWAYS;
107 mode++;
108 }
109 break;
110
111 case 'w':
112 access = GENERIC_WRITE;
113 create = TRUNCATE_EXISTING;
114 if (*++mode == '+')
115 {
116 access |= GENERIC_READ;
117 mode++;
118 }
119 break;
120
121 case 'a':
122 access = GENERIC_WRITE;
123 create = OPEN_ALWAYS;
124 if (*++mode == '+')
125 {
126 access |= GENERIC_READ;
127 mode++;
128 }
129 break;
130 }
131 if (*mode == 'b')
132 {
133 mode++;
134 }
135 else if (*mode == 't')
136 {
137 mode++;
138 }
139 if (*mode || create == -1)
140 {
141 //FIX-ME: SETERRNO(EINVAL,LIB$_INVARG);
142 XCEMessageBoxA(NULL, "NEED TO IMPLEMENT a place in ../wince/win32io.c", "Perl(developer)", 0);
143 return NULL;
144 }
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)
149 {
150 if (create == TRUNCATE_EXISTING)
151 h = CreateFileW(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL);
152 }
153 }
154 else
155 {
156 /* fd open */
157 h = INVALID_HANDLE_VALUE;
158 if (fd >= 0 && fd <= max_open_fd)
159 {
160 PerlIOWin32 *s = fdtable[fd];
161 if (s)
162 {
163 s->refcnt++;
164 if (!f)
165 f = PerlIO_allocate(aTHX);
166 *f = &s->base;
167 return f;
168 }
169 }
170 if (*mode == 'I')
171 {
172 mode++;
173 switch(fd)
174 {
175 case 0:
176 h = XCEGetStdHandle(STD_INPUT_HANDLE);
177 break;
178 case 1:
179 h = XCEGetStdHandle(STD_OUTPUT_HANDLE);
180 break;
181 case 2:
182 h = XCEGetStdHandle(STD_ERROR_HANDLE);
183 break;
184 }
185 }
186 }
187 if (h != INVALID_HANDLE_VALUE)
188 fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
189 if (fd >= 0)
190 {
191 PerlIOWin32 *s;
192 if (!f)
193 f = PerlIO_allocate(aTHX);
194 s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32);
195 s->h = h;
196 s->fd = fd;
197 s->refcnt = 1;
198 if (fd >= 0)
199 {
200 fdtable[fd] = s;
201 if (fd > max_open_fd)
202 max_open_fd = fd;
203 }
204 return f;
205 }
206 if (f)
207 {
208 /* FIXME: pop layers ??? */
209 }
210 return NULL;
211}
212
213SSize_t
214PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
215{
216 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
217 DWORD len;
218 if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
219 return 0;
220 if (ReadFile(s->h,vbuf,count,&len,NULL))
221 {
222 return len;
223 }
224 else
225 {
226 if (GetLastError() != NO_ERROR)
227 {
228 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
229 return -1;
230 }
231 else
232 {
233 if (count != 0)
234 PerlIOBase(f)->flags |= PERLIO_F_EOF;
235 return 0;
236 }
237 }
238}
239
240SSize_t
241PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
242{
243 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
244 DWORD len;
245 if (WriteFile(s->h,vbuf,count,&len,NULL))
246 {
247 return len;
248 }
249 else
250 {
251 PerlIOBase(f)->flags |= PERLIO_F_ERROR;
252 return -1;
253 }
254}
255
256IV
257PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
258{
259 static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END };
260 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
261 DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0;
262 DWORD low = (DWORD) offset;
263 DWORD res = SetFilePointer(s->h,low,&high,where[whence]);
264 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
265 {
266 return 0;
267 }
268 else
269 {
270 return -1;
271 }
272}
273
274Off_t
275PerlIOWin32_tell(pTHX_ PerlIO *f)
276{
277 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
278 DWORD high = 0;
279 DWORD res = SetFilePointer(s->h,0,&high,FILE_CURRENT);
280 if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR)
281 {
282 return ((Off_t) high << 32) | res;
283 }
284 return (Off_t) -1;
285}
286
287IV
288PerlIOWin32_close(pTHX_ PerlIO *f)
289{
290 PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
291 if (s->refcnt == 1)
292 {
f4257e4d 293 IV code = 0;
814ffeea 294#if 0
f4257e4d 295 /* This does not do pipes etc. correctly */
814ffeea 296 if (!CloseHandle(s->h))
18f68570 297 {
298 s->h = INVALID_HANDLE_VALUE;
299 return -1;
300 }
814ffeea 301#else
302 PerlIOBase(f)->flags &= ~PERLIO_F_OPEN;
303 return win32_close(s->fd);
304#endif
18f68570 305 }
18f68570 306 return 0;
307}
308
309PerlIO *
310PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
311{
312 PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32);
313 HANDLE proc = GetCurrentProcess();
814ffeea 314 HANDLE new;
315 if (DuplicateHandle(proc, os->h, proc, &new, 0, FALSE, DUPLICATE_SAME_ACCESS))
18f68570 316 {
317 char mode[8];
318 int fd = win32_open_osfhandle((intptr_t) new, PerlIOUnix_oflags(PerlIO_modestr(o,mode)));
814ffeea 319 if (fd >= 0)
18f68570 320 {
321 f = PerlIOBase_dup(aTHX_ f, o, params, flags);
814ffeea 322 if (f)
18f68570 323 {
324 PerlIOWin32 *fs = PerlIOSelf(f,PerlIOWin32);
325 fs->h = new;
326 fs->fd = fd;
327 fs->refcnt = 1;
328 fdtable[fd] = fs;
329 if (fd > max_open_fd)
330 max_open_fd = fd;
331 }
332 else
333 {
334 win32_close(fd);
335 }
336 }
337 else
338 {
339 CloseHandle(new);
340 }
341 }
342 return f;
343}
344
345PerlIO_funcs PerlIO_win32 = {
216db7ee 346 sizeof(PerlIO_funcs),
18f68570 347 "win32",
348 sizeof(PerlIOWin32),
349 PERLIO_K_RAW,
350 PerlIOWin32_pushed,
351 PerlIOWin32_popped,
352 PerlIOWin32_open,
216db7ee 353 PerlIOBase_binmode,
18f68570 354 NULL, /* getarg */
355 PerlIOWin32_fileno,
356 PerlIOWin32_dup,
357 PerlIOWin32_read,
358 PerlIOBase_unread,
359 PerlIOWin32_write,
360 PerlIOWin32_seek,
361 PerlIOWin32_tell,
362 PerlIOWin32_close,
363 PerlIOBase_noop_ok, /* flush */
364 PerlIOBase_noop_fail, /* fill */
365 PerlIOBase_eof,
366 PerlIOBase_error,
367 PerlIOBase_clearerr,
368 PerlIOBase_setlinebuf,
369 NULL, /* get_base */
370 NULL, /* get_bufsiz */
371 NULL, /* get_ptr */
372 NULL, /* get_cnt */
373 NULL, /* set_ptrcnt */
374};
375
18f68570 376#endif
814ffeea 377