#include <sys/stat.h>
#include "EXTERN.h"
#include "perl.h"
+
+#ifdef PERLIO_LAYERS
+
#include "perliol.h"
#define NO_XSLOCKS
#include "XSUB.h"
+
/* Bottom-most level for Win32 case */
typedef struct
IV max_open_fd = -1;
IV
-PerlIOWin32_popped(PerlIO *f)
+PerlIOWin32_popped(pTHX_ PerlIO *f)
{
PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
if (--s->refcnt > 0)
}
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);
{
/* 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)
{
}
}
if (h != INVALID_HANDLE_VALUE)
- fd = win32_open_osfhandle((long) h, PerlIOUnix_oflags(tmode));
+ fd = win32_open_osfhandle((intptr_t) h, PerlIOUnix_oflags(tmode));
if (fd >= 0)
{
PerlIOWin32 *s;
s->h = h;
s->fd = fd;
s->refcnt = 1;
- if (fd >= 0)
+ if (fd >= 0)
{
- fdtable[fd] = s;
+ fdtable[fd] = s;
if (fd > max_open_fd)
max_open_fd = fd;
- }
+ }
return f;
}
if (f)
}
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;
}
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;
}
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;
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;
}
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)
{
return ((Off_t) high << 32) | res;
}
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;
+ if (DuplicateHandle(proc, os->h, proc, &new, 0, FALSE, DUPLICATE_SAME_ACCESS))
+ {
+ char mode[8];
+ int fd = win32_open_osfhandle((intptr_t) new, 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;
+ 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);
+ }
+ }
+ 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,
NULL, /* set_ptrcnt */
};
+#endif