MS-DOS patches to perl.
Apply this patch to the standard perl source, version 4, patch level 19,
using "patch -p."  Do this in the root directory of the perl source
distribution.

You can cat all these patches together and pipe the output to patch -p.

Len Reed
Holos Software, Inc.
..!gatech!holos0!lbr
holos0!lbr@gatech.edu
--------------------------------------
*** perl.c.old	Thu Nov 14 07:29:28 1991
--- perl.c	Thu Nov 14 08:52:26 1991
***************
*** 50,55 ****
--- 50,67 ----
  #include "patchlevel.h"
  #endif
  
+ #ifndef PRIVLIB
+ #define PRIVLIB "/usr/local/lib/perl"
+ #endif
+ 
+ #ifdef MSDOS
+     /* Binary perl.exe is widely distributed to those who can't rebuild it
+        for lack of tooling.  Hence, PRIVLIB can be run-time overridden.
+        The first directory in $ENV{'PERLLIB'} is used, if it is set.
+     */
+ static char *privlib = PRIVLIB;	/* default, if no PERLLIB */
+ #endif /* MSDOS */
+ 
  char *getenv();
  
  #ifdef IAMSUID
***************
*** 72,77 ****
--- 84,103 ----
  static int nrschar = '\n';      /* final char of rs, or 0777 if none */
  static int nrslen = 1;
  
+ #ifdef MSDOS
+ static struct todo *e_t_ptr;	/* temp file for -e */
+ #define path_sep(s) (index((s), '/') || index((s), '\\') || index((s), ':'))
+ #define PATH_COMP_SEP ';'
+ #ifdef MKS_SUPPORT
+ # define no_mks_args (getenv("MKSARGS") == Nullch)
+ #else
+ # define no_mks_args 1
+ #endif
+ #else
+ #define path_sep(s) index((s), '/')
+ #define PATH_COMP_SEP ':'
+ #endif
+ 
  main(argc,argv,env)
  register int argc;
  register char **argv;
***************
*** 110,115 ****
--- 136,171 ----
       */
      (void)fclose(stdaux);
      (void)fclose(stdprn);
+ 
+     /* Close anything else higher that stdprn for the same reason */
+ 
+     {
+     	int nofiles, i;
+ 	nofiles = dos_get_nofiles();	
+ 	for (i = 5; i < nofiles; i++)
+ 	    (void) close(i);
+     }
+ 
+     /* Duplicate TMP from TMPDIR if only latter exists.  Reverse slashes
+        as a courtesy to desendant processes.
+     */
+ 
+     if (getenv("TMP") == NULL) {	/* if no TMP */
+     	if (s = getenv("TMPDIR")) {	/* if TMPDIR */
+ 	    	/* ( $ENV{'TMP'} = $ENV{'TMPDIR'} ) =~ s,/,\\,g; */
+ 	    char *s2;
+ 
+ 	    s2 = s;
+ 	    New(1190, s, strlen(s) + 5, char);
+ 	    (void) strcpy(s, "TMP=");
+ 	    (void) strcat(s+4, s2);
+ 	    putenv(s);
+ 	    for (s += 4; *s; ++s) {
+ 	    	if (*s == '/')
+ 		    *s = '\\';
+ 	    }
+     	}
+     }
  #endif
      if (do_undump) {
  	origfilename = savestr(argv[0]);
***************
*** 162,172 ****
--- 218,237 ----
  		fatal("No -e allowed in setuid scripts");
  #endif
  	    if (!e_fp) {
+ #ifndef MSDOS
  	        e_tmpname = savestr(TMPPATH);
+ #else
+ 		block_signals();	/* prevent untimely ^C */
+ 		e_tmpname = tempnam("", TMPPATH);  /* uses env $TMP dir */
+ #endif
  		(void)mktemp(e_tmpname);
  		e_fp = fopen(e_tmpname,"w");
  		if (!e_fp)
  		    fatal("Cannot open temporary file");
+ #ifdef MSDOS
+ 			/* tie into temp file cleanup handler, unblock sigs */
+ 		e_t_ptr = add_temp_file(e_fp, -1, NULL, e_tmpname, fdelete, 0);
+ #endif
  	    }
  	    if (argv[1]) {
  		fputs(argv[1],e_fp);
***************
*** 239,249 ****
  	scriptname = e_tmpname;
      }
  
- #ifdef MSDOS
- #define PERLLIB_SEP ';'
- #else
- #define PERLLIB_SEP ':'
- #endif
  #ifndef TAINT		/* Can't allow arbitrary PERLLIB in setuid script */
      {
  	char * s2 = getenv("PERLLIB");
--- 304,309 ----
***************
*** 252,263 ****
  	    /* Break at all separators */
  	    while ( *s2 ) {
  		/* First, skip any consecutive separators */
! 		while ( *s2 == PERLLIB_SEP ) {
  		    /* Uncomment the next line for PATH semantics */
  		    /* (void)apush(stab_array(incstab),str_make(".",1)); */
  		    s2++;
  		}
! 		if ( (s = index(s2,PERLLIB_SEP)) != Nullch ) {
  		    (void)apush(stab_array(incstab),str_make(s2,(int)(s-s2)));
  		    s2 = s+1;
  		} else {
--- 312,323 ----
  	    /* Break at all separators */
  	    while ( *s2 ) {
  		/* First, skip any consecutive separators */
! 		while ( *s2 == PATH_COMP_SEP ) {
  		    /* Uncomment the next line for PATH semantics */
  		    /* (void)apush(stab_array(incstab),str_make(".",1)); */
  		    s2++;
  		}
! 		if ( (s = index(s2,PATH_COMP_SEP)) != Nullch ) {
  		    (void)apush(stab_array(incstab),str_make(s2,(int)(s-s2)));
  		    s2 = s+1;
  		} else {
***************
*** 265,277 ****
  		    break;
  		}
  	    }
  	}
      }
  #endif /* TAINT */
  
- #ifndef PRIVLIB
- #define PRIVLIB "/usr/local/lib/perl"
- #endif
      (void)apush(stab_array(incstab),str_make(PRIVLIB,0));
      (void)apush(stab_array(incstab),str_make(".",1));
  
--- 325,337 ----
  		    break;
  		}
  	    }
+ #ifdef MSDOS
+ 	    privlib = str_get(afetch(stab_array(incstab),0,TRUE));
+ #endif
  	}
      }
  #endif /* TAINT */
  
      (void)apush(stab_array(incstab),str_make(PRIVLIB,0));
      (void)apush(stab_array(incstab),str_make(".",1));
  
***************
*** 290,313 ****
  #else
  	scriptname = "-";
  #endif
!     if (dosearch && !index(scriptname, '/') && (s = getenv("PATH"))) {
! 	char *xfound = Nullch, *xfailed = Nullch;
  	int len;
  
! 	bufend = s + strlen(s);
! 	while (*s) {
! #ifndef MSDOS
! 	    s = cpytill(tokenbuf,s,bufend,':',&len);
! #else
! 	    for (len = 0; *s && *s != ';'; tokenbuf[len++] = *s++);
! 	    tokenbuf[len] = '\0';
  #endif
  	    if (*s)
  		s++;
  #ifndef MSDOS
  	    if (len && tokenbuf[len-1] != '/')
  #else
! 	    if (len && tokenbuf[len-1] != '\\')
  #endif
  		(void)strcat(tokenbuf+len,"/");
  	    (void)strcat(tokenbuf+len,scriptname);
--- 350,383 ----
  #else
  	scriptname = "-";
  #endif
!     if (dosearch && !path_sep(scriptname) && (s = getenv("PATH"))) {
! 	char *xfound = Nullch;
! #ifndef MSDOS
! 	char *xfailed = Nullch;
! #endif
  	int len;
  
! #ifdef MSDOS
! 	    /* DOS PATH semantics always look in cur directory 1st:
! 	       Exception: MKS users have Unix-like PATH
! 	    */
! 	if (no_mks_args && stat(scriptname,&statbuf) == 0) {
! 	    xfound = scriptname;   /* bingo! */
! 	    *s = '\0';		/* avoid while loop */
! 	}
! 	else	/* don't do strlen if we already found file */
  #endif
+ 	{
+ 	    bufend = s + strlen(s);
+ 	}
+ 	while (*s) {
+ 	    s = cpytill(tokenbuf,s,bufend,PATH_COMP_SEP,&len);
  	    if (*s)
  		s++;
  #ifndef MSDOS
  	    if (len && tokenbuf[len-1] != '/')
  #else
! 	    if (len && tokenbuf[len-1] != '\\' && tokenbuf[len-1] != '/')
  #endif
  		(void)strcat(tokenbuf+len,"/");
  	    (void)strcat(tokenbuf+len,scriptname);
***************
*** 317,322 ****
--- 387,393 ----
  #endif
  	    if (stat(tokenbuf,&statbuf) < 0)		/* not there? */
  		continue;
+ #ifndef MSDOS
  	    if (S_ISREG(statbuf.st_mode)
  	     && cando(S_IRUSR,TRUE,&statbuf) && cando(S_IXUSR,TRUE,&statbuf)) {
  		xfound = tokenbuf;              /* bingo! */
***************
*** 324,335 ****
  	    }
  	    if (!xfailed)
  		xfailed = savestr(tokenbuf);
  	}
  	if (!xfound)
  	    fatal("Can't execute %s", xfailed ? xfailed : scriptname );
  	if (xfailed)
  	    Safefree(xfailed);
! 	scriptname = savestr(xfound);
      }
  
      fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
--- 395,417 ----
  	    }
  	    if (!xfailed)
  		xfailed = savestr(tokenbuf);
+ #else
+ 	    xfound = tokenbuf;	/* all files "executable" on MS-DOS */
+ 	    break;
+ #endif
  	}
+ #ifndef MSDOS
  	if (!xfound)
  	    fatal("Can't execute %s", xfailed ? xfailed : scriptname );
  	if (xfailed)
  	    Safefree(xfailed);
! #else
! 	if (!xfound)
! 	    fatal("Can't execute %s", scriptname );
! #endif
! 	if (xfound != scriptname) {
! 	    scriptname = savestr(xfound);
! 	}
      }
  
      fdpid = anew(Nullstab);	/* for remembering popen pids by fd */
***************
*** 340,345 ****
--- 422,428 ----
      if (strEQ(origfilename,"-"))
  	scriptname = "";
      if (preprocess) {
+ #ifndef MSDOS
  	char *cpp = CPPSTDIN;
  
  	if (strEQ(cpp,"cppstdin"))
***************
*** 361,371 ****
   -e '/^#[ 	]*endif/b' \
   -e 's/^[ 	]*#.*//' \
   %s | %s -C %s %s",
- #ifdef MSDOS
- 	  "",
- #else
  	  "/bin/",
- #endif
  	  (doextract ? "-e '1,/^#/d\n'" : ""),
  	  scriptname, tokenbuf, str_get(str), CPPMINUS);
  #ifdef DEBUGGING
--- 444,450 ----
***************
*** 387,392 ****
--- 466,477 ----
  #endif
  #endif
  #endif /* IAMSUID */
+ #else	/* MSDOS */
+ 		/* MS-DOS system may not have sed but it has perl */
+ 	(void) sprintf(buf, "%s -s %s/doscpp.pl %s %s",
+ 		    *origargv, privlib, argv[0],
+ 		    (doextract ? "-x" : ""));
+ #endif
  	rsfp = mypopen(buf,"r");
      }
      else if (!*scriptname) {
***************
*** 396,403 ****
  #endif
  	rsfp = stdin;
      }
!     else
  	rsfp = fopen(scriptname,"r");
      if ((FILE*)rsfp == Nullfp) {
  #ifdef DOSUID
  #ifndef IAMSUID		/* in case script is not readable before setuid */
--- 481,498 ----
  #endif
  	rsfp = stdin;
      }
!     else {
! #ifdef MSDOS
!     	if (e_fp) {
! 	    block_signals();
! 	    rsfp = fopen(e_tmpname, "r");
! 	    e_t_ptr->hfd.f = rsfp;	/* new (FILE *) in temp file list */
! 	    unblock_signals();
! 	}
! 	else	/* handle like Unix */
! #endif /* MSDOS */
  	rsfp = fopen(scriptname,"r");
+     }
      if ((FILE*)rsfp == Nullfp) {
  #ifdef DOSUID
  #ifndef IAMSUID		/* in case script is not readable before setuid */
***************
*** 694,701 ****
  
      preprocess = FALSE;
      if (e_fp) {
! 	e_fp = Nullfp;
  	(void)UNLINK(e_tmpname);
      }
  
      /* initialize everything that won't change if we undump */
--- 789,800 ----
  
      preprocess = FALSE;
      if (e_fp) {
! #ifndef MSDOS
  	(void)UNLINK(e_tmpname);
+ #else
+ 	mypclose(e_fp);	/* this will unlink the temp file */
+ #endif
+ 	e_fp = Nullfp;
      }
  
      /* initialize everything that won't change if we undump */
***************
*** 1300,1305 ****
--- 1399,1406 ----
  #ifdef MSDOS
  	fputs("MS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n",
  	stdout);
+ 	fputs("MS-DOS enhancements Copyright (c) 1990, 1991 Leonard Reed\n",
+ 	stdout);
  #ifdef OS2
          fputs("OS/2 port Copyright (c) 1990, Raymond Chen, Kai Uwe Rommel\n",
          stdout);
***************
*** 1308,1316 ****
  	fputs("\n\
  Perl may be copied only under the terms of either the Artistic License or the\n\
  GNU General Public License, which may be found in the Perl 4.0 source kit.\n",stdout);
- #ifdef MSDOS
-         usage(origargv[0]);
- #endif
  	exit(0);
      case 'w':
  	dowarn = TRUE;
--- 1409,1414 ----
***************
*** 1359,1362 ****
  #endif /* ! MSDOS */
  #endif
  }
- 
--- 1457,1459 ----
