From: John E. Malmberg <wb8tyw@qsl.net>
Date: Sat, 22 Nov 2008 11:31:58 +0000 (-0600)
Subject: [patch@34896] vms readdir() fixes for UNIX/EFS mode
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0dddfacae0751be5e7e1fe32b399c75ac4e8ecc6;p=p5sagit%2Fp5-mst-13.2.git

[patch@34896] vms readdir() fixes for UNIX/EFS mode
From: "John E. Malmberg" <wb8tyw@qsl.net>
Message-id: <4928420E.2010607@qsl.net>

p4raw-id: //depot/perl@34901
---

diff --git a/vms/vms.c b/vms/vms.c
index e674a8a..08a7991 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -9631,11 +9631,32 @@ Perl_readdir(pTHX_ DIR *dd)
 	&vs_spec,
 	&vs_len);
 
-    /* Drop NULL extensions on UNIX file specification */
-    if ((dd->flags & PERL_VMSDIR_M_UNIXSPECS &&
-	(e_len == 1) && decc_readdir_dropdotnotype)) {
-	e_len = 0;
-	e_spec[0] = '\0';
+    if (dd->flags & PERL_VMSDIR_M_UNIXSPECS) {
+
+        /* In Unix report mode, remove the ".dir;1" from the name */
+        /* if it is a real directory. */
+        if (decc_filename_unix_report || decc_efs_charset) {
+            if ((e_len == 4) && (vs_len == 2) && (vs_spec[1] == '1')) {
+                if ((toupper(e_spec[1]) == 'D') &&
+                    (toupper(e_spec[2]) == 'I') &&
+                    (toupper(e_spec[3]) == 'R')) {
+                    Stat_t statbuf;
+                    int ret_sts;
+
+                    ret_sts = stat(buff, (stat_t *)&statbuf);
+                    if ((ret_sts == 0) && S_ISDIR(statbuf.st_mode)) {
+                        e_len = 0;
+                        e_spec[0] = 0;
+                    }
+                }
+            }
+        }
+
+        /* Drop NULL extensions on UNIX file specification */
+	if ((e_len == 1) && decc_readdir_dropdotnotype) {
+	    e_len = 0;
+	    e_spec[0] = '\0';
+        }
     }
 
     strncpy(dd->entry.d_name, n_spec, n_len + e_len);