X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fwin32io.c;h=7997658f4ed2985418946555226b8e3ac6e7b35a;hb=15af043884e0520355045b5d53efce3cdf6f3094;hp=6152647a7434f24a58c8eec63abc9e4cd5da20f4;hpb=8cf8f3d16d82d8b3561907820401eea7766f2f96;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/win32/win32io.c b/win32/win32io.c
index 6152647..7997658 100644
--- a/win32/win32io.c
+++ b/win32/win32io.c
@@ -10,11 +10,15 @@
 #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
@@ -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,15 +46,15 @@ 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)
 {
- IV code = PerlIOBase_pushed(f,mode,arg);
+ IV code = PerlIOBase_pushed(aTHX_ f,mode,arg);
  if (*PerlIONext(f))
   {
    PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
@@ -69,7 +73,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)
   {
@@ -179,7 +183,7 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch
     }
   }
  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;
@@ -205,7 +209,7 @@ 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;
@@ -232,7 +236,7 @@ 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;
@@ -248,7 +252,7 @@ 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);
@@ -266,7 +270,7 @@ 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;
@@ -279,26 +283,61 @@ PerlIOWin32_tell(PerlIO *f)
 }
 
 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 *
-PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params)
+PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags)
 {
- /* Almost certainly needs more work */
- return PerlIOBase_dup(aTHX_ f, o, params);
+ 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 PerlIO_win32 = {
@@ -308,6 +347,7 @@ PerlIO_funcs PerlIO_win32 = {
  PerlIOWin32_pushed,
  PerlIOWin32_popped,
  PerlIOWin32_open,
+ PerlIOBase_binmode,
  NULL,                 /* getarg */
  PerlIOWin32_fileno,
  PerlIOWin32_dup,
@@ -330,4 +370,5 @@ PerlIO_funcs PerlIO_win32 = {
  NULL, /* set_ptrcnt */
 };
 
+#endif