perl 3.0 patch #39 patch #38, continued

See patch #38.

5 files changed, 61 insertions, 9 deletions

diff --git a/os2/director.c b/os2/director.c
index a360af712b..d5accd73e1 100644
--- a/os2/director.c
+++ b/os2/director.c
@@ -5,16 +5,19 @@
  *  MS-DOS.  Written by Michael Rendell ({uunet,utai}michael@garfield),
  *  August 1897
  *  Ported to OS/2 by Kai Uwe Rommel
- *  December 1989
+ *  December 1989, February 1990
+ *  Change for HPFS support, October 1990
  */
 
 #include <sys/types.h>
 #include <sys/stat.h>
 #include <sys/dir.h>
 
+#include <stdlib.h>
 #include <stdio.h>
 #include <malloc.h>
 #include <string.h>
+#include <ctype.h>
 
 #define INCL_NOPM
 #include <os2.h>
@@ -29,6 +32,7 @@ static void free_dircontents(struct _dircontents *);
 static HDIR hdir;
 static USHORT count;
 static FILEFINDBUF find;
+static BOOL lower;
 
 
 DIR *opendir(char *name)
@@ -125,7 +129,6 @@ struct direct *readdir(DIR * dirp)
   dp.d_namlen = dp.d_reclen =
     strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry));
 
-  strlwr(dp.d_name);		       /* JF */
   dp.d_ino = 0;
 
   dp.d_size = dirp -> dd_cp -> _d_size;
@@ -176,12 +179,52 @@ static void free_dircontents(struct _dircontents * dp)
 }
 
 
+static int IsFileSystemFAT(char *dir)
+{
+  USHORT nDrive;
+  ULONG lMap;
+  BYTE bData[64], bName[3];
+  USHORT cbData;
+
+  if ( _osmode == DOS_MODE )
+    return TRUE;
+  else
+  {
+    /* We separate FAT and HPFS file systems here.
+     * Filenames read from a FAT system are converted to lower case
+     * while the case of filenames read from a HPFS (and other future
+     * file systems, like Unix-compatibles) is preserved.
+     */
+
+    if ( isalpha(dir[0]) && (dir[1] == ':') )
+      nDrive = toupper(dir[0]) - '@';
+    else
+      DosQCurDisk(&nDrive, &lMap);
+
+    bName[0] = (char) (nDrive + '@');
+    bName[1] = ':';
+    bName[2] = 0;
+
+    cbData = sizeof(bData);
+
+    if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) )
+      return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT");
+    else
+      return FALSE;
+
+    /* End of this ugly code */
+  }
+}
+
+
 static char *getdirent(char *dir)
 {
   int done;
 
   if (dir != NULL)
   {				       /* get first entry */
+    lower = IsFileSystemFAT(dir);
+
     hdir = HDIR_CREATE;
     count = 1;
     done = DosFindFirst(dir, &hdir, attributes,
@@ -190,6 +233,9 @@ static char *getdirent(char *dir)
   else				       /* get next entry */
     done = DosFindNext(hdir, &find, sizeof(find), &count);
 
+  if ( lower )
+    strlwr(find.achName);
+
   if (done == 0)
     return find.achName;
   else
diff --git a/os2/os2.c b/os2/os2.c
index 279a88f88b..a1a464bf24 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1,4 +1,4 @@
-/* $Header: os2.c,v 3.0.1.1 90/10/15 17:49:55 lwall Locked $
+/* $Header: os2.c,v 3.0.1.2 90/11/10 01:42:38 lwall Locked $
  *
  *    (C) Copyright 1989, 1990 Diomidis Spinellis.
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:	os2.c,v $
+ * Revision 3.0.1.2  90/11/10  01:42:38  lwall
+ * patch38: more msdos/os2 upgrades
+ * 
  * Revision 3.0.1.1  90/10/15  17:49:55  lwall
  * patch29: Initial revision
  * 
@@ -50,7 +53,7 @@ int syscall()
 int chdir(char *path)
 {
   if ( path[0] != 0 && path[1] == ':' )
-    DosSelectDisk(tolower(path[0]) - '@');
+    DosSelectDisk(toupper(path[0]) - '@');
 
   DosChDir(path, 0L);
 }
diff --git a/os2/perl.bad b/os2/perl.bad
index bec21328fc..870785aa52 100644
--- a/os2/perl.bad
+++ b/os2/perl.bad
@@ -4,3 +4,4 @@ DOSKILLPROCESS
 DOSFLAGPROCESS
 DOSSETPRTY
 DOSGETPRTY
+DOSQFSATTACH
diff --git a/os2/perl.cs b/os2/perl.cs
index 530f0930df..416e29c397 100644
--- a/os2/perl.cs
+++ b/os2/perl.cs
@@ -3,11 +3,13 @@ array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c
 hash.c perl.c perly.c regcomp.c regexec.c stab.c str.c util.c
 )
 (-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c{evalargs.xc} toke.c)
-(-W1 -Od -Olt os2.c popen.c mktemp.c director.c suffix.c)
+(-W1 -Od -Olt -I.
+os2\os2.c os2\popen.c os2\mktemp.c os2\director.c os2\suffix.c
+)
 
 setargv.obj
-perl.def
-perl.bad
+os2\perl.def
+os2\perl.bad
 perl.exe
 
--AL -LB -S0x9000
+-AL -LB -S0x8800
diff --git a/os2/perl.def b/os2/perl.def
index 2b49370937..2c990c26aa 100644
--- a/os2/perl.def
+++ b/os2/perl.def
@@ -1,2 +1,2 @@
 NAME PERL WINDOWCOMPAT NEWFILES
-DESCRIPTION 'PERL 3.0, patchlevel 28 - for MS-DOS and OS/2'
+DESCRIPTION 'PERL 3.0, patchlevel 37 - for MS-DOS and OS/2'