fgetname() does not always return the correct Unix format file
specification when the decc$filename_unix_report feature is active and
is ignoring the decc$readdir_dropdot_notype setting.
So always have fgetname() return a VMS format file specification. When
decc$filename_unix_report is active, use unixify() to convert it to the
expected syntax.
This bug shows up doing rename tests on an open file that has no file
extension with decc$filename_unix_report and decc$readdir_dropdot_notype
both active.
This appears to be the last patch needed for vms.c/vmsish.h for this
round of Unix compatibility and Extended character set filename support.
-John
wb8...@gmail.com
Personal Opinion Only
--- /ref1_root/perl/vms/vms.c Sun Feb 8 21:53:44 2009
+++ vms/vms.c Sun Feb 8 21:53:50 2009
@@ -9397,7 +9397,7 @@
/* Input from a pipe, reopen it in binary mode to disable */
/* carriage control processing. */
- fgetname(stdin, mbxname);
+ fgetname(stdin, mbxname, 1);
mbxnam.dsc$a_pointer = mbxname;
mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);
lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
@@ -11325,6 +11325,34 @@
if (res == 0 && vaxc$errno == RMS$_EOF) clearerr(fp);
return res;
+}
+/*}}}*/
+
+/* fgetname() is not returning the correct file specifications when
+ * decc_filename_unix_report mode is active. So we have to have it
+ * aways return filenames in VMS mode and convert it ourselves.
+ */
+
+/*{{{ char * my_fgetname(FILE *fp, buf)*/
+char *
+Perl_my_fgetname(FILE *fp, char * buf) {
+ char * retname;
+ char * vms_name;
+
+ retname = fgetname(fp, buf, 1);
+
+ /* If we are in VMS mode, then we are done */
+ if (!decc_filename_unix_report || (retname == NULL)) {
+ return retname;
+ }
+
+ /* Convert this to Unix format */
+ vms_name = PerlMem_malloc(VMS_MAXRSS + 1);
+ strcpy(vms_name, retname);
+ retname = int_tounixspec(vms_name, buf, NULL);
+ PerlMem_free(vms_name);
+
+ return retname;
}
/*}}}*/
--- /rsync_root/perl/vms/vmsish.h Sun Feb 1 15:19:12 2009
+++ vms/vmsish.h Sun Feb 8 21:52:55 2009
@@ -133,6 +133,7 @@
#define vms_image_init Perl_vms_image_init
#define my_tmpfile Perl_my_tmpfile
#define vmstrnenv Perl_vmstrnenv
+#define my_fgetname(a, b) Perl_my_fgetname(a, b)
#if !defined(PERL_IMPLICIT_CONTEXT)
#define my_getenv_len Perl_my_getenv_len
#define vmssetenv Perl_vmssetenv
@@ -520,6 +521,7 @@
# define fwrite my_fwrite /* for PerlSIO_fwrite */
# define fdopen my_fdopen
# define fclose my_fclose
+# define fgetname(a, b) my_fgetname(a, b)
#ifdef HAS_SYMLINK
# define symlink my_symlink
#endif
@@ -973,6 +975,7 @@
FILE * my_fdopen (int, const char *);
int my_fclose (FILE *);
int my_fwrite (const void *, size_t, size_t, FILE *);
+char * Perl_my_fgetname (FILE *fp, char *buf);
#ifdef HAS_SYMLINK
int Perl_my_symlink(pTHX_ const char *path1, const char *path2);
#endif
