[blead-329-gdf27866] vms rmsexpand refactor

--- /rsync_root/perl/vms/vms.c	Tue Jan 13 07:14:08 2009
+++ vms/vms.c	Wed Jan 14 00:11:11 2009
@@ -296,6 +296,10 @@
 static char *mp_do_tounixspec(pTHX_ const char *, char *, int, int *);
 static char *mp_do_pathify_dirspec(pTHX_ const char *dir,char *buf, int ts, int *);
 
+static char *  int_rmsexpand_vms(
+    const char * filespec, char * outbuf, unsigned opts);
+static char * int_rmsexpand_tovms(
+    const char * filespec, char * outbuf, unsigned opts);
 static char *int_tovmsspec
    (const char *path, char *buf, int dir_flag, int * utf8_flag);
 static char * int_tounixspec(const char *spec, char *buf, int * utf8_fl);
@@ -1962,13 +1966,7 @@
     vmsname = PerlMem_malloc(NAM$C_MAXRSS+1);
     if (vmsname == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 
-    rslt = do_rmsexpand(name,
-			vmsname,
-			0,
-			NULL,
-			PERL_RMSEXPAND_M_VMS | PERL_RMSEXPAND_M_SYMLINK,
-			NULL,
-			NULL);
+    rslt = int_rmsexpand_tovms(name, vmsname, PERL_RMSEXPAND_M_SYMLINK);
     if (rslt == NULL) {
         PerlMem_free(vmsname);
 	return -1;
@@ -3809,8 +3807,7 @@
             file[NAM$C_MAXRSS] = '\0';
             p = p->next;
 
-            exp_res = do_rmsexpand
-		(file, vmspipe_file, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL);
+            exp_res = int_rmsexpand_tovms(file, vmspipe_file, 0);
             if (!exp_res) continue;
 
             if (cando_by_name_int
@@ -5062,13 +5059,9 @@
     if (vmsname == NULL)
 	return SS$_INSFMEM;
 
-    rslt = do_rmsexpand(vms_src_dsc->dsc$a_pointer,
+    rslt = int_rmsexpand_tovms(vms_src_dsc->dsc$a_pointer,
 			vmsname,
-			0,
-			NULL,
-			PERL_RMSEXPAND_M_VMS | PERL_RMSEXPAND_M_SYMLINK,
-			NULL,
-			NULL);
+			PERL_RMSEXPAND_M_SYMLINK);
     if (rslt == NULL) {
 	PerlMem_free(vmsname);
 	return SS$_INSFMEM;
@@ -5458,19 +5451,20 @@
 static char *mp_do_tounixspec(pTHX_ const char *, char *, int, int *);
 
 static char *
-mp_do_rmsexpand
-   (pTHX_ const char *filespec,
+int_rmsexpand
+   (const char *filespec,
     char *outbuf,
-    int ts,
     const char *defspec,
     unsigned opts,
     int * fs_utf8,
     int * dfs_utf8)
 {
-  static char __rmsexpand_retbuf[VMS_MAXRSS];
-  char * vmsfspec, *tmpfspec;
-  char * esa, *cp, *out = NULL;
-  char * tbuf;
+  char * ret_spec;
+  const char * in_spec;
+  char * spec_buf;
+  const char * def_spec;
+  char * vmsfspec, *vmsdefspec;
+  char * esa;
   char * esal = NULL;
   char * outbufl;
   struct FAB myfab = cc$rms_fab;
@@ -5487,63 +5481,74 @@
     set_vaxc_errno(LIB$_INVARG); set_errno(EINVAL);
     return NULL;
   }
-  if (!outbuf) {
-    if (ts) out = Newx(outbuf,VMS_MAXRSS,char);
-    else    outbuf = __rmsexpand_retbuf;
-  }
 
   vmsfspec = NULL;
-  tmpfspec = NULL;
+  vmsdefspec = NULL;
   outbufl = NULL;
 
+  in_spec = filespec;
   isunix = 0;
   if ((opts & PERL_RMSEXPAND_M_VMS_IN) == 0) {
-    isunix = is_unix_filespec(filespec);
-    if (isunix) {
-      vmsfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (vmsfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
-      if (int_tovmsspec(filespec, vmsfspec, 0, fs_utf8) == NULL) {
-	PerlMem_free(vmsfspec);
-	if (out)
-	   Safefree(out);
-	return NULL;
-      }
-      filespec = vmsfspec;
+      char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
+      int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
 
-      /* Unless we are forcing to VMS format, a UNIX input means
-       * UNIX output, and that requires long names to be used
-       */
+      /* If this is a UNIX file spec, convert it to VMS */
+      sts = vms_split_path(filespec, &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) {
+          isunix = 1;
+          char * ret_spec;
+
+          vmsfspec = PerlMem_malloc(VMS_MAXRSS);
+          if (vmsfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+          ret_spec = int_tovmsspec(filespec, vmsfspec, 0, fs_utf8);
+          if (ret_spec == NULL) {
+              PerlMem_free(vmsfspec);
+              return NULL;
+          }
+          in_spec = (const char *)vmsfspec;
+
+          /* Unless we are forcing to VMS format, a UNIX input means
+           * UNIX output, and that requires long names to be used
+           */
+          if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
-      if ((opts & PERL_RMSEXPAND_M_VMS) == 0)
-	opts |= PERL_RMSEXPAND_M_LONG;
-      else
+              opts |= PERL_RMSEXPAND_M_LONG;
 #endif
-	isunix = 0;
+          else
+              isunix = 0;
       }
-    }
 
-  rms_set_fna(myfab, mynam, (char *)filespec, strlen(filespec)); /* cast ok */
+  }
+
+  rms_set_fna(myfab, mynam, (char *)in_spec, strlen(in_spec)); /* cast ok */
   rms_bind_fab_nam(myfab, mynam);
 
+  /* Process the default file specification if present */
+  def_spec = defspec;
   if (defspec && *defspec) {
     int t_isunix;
     t_isunix = is_unix_filespec(defspec);
     if (t_isunix) {
-      tmpfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (tmpfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
-      if (int_tovmsspec(defspec, tmpfspec, 0, dfs_utf8) == NULL) {
-	PerlMem_free(tmpfspec);
-	if (vmsfspec != NULL)
-	    PerlMem_free(vmsfspec);
-	if (out)
-	   Safefree(out);
-	return NULL;
+      vmsdefspec = PerlMem_malloc(VMS_MAXRSS);
+      if (vmsdefspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
+      ret_spec = int_tovmsspec(defspec, vmsdefspec, 0, dfs_utf8);
+
+      if (ret_spec == NULL) {
+          /* Clean up and bail */
+          PerlMem_free(vmsdefspec);
+          if (vmsfspec != NULL)
+              PerlMem_free(vmsfspec);
+              return NULL;
+          }
+          def_spec = (const char *)vmsdefspec;
       }
-      defspec = tmpfspec;
-    }
-    rms_set_dna(myfab, mynam, (char *)defspec, strlen(defspec)); /* cast ok */
+      rms_set_dna(myfab, mynam,
+                  (char *)def_spec, strlen(def_spec)); /* cast ok */
   }
 
+  /* Now we need the expansion buffers */
   esa = PerlMem_malloc(NAM$C_MAXRSS + 1);
   if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
@@ -5578,17 +5583,19 @@
 
     /* Could not find the file, try as syntax only if error is not fatal */
     rms_set_nam_nop(mynam, NAM$M_SYNCHK);
-    if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV) {
+    if (retsts == RMS$_DNF ||
+        retsts == RMS$_DIR ||
+        retsts == RMS$_DEV ||
+        retsts == RMS$_PRV) {
       retsts = sys$parse(&myfab,0,0);
-      if (retsts & STS$K_SUCCESS) goto expanded;
+      if (retsts & STS$K_SUCCESS) goto int_expanded;
     }  
 
      /* Still could not parse the file specification */
     /*----------------------------------------------*/
     sts = rms_free_search_context(&myfab); /* Free search context */
-    if (out) Safefree(out);
-    if (tmpfspec != NULL)
-	PerlMem_free(tmpfspec);
+    if (vmsdefspec != NULL)
+	PerlMem_free(vmsdefspec);
     if (vmsfspec != NULL)
 	PerlMem_free(vmsfspec);
     if (outbufl != NULL)
@@ -5606,9 +5613,8 @@
   retsts = sys$search(&myfab,0,0);
   if (!(retsts & STS$K_SUCCESS) && retsts != RMS$_FNF) {
     sts = rms_free_search_context(&myfab); /* Free search context */
-    if (out) Safefree(out);
-    if (tmpfspec != NULL)
-	PerlMem_free(tmpfspec);
+    if (vmsdefspec != NULL)
+	PerlMem_free(vmsdefspec);
     if (vmsfspec != NULL)
 	PerlMem_free(vmsfspec);
     if (outbufl != NULL)
@@ -5624,35 +5630,37 @@
 
   /* If the input filespec contained any lowercase characters,
    * downcase the result for compatibility with Unix-minded code. */
-  expanded:
+int_expanded:
   if (!decc_efs_case_preserve) {
+    char * tbuf;
     for (tbuf = rms_get_fna(myfab, mynam); *tbuf; tbuf++)
       if (islower(*tbuf)) { haslower = 1; break; }
   }
 
    /* Is a long or a short name expected */
   /*------------------------------------*/
+  spec_buf = NULL;
   if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
     if (rms_nam_rsll(mynam)) {
-	tbuf = outbufl;
+	spec_buf = outbufl;
 	speclen = rms_nam_rsll(mynam);
     }
     else {
-	tbuf = esal; /* Not esa */
+	spec_buf = esal; /* Not esa */
 	speclen = rms_nam_esll(mynam);
     }
   }
   else {
     if (rms_nam_rsl(mynam)) {
-	tbuf = outbuf;
+	spec_buf = outbuf;
 	speclen = rms_nam_rsl(mynam);
     }
     else {
-	tbuf = esa; /* Not esal */
+	spec_buf = esa; /* Not esal */
 	speclen = rms_nam_esl(mynam);
     }
   }
-  tbuf[speclen] = '\0';
+  spec_buf[speclen] = '\0';
 
   /* Trim off null fields added by $PARSE
    * If type > 1 char, must have been specified in original or default spec
@@ -5673,11 +5681,11 @@
       char *defesa = NULL;
       defesa = PerlMem_malloc(VMS_MAXRSS + 1);
       if (defesa != NULL) {
+        struct FAB deffab = cc$rms_fab;
 #if !defined(__VAX) && defined(NAML$C_MAXRSS)
         defesal = PerlMem_malloc(VMS_MAXRSS + 1);
         if (defesal == NULL) _ckvmssts_noperl(SS$_INSFMEM);
 #endif
-	struct FAB deffab = cc$rms_fab;
 	rms_setup_nam(defnam);
      
 	rms_bind_fab_nam(deffab, defnam);
@@ -5710,34 +5718,36 @@
 	if (defesal != NULL)
 	    PerlMem_free(defesal);
 	PerlMem_free(defesa);
+      } else {
+          _ckvmssts_noperl(SS$_INSFMEM);
       }
     }
     if (trimver) {
       if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
 	if (*(rms_nam_verl(mynam)) != '\"')
-	  speclen = rms_nam_verl(mynam) - tbuf;
+	  speclen = rms_nam_verl(mynam) - spec_buf;
       }
       else {
 	if (*(rms_nam_ver(mynam)) != '\"')
-	  speclen = rms_nam_ver(mynam) - tbuf;
+	  speclen = rms_nam_ver(mynam) - spec_buf;
       }
     }
     if (trimtype) {
       /* If we didn't already trim version, copy down */
       if ((opts & PERL_RMSEXPAND_M_LONG) != 0) {
-	if (speclen > rms_nam_verl(mynam) - tbuf)
+	if (speclen > rms_nam_verl(mynam) - spec_buf)
 	  memmove
 	   (rms_nam_typel(mynam),
 	    rms_nam_verl(mynam),
-	    speclen - (rms_nam_verl(mynam) - tbuf));
+	    speclen - (rms_nam_verl(mynam) - spec_buf));
 	  speclen -= rms_nam_verl(mynam) - rms_nam_typel(mynam);
       }
       else {
-	if (speclen > rms_nam_ver(mynam) - tbuf)
+	if (speclen > rms_nam_ver(mynam) - spec_buf)
 	  memmove
 	   (rms_nam_type(mynam),
 	    rms_nam_ver(mynam),
-	    speclen - (rms_nam_ver(mynam) - tbuf));
+	    speclen - (rms_nam_ver(mynam) - spec_buf));
 	  speclen -= rms_nam_ver(mynam) - rms_nam_type(mynam);
       }
     }
@@ -5747,8 +5757,8 @@
   /*-------------------------------------------*/
   if (vmsfspec != NULL)
 	PerlMem_free(vmsfspec);
-  if (tmpfspec != NULL)
-	PerlMem_free(tmpfspec);
+  if (vmsdefspec != NULL)
+	PerlMem_free(vmsdefspec);
 
   /* If we just had a directory spec on input, $PARSE "helpfully"
    * adds an empty name and type for us */
@@ -5757,7 +5767,7 @@
     if (rms_nam_namel(mynam) == rms_nam_typel(mynam) &&
 	rms_nam_verl(mynam)  == rms_nam_typel(mynam) + 1 &&
 	!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
-      speclen = rms_nam_namel(mynam) - tbuf;
+      speclen = rms_nam_namel(mynam) - spec_buf;
   }
   else
 #endif
@@ -5765,20 +5775,20 @@
     if (rms_nam_name(mynam) == rms_nam_type(mynam) &&
 	rms_nam_ver(mynam)  == rms_nam_ver(mynam) + 1 &&
 	!(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME)))
-      speclen = rms_nam_name(mynam) - tbuf;
+      speclen = rms_nam_name(mynam) - spec_buf;
   }
 
   /* Posix format specifications must have matching quotes */
   if (speclen < (VMS_MAXRSS - 1)) {
-    if (decc_posix_compliant_pathnames && (tbuf[0] == '\"')) {
-      if ((speclen > 1) && (tbuf[speclen-1] != '\"')) {
-        tbuf[speclen] = '\"';
+    if (decc_posix_compliant_pathnames && (spec_buf[0] == '\"')) {
+      if ((speclen > 1) && (spec_buf[speclen-1] != '\"')) {
+        spec_buf[speclen] = '\"';
         speclen++;
       }
     }
   }
-  tbuf[speclen] = '\0';
-  if (haslower && !decc_efs_case_preserve) __mystrtolower(tbuf);
+  spec_buf[speclen] = '\0';
+  if (haslower && !decc_efs_case_preserve) __mystrtolower(spec_buf);
 
   /* Have we been working with an expanded, but not resultant, spec? */
   /* Also, convert back to Unix syntax if necessary. */
@@ -5794,44 +5804,118 @@
       rsl = rms_nam_rsl(mynam);
     }
     if (!rsl) {
+      /* rsl is not present, it means that spec_buf is either */
+      /* esa or esal, and needs to be copied to outbuf */
+      /* convert to Unix if desired */
       if (isunix) {
-        if (int_tounixspec(tbuf, outbuf, fs_utf8) == NULL) {
-	  if (out) Safefree(out);
-	  if (esal != NULL)
-	    PerlMem_free(esal);
-	  PerlMem_free(esa);
-	  if (outbufl != NULL)
-	    PerlMem_free(outbufl);
-	  return NULL;
-        }
+        ret_spec = int_tounixspec(spec_buf, outbuf, fs_utf8);
+      } else {
+        /* VMS file specs are not in UTF-8 */
+        if (fs_utf8 != NULL)
+            *fs_utf8 = 0;
+        strcpy(outbuf, spec_buf);
+        ret_spec = outbuf;
       }
-      else strcpy(outbuf, tbuf);
-    }
-    else if (isunix) {
-      tmpfspec = PerlMem_malloc(VMS_MAXRSS);
-      if (tmpfspec == NULL) _ckvmssts_noperl(SS$_INSFMEM);
-      if (int_tounixspec(tbuf, tmpfspec, fs_utf8) == NULL) {
-	if (out) Safefree(out);
-	PerlMem_free(esa);
-	if (esal != NULL)
-	    PerlMem_free(esal);
-	PerlMem_free(tmpfspec);
-	if (outbufl != NULL)
-	    PerlMem_free(outbufl);
-	return NULL;
+    }
+    else {
+      /* Now spec_buf is either outbuf or outbufl */
+      /* We need the result into outbuf */
+      if (isunix) {
+           /* If we need this in UNIX, then we need another buffer */
+           /* to keep things in order */
+           char * src;
+           char * new_src = NULL;
+           if (spec_buf == outbuf) {
+               new_src = PerlMem_malloc(VMS_MAXRSS);
+               strcpy(new_src, spec_buf);
+           } else {
+               src = spec_buf;
+           }
+           ret_spec = int_tounixspec(src, outbuf, fs_utf8);
+           if (new_src) {
+               PerlMem_free(new_src);
+           }
+      } else {
+           /* VMS file specs are not in UTF-8 */
+           if (fs_utf8 != NULL)
+               *fs_utf8 = 0;
+
+           /* Copy the buffer if needed */
+           if (outbuf != spec_buf)
+               strcpy(outbuf, spec_buf);
+           ret_spec = outbuf;
       }
-      strcpy(outbuf,tmpfspec);
-      PerlMem_free(tmpfspec);
     }
   }
+
+  /* Need to clean up the search context */
   rms_set_rsal(mynam, NULL, 0, NULL, 0);
   sts = rms_free_search_context(&myfab); /* Free search context */
-  PerlMem_free(esa);
+
+  /* Clean up the extra buffers */
   if (esal != NULL)
-     PerlMem_free(esal);
+      PerlMem_free(esal);
+  PerlMem_free(esa);
   if (outbufl != NULL)
      PerlMem_free(outbufl);
-  return outbuf;
+
+  /* Return the result */
+  return ret_spec;
+}
+
+/* Common simple case - Expand an already VMS spec */
+static char * 
+int_rmsexpand_vms(const char * filespec, char * outbuf, unsigned opts) {
+    opts |= PERL_RMSEXPAND_M_VMS_IN;
+    return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); 
+}
+
+/* Common simple case - Expand to a VMS spec */
+static char * 
+int_rmsexpand_tovms(const char * filespec, char * outbuf, unsigned opts) {
+    opts |= PERL_RMSEXPAND_M_VMS;
+    return int_rmsexpand(filespec, outbuf, NULL, opts, NULL, NULL); 
+}
+
+
+/* Entry point used by perl routines */
+static char *
+mp_do_rmsexpand
+   (pTHX_ const char *filespec,
+    char *outbuf,
+    int ts,
+    const char *defspec,
+    unsigned opts,
+    int * fs_utf8,
+    int * dfs_utf8)
+{
+    static char __rmsexpand_retbuf[VMS_MAXRSS];
+    char * expanded, *ret_spec, *ret_buf;
+
+    expanded = NULL;
+    ret_buf = outbuf;
+    if (ret_buf == NULL) {
+        if (ts) {
+            Newx(expanded, VMS_MAXRSS, char);
+            if (expanded == NULL)
+                _ckvmssts(SS$_INSFMEM);
+            ret_buf = expanded;
+        } else {
+            ret_buf = __rmsexpand_retbuf;
+        }
+    }
+
+
+    ret_spec = int_rmsexpand(filespec, ret_buf, defspec,
+                             opts, fs_utf8,  dfs_utf8);
+
+    if (ret_spec == NULL) {
+       /* Cleanup on isle 5, if this is thread specific we need to deallocate */
+       if (expanded)
+           Safefree(expanded);
+    }
+
+    return ret_spec;
 }
 /*}}}*/
 /* External entry points */
@@ -10489,8 +10573,8 @@
 
 	       /* Try to find the exact program requested to be run */
 	      /*---------------------------------------------------*/
-	      iname = do_rmsexpand
-		 (tmpspec, image_name, 0, ".exe",
+	      iname = int_rmsexpand
+		 (tmpspec, image_name, ".exe",
 		  PERL_RMSEXPAND_M_VMS, NULL, NULL);
 	      if (iname != NULL) {
 		if (cando_by_name_int
@@ -10501,8 +10585,8 @@
 		else {
 		   /* Try again with a null type */
 		  /*----------------------------*/
-		  iname = do_rmsexpand
-		    (tmpspec, image_name, 0, ".",
+		  iname = int_rmsexpand
+		    (tmpspec, image_name, ".",
 		     PERL_RMSEXPAND_M_VMS, NULL, NULL);
 		  if (iname != NULL) {
 		    if (cando_by_name_int
@@ -11871,7 +11955,7 @@
   }
 
   /* Convert to VMS format ensuring that it will fit in 255 characters */
-  if (do_rmsexpand(file, vmsspec, 0, NULL, PERL_RMSEXPAND_M_VMS, NULL, NULL) == NULL) {
+  if (int_rmsexpand_tovms(file, vmsspec, 0) == NULL) {
       SETERRNO(ENOENT, LIB$_INVARG);
       return -1;
   }
@@ -12323,14 +12407,10 @@
     }
     else {
 	/* Make sure that the saved name fits in 255 characters */
-	cptr = do_rmsexpand
+	cptr = int_rmsexpand_vms
 		       (vms_filename,
 			statbufp->st_devnam, 
-			0,
-			NULL,
-			PERL_RMSEXPAND_M_VMS | PERL_RMSEXPAND_M_VMS_IN,
-			NULL,
-			NULL);
+			0);
 	if (cptr == NULL)
 	    statbufp->st_devnam[0] = 0;
     }
@@ -12487,8 +12567,7 @@
       if (lstat_flag)
 	rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK;
 
-      cptr = do_rmsexpand
-       (save_spec, statbufp->st_devnam, 0, NULL, rmsex_flags, NULL, NULL);
+      cptr = int_rmsexpand_tovms(save_spec, statbufp->st_devnam, rmsex_flags);
       if (cptr == NULL)
 	statbufp->st_devnam[0] = 0;
 
@@ -13724,8 +13803,8 @@
 	    if (!decc_efs_charset) {
 
 		/* 1. ODS-2 mode wants to do a syntax only translation */
-		rslt = do_rmsexpand(filespec, outbuf,
-				    0, NULL, 0, NULL, utf8_fl);
+		rslt = int_rmsexpand(filespec, outbuf,
+				    NULL, 0, NULL, utf8_fl);
 
 	    } else {
 		if (decc_filename_unix_report) {