vms rename Unix mode fixes

Here are the fixes for the rename() wrapper to support Unix mode better.

Removed calls to pathify/vmsify that were redundant because of
flex_lstat() calls.

Support option to unlink all versions on rename.

Message-id: <498701F5.5040906@gmail.com>

diff --git a/vms/vms.c b/vms/vms.c
index 8f081ab..ced08d9 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -5261,14 +5261,19 @@ Stat_t src_st;
 Stat_t dst_st;
 
     /* Validate the source file */
-    src_sts = flex_lstat(src, &src_st);
+    src_sts = Perl_flex_lstat(NULL, src, &src_st);
     if (src_sts != 0) {
 
        /* No source file or other problem */
        return src_sts;
     }
+    if (src_st.st_devnam[0] == 0)  {
+        /* This may be possible so fail if it is seen. */
+        errno = EIO;
+        return -1;
+    }
 
-    dst_sts = flex_lstat(dst, &dst_st);
+    dst_sts = Perl_flex_lstat(NULL, dst, &dst_st);
     if (dst_sts == 0) {
 
        if (dst_st.st_dev != src_st.st_dev) {
@@ -5312,7 +5317,28 @@ Stat_t dst_st;
 
        if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) {
            int d_sts;
-           d_sts = mp_do_kill_file(aTHX_ dst, S_ISDIR(dst_st.st_mode));
+           d_sts = mp_do_kill_file(NULL, dst_st.st_devnam,
+                                    S_ISDIR(dst_st.st_mode));
+
+           /* Need to delete all versions ? */
+           if ((d_sts == 0) && (vms_unlink_all_versions == 1)) {
+                int i = 0;
+
+                while (lstat(dst_st.st_devnam, &dst_st.crtl_stat) == 0) {
+                    d_sts = mp_do_kill_file(NULL, dst_st.st_devnam, 0);
+                    if (d_sts != 0)
+                        break;
+                    i++;
+
+                    /* Make sure that we do not loop forever */
+                    if (i > 32767) {
+                        errno = EIO;
+                        d_sts = -1;
+                        break;
+                    }
+                }
+           }
+
            if (d_sts != 0)
                return d_sts;
 
@@ -5333,7 +5359,6 @@ Stat_t dst_st;
        /* if the source is a directory, then need to fileify */
        /*  and dest must be a directory or non-existant. */
 
-       char * vms_src;
        char * vms_dst;
        int sts;
        char * ret_str;
@@ -5345,18 +5370,6 @@ Stat_t dst_st;
         * on if one or more of them are directories.
         */
 
-       vms_src = PerlMem_malloc(VMS_MAXRSS);
-       if (vms_src == NULL)
-           _ckvmssts_noperl(SS$_INSFMEM);
-
-       /* Source is always a VMS format file */
-       ret_str = do_tovmsspec(src, vms_src, 0, NULL);
-       if (ret_str == NULL) {
-           PerlMem_free(vms_src);
-           errno = EIO;
-           return -1;
-       }
-
        vms_dst = PerlMem_malloc(VMS_MAXRSS);
        if (vms_dst == NULL)
            _ckvmssts_noperl(SS$_INSFMEM);
@@ -5369,24 +5382,11 @@ Stat_t dst_st;
            if (vms_dir_file == NULL)
                _ckvmssts_noperl(SS$_INSFMEM);
 
-           /* The source must be a file specification */
-           ret_str = int_fileify_dirspec(vms_src, vms_dir_file, NULL);
-           if (ret_str == NULL) {
-               PerlMem_free(vms_src);
-               PerlMem_free(vms_dst);
-               PerlMem_free(vms_dir_file);
-               errno = EIO;
-               return -1;
-           }
-           PerlMem_free(vms_src);
-           vms_src = vms_dir_file;
-
            /* If the dest is a directory, we must remove it
            if (dst_sts == 0) {
                int d_sts;
-               d_sts = mp_do_kill_file(aTHX_ dst, 1);
+               d_sts = mp_do_kill_file(NULL dst_st.st_devnam, 1);
                if (d_sts != 0) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return sts;
@@ -5398,7 +5398,6 @@ Stat_t dst_st;
           /* The dest must be a VMS file specification */
           ret_str = int_tovmsspec(dst, vms_dst, 0, NULL);
           if (ret_str == NULL) {
-               PerlMem_free(vms_src);
                PerlMem_free(vms_dst);
                errno = EIO;
                return -1;
@@ -5411,7 +5410,6 @@ Stat_t dst_st;
 
            ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
            if (ret_str == NULL) {
-               PerlMem_free(vms_src);
                PerlMem_free(vms_dst);
                PerlMem_free(vms_dir_file);
                errno = EIO;
@@ -5427,26 +5425,42 @@ Stat_t dst_st;
                /* VMS pathify a dir target */
                ret_str = int_tovmspath(dst, vms_dst, NULL);
                if (ret_str == NULL) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return -1;
                }
            } else {
+                char * v_spec, * r_spec, * d_spec, * n_spec;
+                char * e_spec, * vs_spec;
+                int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
 
                /* fileify a target VMS file specification */
                ret_str = int_tovmsspec(dst, vms_dst, 0, NULL);
                if (ret_str == NULL) {
-                   PerlMem_free(vms_src);
                    PerlMem_free(vms_dst);
                    errno = EIO;
                    return -1;
                }
+
+               sts = vms_split_path(vms_dst, &v_spec, &v_len, &r_spec, &r_len,
+                             &d_spec, &d_len, &n_spec, &n_len, &e_spec,
+                             &e_len, &vs_spec, &vs_len);
+               if (sts == 0) {
+                    if (e_len == 0) {
+                        /* Get rid of the version */
+                        if (vs_len != 0) {
+                            *vs_spec = '\0';
+                        }
+                        /* Need to specify a '.' so that the extension */
+                        /* is not inherited */
+                        strcat(vms_dst,".");
+                    }
+               }
            }
        }
 
-       old_file_dsc.dsc$a_pointer = vms_src;
-       old_file_dsc.dsc$w_length = strlen(vms_src);
+       old_file_dsc.dsc$a_pointer = src_st.st_devnam;
+       old_file_dsc.dsc$w_length = strlen(src_st.st_devnam);
        old_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
        old_file_dsc.dsc$b_class = DSC$K_CLASS_S;
 
@@ -5474,7 +5488,6 @@ Stat_t dst_st;
           sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags);
        }
 
-       PerlMem_free(vms_src);
        PerlMem_free(vms_dst);
        if (!$VMS_STATUS_SUCCESS(sts)) {
            errno = EIO;
@@ -5487,10 +5500,25 @@ Stat_t dst_st;
        /* Now get rid of any previous versions of the source file that
         * might still exist
         */
-       int save_errno;
-       save_errno = errno;
-       src_sts = mp_do_kill_file(aTHX_ src, S_ISDIR(src_st.st_mode));
-       errno = save_errno;
+       int i = 0;
+       dSAVEDERRNO;
+       SAVE_ERRNO;
+       src_sts = mp_do_kill_file(NULL, src_st.st_devnam,
+                                  S_ISDIR(src_st.st_mode));
+       while (lstat(src_st.st_devnam, &src_st.crtl_stat) == 0) {
+            src_sts = mp_do_kill_file(NULL, src_st.st_devnam,
+                                      S_ISDIR(src_st.st_mode));
+            if (src_sts != 0)
+                break;
+            i++;
+
+            /* Make sure that we do not loop forever */
+            if (i > 32767) {
+                src_sts = -1;
+                break;
+            }
+       }
+       RESTORE_ERRNO;
     }
 
     /* We deleted the destination, so must force the error to be EIO */