--- patchlevel.h-orig	Wed May 17 12:33:59 2000

+++ patchlevel.h	Wed May 17 12:33:51 2000

@@ -73,2 +73,3 @@

+	,"VMSSOCK01 - Socket i/o fixes for VMS"

 	,NULL

 };

 

--- doio.c-orig	Wed May 17 09:39:31 2000

+++ doio.c	Wed May 17 09:39:31 2000

@@ -327,7 +327,18 @@

 			    fd = -1;

 		    }

 		    if (dodup)

+#ifdef VMS_DO_SOCKETS

+		    {   

+			char o = 0;

+			if (fd >= 0 && fd <= MAX_FILEISSOCKET) 

+			    o = PL_VMS_file_is_socket[fd];

+#endif

 			fd = PerlLIO_dup(fd);

+#ifdef VMS_DO_SOCKETS

+			if (fd >= 0 && fd <= MAX_FILEISSOCKET) 

+			PL_VMS_file_is_socket[fd] = o;

+		    }

+#endif

 		    else

 			was_fdopen = TRUE;

 		    if (!(fp = PerlIO_fdopen(fd,mode))) {

@@ -830,6 +841,20 @@

 {

     bool retval = FALSE;

     int status;

+

+#ifdef VMS_DO_SOCKETS

+    int fd;

+    if (IoIFP(io)) {

+        fd = fileno(IoIFP(io));

+        if (fd >= 0 && fd <= MAX_FILEISSOCKET) 

+            PL_VMS_file_is_socket[fd] = 0 ;

+    }

+    if (IoOFP(io)) {

+        fd = fileno(IoOFP(io));

+        if (fd >= 0 && fd <= MAX_FILEISSOCKET) 

+            PL_VMS_file_is_socket[fd] = 0 ;

+    }

+#endif

 

     if (IoIFP(io)) {

 	if (IoTYPE(io) == '|') {

--- perlsdio.h-orig	Wed May 17 10:05:22 2000

+++ perlsdio.h	Wed May 17 10:05:14 2000

@@ -13,7 +13,11 @@

 #define PerlIO_stdout()			stdout

 #define PerlIO_stdin()			stdin

 

+#if defined(VMS)

+#define PerlIO_printf			my_fprintf

+#else

 #define PerlIO_printf			fprintf

+#endif

 #define PerlIO_stdoutf			printf

 #define PerlIO_vprintf(f,fmt,a)		vfprintf(f,fmt,a)          

 #define PerlIO_write(f,buf,count)	fwrite1(buf,1,count,f)

--- pp_sys.c-orig	Wed May 17 09:39:32 2000

+++ pp_sys.c	Wed May 17 09:39:33 2000

@@ -2045,6 +2045,11 @@

     fd = PerlSock_socket(domain, type, protocol);

     if (fd < 0)

 	RETPUSHUNDEF;

+#ifdef VMS_DO_SOCKETS

+    if (fd <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd]=1;

+    else if (ckWARN(WARN_IO))  

+        Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");

+#endif

     IoIFP(io) = PerlIO_fdopen(fd, "r");	/* stdio gets confused about sockets */

     IoOFP(io) = PerlIO_fdopen(fd, "w");

     IoTYPE(io) = 's';

@@ -2092,6 +2097,14 @@

     TAINT_PROPER("socketpair");

     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)

 	RETPUSHUNDEF;

+#ifdef VMS_DO_SOCKETS

+    if (fd[0] <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd[0]]=1;

+    else if (ckWARN(WARN_IO))  

+        Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");

+    if (fd[1] <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd[1]]=1;

+    else if (ckWARN(WARN_IO))  

+        Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");

+#endif

     IoIFP(io1) = PerlIO_fdopen(fd[0], "r");

     IoOFP(io1) = PerlIO_fdopen(fd[0], "w");

     IoTYPE(io1) = 's';

@@ -2264,6 +2277,11 @@

     fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);

     if (fd < 0)

 	goto badexit;

+#ifdef VMS_DO_SOCKETS

+    if (fd <= MAX_FILEISSOCKET) PL_VMS_file_is_socket[fd]=1;

+    else if (ckWARN(WARN_IO))  

+        Perl_warner(aTHX_ WARN_IO, "socket file# too large, may have i/o errors");

+#endif

     IoIFP(nstio) = PerlIO_fdopen(fd, "r");

     IoOFP(nstio) = PerlIO_fdopen(fd, "w");

     IoTYPE(nstio) = 's';

--- vms/vms.c-orig	Wed May 17 09:39:35 2000

+++ vms/vms.c	Wed May 17 10:05:14 2000

@@ -3669,6 +3669,10 @@

 }  /* end of do_spawn() */

 /*}}}*/

 

+#ifdef VMS_DO_SOCKETS

+char PL_VMS_file_is_socket[MAX_FILEISSOCKET+1];

+#endif

+

 /* 

  * A simple fwrite replacement which outputs itmsz*nitm chars without

  * introducing record boundaries every itmsz chars.

@@ -3678,7 +3682,13 @@

 my_fwrite(void *src, size_t itmsz, size_t nitm, FILE *dest)

 {

   register char *cp, *end;

-

+#ifdef VMS_DO_SOCKETS

+  int fd = fileno(dest);

+  if (fd >= 0 && fd <= MAX_FILEISSOCKET && PL_VMS_file_is_socket[fd]) {

+      if (write(fd,src,itmsz*nitm) == EOF) return EOF;

+      return 1;

+  }

+#endif

   end = (char *)src + itmsz * nitm;

 

   while ((char *)src <= end) {

@@ -3694,6 +3704,37 @@

 }  /* end of my_fwrite() */

 /*}}}*/

 

+

+/* 

+ * A simple fprintf replacement with socket redirection

+ */

+/*{{{ int my_printf(FILE *f, const char *fmt, ...)  */

+int

+my_fprintf(FILE *f,const char *fmt,...)

+{

+    va_list ap;

+    int result;

+    

+    va_start(ap,fmt);

+#ifdef VMS_DO_SOCKETS

+    {

+        int fd = fileno(f);

+        

+        if (fd >= 0 && fd <= MAX_FILEISSOCKET && PL_VMS_file_is_socket[fd]) {

+            char buffer[2048];  /* oh please don't write any more than this!! */

+            result = vsprintf(buffer,fmt,ap);

+            va_end(ap);

+            if ((result = write(fd,buffer,result)) == EOF) return EOF;

+            return result;

+        }

+    }

+#endif

+    result = vfprintf(f,fmt,ap);

+    va_end(ap);

+    return result;

+}

+/*}}}*/

+

 /*{{{ int my_flush(FILE *fp)*/

 int

 my_flush(FILE *fp)

@@ -5196,6 +5237,13 @@

   newXSproto("VMS::Filespec::candelete",candelete_fromperl,file,"$");

   newXS("File::Copy::rmscopy",rmscopy_fromperl,file);

 

+#ifdef VMS_DO_SOCKETS

+  {

+    int j;

+    for (j = 0; j <= MAX_FILEISSOCKET; j++)  

+        PL_VMS_file_is_socket[j] = 0;

+  }

+#endif

   return;

 }

   

--- vms/vmsish.h-orig	Wed May 17 09:39:36 2000

+++ vms/vmsish.h	Wed May 17 11:48:59 2000

@@ -150,6 +150,7 @@

 #define do_aspawn		Perl_do_aspawn

 #define do_spawn		Perl_do_spawn

 #define my_fwrite		Perl_my_fwrite

+#define my_fprintf		Perl_my_fprintf

 #define my_flush		Perl_my_flush

 #define my_getpwnam		Perl_my_getpwnam

 #define my_getpwuid		Perl_my_getpwuid

@@ -681,6 +682,7 @@

 unsigned long int	do_aspawn (void *, void **, void **);

 unsigned long int	do_spawn (char *);

 int	my_fwrite (void *, size_t, size_t, FILE *);

+int	my_fprintf (FILE *, const char *, ...);

 int	my_flush (FILE *);

 struct passwd *	my_getpwnam (char *name);

 struct passwd *	my_getpwuid (Uid_t uid);

@@ -721,5 +723,12 @@

 #if defined(fileno) && defined(__DECC_VER) && __DECC_VER < 50300000

 #  undef fileno 

 #endif 

+

+/* fixup i/o to sockets, flag which file#'s are sockets */

+#ifdef VMS_DO_SOCKETS

+#define MAX_FILEISSOCKET 256

+extern char PL_VMS_file_is_socket[MAX_FILEISSOCKET+1];

+#endif

+

 

 #endif  /* __vmsish_h_included */

