This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Restore directory extension and version in fileify under EFS.
authorCraig A. Berry <craigberry@mac.com>
Sat, 28 Jan 2012 15:22:04 +0000 (09:22 -0600)
committerCraig A. Berry <craigberry@mac.com>
Sat, 28 Jan 2012 15:22:04 +0000 (09:22 -0600)
In df2786654 and 8a5aa89570, the traditional behavior of adding
the .DIR;1 onto a fileified directory spec was removed when
operating under Extended Filename Syntax.  Various scary comments
were added about its being a bug to add a type and version onto
a Unix-style path, but actually the CRTL appears to be perfectly
happy with, for example:

   stat('/foo/bar/baz.dir;1');

and without the extension, the home-grown rmdir() fails in the
case of a directory with no preceding path information.  E.g.,

   rmdir('foo');

was failing because there was no internal translation to foo.dir
before passing it to SYS$ERASE.

Moreover, even if there were something wrong with adding .DIR;1,
it has nothing to do with EFS.

vms/ext/filespec.t
vms/vms.c

index f5f71ce..86cdc76 100755 (executable)
@@ -130,14 +130,14 @@ __some_/__where_/...   vmsify  [.__some_.__where_...] ^*
 # Fileifying directory specs
 __down_:[__the_.__garden_.__path_]     fileify __down_:[__the_.__garden_]__path_.dir;1 ^
 [.__down_.__the_.__garden_.__path_]    fileify [.__down_.__the_.__garden_]__path_.dir;1 ^
-/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
-/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1 /__down_/__the_/__garden_/__path_
-__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1 __down_/__the_/__garden_/__path_
+/__down_/__the_/__garden_/__path_      fileify /__down_/__the_/__garden_/__path_.dir;1 ^
+/__down_/__the_/__garden_/__path_/     fileify /__down_/__the_/__garden_/__path_.dir;1 ^
+__down_/__the_/__garden_/__path_       fileify __down_/__the_/__garden_/__path_.dir;1 ^
 __down_:[__the_.__garden_]__path_      fileify __down_:[__the_.__garden_]__path_.dir;1 ^
 __down_:[__the_.__garden_]__path_.     fileify ^ __down_:[__the_.__garden_]__path_^..dir;1 # N.B. trailing . ==> null type
 __down_:[__the_]__garden_.__path_      fileify ^ __down_:[__the_]__garden_^.__path_.dir;1 #undef
-/__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_. # N.B. trailing . ==> null type
-/__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_
+/__down_/__the_/__garden_/__path_.     fileify ^ /__down_/__the_/__garden_/__path_..dir;1 # N.B. trailing . ==> null type
+/__down_/__the_/__garden_.__path_      fileify ^ /__down_/__the_/__garden_.__path_.dir;1
 
 # and pathifying them
 __down_:[__the_.__garden_]__path_.dir;1        pathify __down_:[__the_.__garden_.__path_] ^
index 507d3b4..dafb655 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -5908,8 +5908,6 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
     char *cp1, *cp2, *lastdir;
     char *trndir, *vmsdir;
     unsigned short int trnlnm_iter_count;
-    int is_vms = 0;
-    int is_unix = 0;
     int sts;
     if (utf8_fl != NULL)
        *utf8_fl = 0;
@@ -5992,30 +5990,6 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
     cp1 = strpbrk(trndir,"]:>");
     if (hasfilename || !cp1) { /* filename present or not VMS */
 
-      if (decc_efs_charset && !cp1) {
-
-          /* EFS handling for UNIX mode */
-
-          /* Just remove the trailing '/' and we should be done */
-          STRLEN trndir_len;
-          trndir_len = strlen(trndir);
-
-          if (trndir_len > 1) {
-              trndir_len--;
-              if (trndir[trndir_len] == '/') {
-                  trndir[trndir_len] = '\0';
-              }
-          }
-          my_strlcpy(buf, trndir, VMS_MAXRSS);
-          PerlMem_free(trndir);
-          PerlMem_free(vmsdir);
-          return buf;
-      }
-
-      /* For non-EFS mode, this is left for backwards compatibility */
-      /* For EFS mode, this is only done for VMS format filespecs as */
-      /* Perl programs generally have problems when a UNIX format spec */
-      /* returns a VMS format spec */
       if (trndir[0] == '.') {
         if (trndir[1] == '\0' || (trndir[1] == '/' && trndir[2] == '\0')) {
          PerlMem_free(trndir);
@@ -6157,52 +6131,10 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl)
 
       /* We've picked up everything up to the directory file name.
          Now just add the type and version, and we're set. */
-
-      /* We should only add type for VMS syntax, but historically Perl
-         has added it for UNIX style also */
-
-      /* Fix me - we should not be using the same routine for VMS and
-         UNIX format files.  Things are too tangled so we need to lookup
-         what syntax the output is */
-
-      is_unix = 0;
-      is_vms = 0;
-      lastdir = strrchr(trndir,'/');
-      if (lastdir) {
-          is_unix = 1;
-      } else {
-          lastdir = strpbrk(trndir,"]:>");
-          if (lastdir) {
-              is_vms = 1;
-          }
-      }
-
-      if ((is_vms == 0) && (is_unix == 0)) {
-          /* We still do not  know? */
-          is_unix = decc_filename_unix_report;
-          if (is_unix == 0)
-              is_vms = 1;
-      }
-
-      if ((is_unix && !decc_efs_charset) || is_vms) {
-
-           /* It is a bug to add a .dir to a UNIX format directory spec */
-           /* However Perl on VMS may have programs that expect this so */
-           /* If not using EFS character specifications allow it. */
-
-           if ((!decc_efs_case_preserve) && vms_process_case_tolerant) {
-               /* Traditionally Perl expects filenames in lower case */
-               strcat(buf, ".dir");
-           } else {
-               /* VMS expects the .DIR to be in upper case */
-               strcat(buf, ".DIR");
-           }
-
-           /* It is also a bug to put a VMS format version on a UNIX file */
-           /* specification.  Perl self tests are looking for this */
-           if (is_vms || !(decc_efs_charset || decc_filename_unix_report))
-               strcat(buf, ";1");
-      }
+      if ((!decc_efs_case_preserve) && vms_process_case_tolerant)
+          strcat(buf,".dir;1");
+      else
+          strcat(buf,".DIR;1");
       PerlMem_free(trndir);
       PerlMem_free(vmsdir);
       return buf;