X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a8c08ecdc5ffec9869657a967edfe7b74a713a27..40bca5ae9c72f416f0e0e056ecf8e205a03e5be3:/win32/win32io.c diff --git a/win32/win32io.c b/win32/win32io.c index e75919f..0483602 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -10,11 +10,15 @@ #include #include "EXTERN.h" #include "perl.h" -#include "perllio.h" + +#ifdef PERLIO_LAYERS + +#include "perliol.h" #define NO_XSLOCKS #include "XSUB.h" + /* Bottom-most level for Win32 case */ typedef struct @@ -29,7 +33,7 @@ PerlIOWin32 *fdtable[256]; IV max_open_fd = -1; IV -PerlIOWin32_popped(PerlIO *f) +PerlIOWin32_popped(pTHX_ PerlIO *f) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); if (--s->refcnt > 0) @@ -42,21 +46,26 @@ PerlIOWin32_popped(PerlIO *f) } IV -PerlIOWin32_fileno(PerlIO *f) +PerlIOWin32_fileno(pTHX_ PerlIO *f) { return PerlIOSelf(f,PerlIOWin32)->fd; } IV -PerlIOWin32_pushed(PerlIO *f, const char *mode, SV *arg) +PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - IV code = PerlIOBase_pushed(f,mode,arg); + IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab); if (*PerlIONext(f)) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); s->fd = PerlIO_fileno(PerlIONext(f)); } PerlIOBase(f)->flags |= PERLIO_F_OPEN; + + Perl_ck_warner_d(aTHX_ + packWARN(WARN_EXPERIMENTAL__WIN32_PERLIO), + "PerlIO layer ':win32' is experimental"); + return code; } @@ -69,7 +78,7 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch { /* Close if already open */ if (PerlIOBase(f)->flags & PERLIO_F_OPEN) - (*PerlIOBase(f)->tab->Close)(f); + (*PerlIOBase(f)->tab->Close)(aTHX_ f); } if (narg > 0) { @@ -131,7 +140,7 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch { mode++; } - if (*mode || oflags == -1) + if (*mode || create == -1) { SETERRNO(EINVAL,LIB$_INVARG); return NULL; @@ -142,7 +151,7 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch if (h == INVALID_HANDLE_VALUE) { if (create == TRUNCATE_EXISTING) - h = CreateFile(path,access,share = OPEN_ALWAYS,NULL,create,attr,NULL); + h = CreateFile(path,access,share,NULL,(create = OPEN_ALWAYS),attr,NULL); } } else @@ -160,32 +169,41 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch *f = &s->base; return f; } - if (*mode == 'I') + } + if (*mode == 'I') + { + mode++; + switch(fd) { - mode++; - switch(fd) - { - case 0: - h = GetStandardHandle(STD_INPUT_HANDLE); - break; - case 1: - h = GetStandardHandle(STD_OUTPUT_HANDLE); - break; - case 2: - h = GetStandardHandle(STD_ERROR_HANDLE); - break; - } + case 0: + h = GetStdHandle(STD_INPUT_HANDLE); + break; + case 1: + h = GetStdHandle(STD_OUTPUT_HANDLE); + break; + case 2: + h = GetStdHandle(STD_ERROR_HANDLE); + break; } } } if (h != INVALID_HANDLE_VALUE) + fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode)); + if (fd >= 0) { PerlIOWin32 *s; if (!f) f = PerlIO_allocate(aTHX); s = PerlIOSelf(PerlIO_push(aTHX_ f,self,tmode,PerlIOArg),PerlIOWin32); - s->ioh = h; + s->h = h; + s->fd = fd; s->refcnt = 1; + if (fd >= 0) + { + fdtable[fd] = s; + if (fd > max_open_fd) + max_open_fd = fd; + } return f; } if (f) @@ -196,13 +214,13 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch } SSize_t -PerlIOWin32_read(PerlIO *f, void *vbuf, Size_t count) +PerlIOWin32_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); DWORD len; if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) return 0; - if (ReadFile(s->h,vbuf,count,&len,NULL) + if (ReadFile(s->h,vbuf,count,&len,NULL)) { return len; } @@ -223,11 +241,11 @@ PerlIOWin32_read(PerlIO *f, void *vbuf, Size_t count) } SSize_t -PerlIOWin32_write(PerlIO *f, const void *vbuf, Size_t count) +PerlIOWin32_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); DWORD len; - if (WriteFile(s->h,vbuf,count,&len,NULL) + if (WriteFile(s->h,vbuf,count,&len,NULL)) { return len; } @@ -239,13 +257,17 @@ PerlIOWin32_write(PerlIO *f, const void *vbuf, Size_t count) } IV -PerlIOWin32_seek(PerlIO *f, Off_t offset, int whence) +PerlIOWin32_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { static const DWORD where[3] = { FILE_BEGIN, FILE_CURRENT, FILE_END }; PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); - DWORD high = (sizeof(offset) > sizeof(DWORD)) ? (DWORD)(offset >> 32) : 0; +#if Off_t_size >= 8 + DWORD high = (DWORD)(offset >> 32); +#else + DWORD high = 0; +#endif DWORD low = (DWORD) offset; - DWORD res = SetFilePointer(s->h,low,&high,where[whence]); + DWORD res = SetFilePointer(s->h,(LONG)low,(LONG *)&high,where[whence]); if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR) { return 0; @@ -257,43 +279,92 @@ PerlIOWin32_seek(PerlIO *f, Off_t offset, int whence) } Off_t -PerlIOWin32_tell(PerlIO *f) +PerlIOWin32_tell(pTHX_ PerlIO *f) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); DWORD high = 0; - DWORD res = SetFilePointer(s->h,0,&high,FILE_CURRENT); + DWORD res = SetFilePointer(s->h,0,(LONG *)&high,FILE_CURRENT); if (res != 0xFFFFFFFF || GetLastError() != NO_ERROR) { +#if Off_t_size >= 8 return ((Off_t) high << 32) | res; +#else + return res; +#endif } return (Off_t) -1; } IV -PerlIOWin32_close(PerlIO *f) +PerlIOWin32_close(pTHX_ PerlIO *f) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); if (s->refcnt == 1) { - if (CloseHandle(s->h)) + IV code = 0; +#if 0 + /* This does not do pipes etc. correctly */ + if (!CloseHandle(s->h)) { s->h = INVALID_HANDLE_VALUE; return -1; } +#else + PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; + return win32_close(s->fd); +#endif } - PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; return 0; } -PerlIO_funcs PerlIO_win32 = { +PerlIO * +PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags) +{ + PerlIOWin32 *os = PerlIOSelf(f,PerlIOWin32); + HANDLE proc = GetCurrentProcess(); + HANDLE new_h; + if (DuplicateHandle(proc, os->h, proc, &new_h, 0, FALSE, DUPLICATE_SAME_ACCESS)) + { + char mode[8]; + int fd = win32_open_osfhandle((intptr_t) new_h, PerlIOUnix_oflags(PerlIO_modestr(o,mode))); + if (fd >= 0) + { + f = PerlIOBase_dup(aTHX_ f, o, params, flags); + if (f) + { + PerlIOWin32 *fs = PerlIOSelf(f,PerlIOWin32); + fs->h = new_h; + fs->fd = fd; + fs->refcnt = 1; + fdtable[fd] = fs; + if (fd > max_open_fd) + max_open_fd = fd; + } + else + { + win32_close(fd); + } + } + else + { + CloseHandle(new_h); + } + } + return f; +} + +PERLIO_FUNCS_DECL(PerlIO_win32) = { + sizeof(PerlIO_funcs), "win32", sizeof(PerlIOWin32), PERLIO_K_RAW, PerlIOWin32_pushed, PerlIOWin32_popped, PerlIOWin32_open, + PerlIOBase_binmode, NULL, /* getarg */ PerlIOWin32_fileno, + PerlIOWin32_dup, PerlIOWin32_read, PerlIOBase_unread, PerlIOWin32_write, @@ -313,4 +384,5 @@ PerlIO_funcs PerlIO_win32 = { NULL, /* set_ptrcnt */ }; +#endif