Commit | Line | Data |
a8c08ecd |
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 | |
10 | #include <sys/stat.h> |
11 | #include "EXTERN.h" |
12 | #include "perl.h" |
0c4128ad |
13 | #include "perliol.h" |
a8c08ecd |
14 | |
15 | #define NO_XSLOCKS |
16 | #include "XSUB.h" |
17 | |
18 | /* Bottom-most level for Win32 case */ |
19 | |
20 | typedef struct |
21 | { |
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 */ |
26 | } PerlIOWin32; |
27 | |
28 | PerlIOWin32 *fdtable[256]; |
29 | IV max_open_fd = -1; |
30 | |
31 | IV |
32 | PerlIOWin32_popped(PerlIO *f) |
33 | { |
34 | PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); |
35 | if (--s->refcnt > 0) |
36 | { |
37 | *f = PerlIOBase(f)->next; |
38 | return 1; |
39 | } |
40 | fdtable[s->fd] = NULL; |
41 | return 0; |
42 | } |
43 | |
44 | IV |
45 | PerlIOWin32_fileno(PerlIO *f) |
46 | { |
47 | return PerlIOSelf(f,PerlIOWin32)->fd; |
48 | } |
49 | |
50 | IV |
51 | PerlIOWin32_pushed(PerlIO *f, const char *mode, SV *arg) |
52 | { |
53 | IV code = PerlIOBase_pushed(f,mode,arg); |
54 | if (*PerlIONext(f)) |
55 | { |
56 | PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); |
57 | s->fd = PerlIO_fileno(PerlIONext(f)); |
58 | } |
59 | PerlIOBase(f)->flags |= PERLIO_F_OPEN; |
60 | return code; |
61 | } |
62 | |
63 | PerlIO * |
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) |
65 | { |
66 | const char *tmode = mode; |
67 | HANDLE h = INVALID_HANDLE_VALUE; |
68 | if (f) |
69 | { |
70 | /* Close if already open */ |
71 | if (PerlIOBase(f)->flags & PERLIO_F_OPEN) |
72 | (*PerlIOBase(f)->tab->Close)(f); |
73 | } |
74 | if (narg > 0) |
75 | { |
76 | char *path = SvPV_nolen(*args); |
77 | DWORD access = 0; |
78 | DWORD share = 0; |
79 | DWORD create = -1; |
80 | DWORD attr = FILE_ATTRIBUTE_NORMAL; |
81 | if (*mode == '#') |
82 | { |
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 |
86 | */ |
87 | mode++; |
88 | } |
89 | else |
90 | { |
91 | /* Normal open - decode mode string */ |
92 | } |
93 | switch(*mode) |
94 | { |
95 | case 'r': |
96 | access = GENERIC_READ; |
97 | create = OPEN_EXISTING; |
98 | if (*++mode == '+') |
99 | { |
100 | access |= GENERIC_WRITE; |
101 | create = OPEN_ALWAYS; |
102 | mode++; |
103 | } |
104 | break; |
105 | |
106 | case 'w': |
107 | access = GENERIC_WRITE; |
108 | create = TRUNCATE_EXISTING; |
109 | if (*++mode == '+') |
110 | { |
111 | access |= GENERIC_READ; |
112 | mode++; |
113 | } |
114 | break; |
115 | |
116 | case 'a': |
117 | access = GENERIC_WRITE; |
118 | create = OPEN_ALWAYS; |
119 | if (*++mode == '+') |
120 | { |
121 | access |= GENERIC_READ; |
122 | mode++; |
123 | } |
124 | break; |
125 | } |
126 | if (*mode == 'b') |
127 | { |
128 | mode++; |
129 | } |
130 | else if (*mode == 't') |
131 | { |
132 | mode++; |
133 | } |
0c4128ad |
134 | if (*mode || create == -1) |
a8c08ecd |
135 | { |
136 | SETERRNO(EINVAL,LIB$_INVARG); |
137 | return NULL; |
138 | } |
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) |
143 | { |
144 | if (create == TRUNCATE_EXISTING) |
0c4128ad |
145 | h = CreateFile(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL); |
a8c08ecd |
146 | } |
147 | } |
148 | else |
149 | { |
150 | /* fd open */ |
151 | h = INVALID_HANDLE_VALUE; |
152 | if (fd >= 0 && fd <= max_open_fd) |
153 | { |
154 | PerlIOWin32 *s = fdtable[fd]; |
155 | if (s) |
156 | { |
157 | s->refcnt++; |
158 | if (!f) |
159 | f = PerlIO_allocate(aTHX); |
160 | *f = &s->base; |
161 | return f; |
162 | } |
0c4128ad |
163 | } |
164 | if (*mode == 'I') |
165 | { |
166 | mode++; |
167 | switch(fd) |
a8c08ecd |
168 | { |
0c4128ad |
169 | case 0: |
170 | h = GetStdHandle(STD_INPUT_HANDLE); |
171 | break; |
172 | case 1: |
173 | h = GetStdHandle(STD_OUTPUT_HANDLE); |
174 | break; |
175 | case 2: |
176 | h = GetStdHandle(STD_ERROR_HANDLE); |
177 | break; |
a8c08ecd |
178 | } |
179 | } |
180 | } |
181 | if (h != INVALID_HANDLE_VALUE) |
0c4128ad |
182 | fd = win32_open_osfhandle((long) h, PerlIOUnix_oflags(tmode)); |
183 | if (fd >= 0) |
a8c08ecd |
184 | { |
185 | PerlIOWin32 *s; |
186 | if (!f) |
187 | f = PerlIO_allocate(aTHX); |
188 | s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32); |
0c4128ad |
189 | s->h = h; |
190 | s->fd = fd; |
a8c08ecd |
191 | s->refcnt = 1; |
0c4128ad |
192 | if (fd >= 0) |
193 | { |
194 | fdtable[fd] = s; |
195 | if (fd > max_open_fd) |
196 | max_open_fd = fd; |
197 | } |
a8c08ecd |
198 | return f; |
199 | } |
200 | if (f) |
201 | { |
202 | /* FIXME: pop layers ??? */ |
203 | } |
204 | return NULL; |
205 | } |
206 | |
207 | SSize_t |
208 | PerlIOWin32_read(PerlIO *f, void *vbuf, Size_t count) |
209 | { |
210 | PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); |
211 | DWORD len; |
212 | if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) |
213 | return 0; |
0c4128ad |
214 | if (ReadFile(s->h,vbuf,count,&len,NULL)) |
a8c08ecd |
215 | { |
216 | return len; |
217 | } |
218 | else |
219 | { |
220 | if (GetLastError() != NO_ERROR) |
221 | { |
222 | PerlIOBase(f)->flags |= PERLIO_F_ERROR; |
223 | return -1; |
224 | } |
225 | else |
226 | { |
227 | if (count != 0) |
228 | PerlIOBase(f)->flags |= PERLIO_F_EOF; |
229 | return 0; |
230 | } |
231 | } |
232 | } |
233 | |
234 | SSize_t |
235 | PerlIOWin32_write(PerlIO *f, const void *vbuf, Size_t count) |
236 | { |
237 | PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); |
238 | DWORD len; |
0c4128ad |
239 | if (WriteFile(s->h,vbuf,count,&len,NULL)) |
a8c08ecd |
240 | { |
241 | return len; |
242 | } |
243 | else |
244 | { |
245 | PerlIOBase(f)->flags |= PERLIO_F_ERROR; |
246 | return -1; |
247 | } |
248 | } |
249 | |
250 | IV |
251 | PerlIOWin32_seek(PerlIO *f, Off_t offset, int whence) |
252 | { |
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) |
259 | { |
260 | return 0; |
261 | } |
262 | else |
263 | { |
264 | return -1; |
265 | } |
266 | } |
267 | |
268 | Off_t |
269 | PerlIOWin32_tell(PerlIO *f) |
270 | { |
271 | PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); |
272 | DWORD high = 0; |
273 | DWORD res = SetFilePointer(s->h,0,&high,FILE_CURRENT); |
274 | if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR) |
275 | { |
276 | return ((Off_t) high << 32) | res; |
277 | } |
278 | return (Off_t) -1; |
279 | } |
280 | |
281 | IV |
282 | PerlIOWin32_close(PerlIO *f) |
283 | { |
284 | PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); |
285 | if (s->refcnt == 1) |
286 | { |
287 | if (CloseHandle(s->h)) |
288 | { |
289 | s->h = INVALID_HANDLE_VALUE; |
290 | return -1; |
291 | } |
292 | } |
293 | PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; |
294 | return 0; |
295 | } |
296 | |
297 | PerlIO_funcs PerlIO_win32 = { |
298 | "win32", |
299 | sizeof(PerlIOWin32), |
300 | PERLIO_K_RAW, |
301 | PerlIOWin32_pushed, |
302 | PerlIOWin32_popped, |
303 | PerlIOWin32_open, |
304 | NULL, /* getarg */ |
305 | PerlIOWin32_fileno, |
306 | PerlIOWin32_read, |
307 | PerlIOBase_unread, |
308 | PerlIOWin32_write, |
309 | PerlIOWin32_seek, |
310 | PerlIOWin32_tell, |
311 | PerlIOWin32_close, |
312 | PerlIOBase_noop_ok, /* flush */ |
313 | PerlIOBase_noop_fail, /* fill */ |
314 | PerlIOBase_eof, |
315 | PerlIOBase_error, |
316 | PerlIOBase_clearerr, |
317 | PerlIOBase_setlinebuf, |
318 | NULL, /* get_base */ |
319 | NULL, /* get_bufsiz */ |
320 | NULL, /* get_ptr */ |
321 | NULL, /* get_cnt */ |
322 | NULL, /* set_ptrcnt */ |
323 | }; |
324 | |
325 | |