[patch@31649] vms.c realpath prototype mismatch

[p5sagit/p5-mst-13.2.git] / vms / vms.c

diff --git a/vms/vms.c b/vms/vms.c
index aaaa869..27214f7 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -419,7 +419,7 @@ int utf8_flag;
            }
        }
 
-       /* High bit set, but not a unicode character! */
+       /* High bit set, but not a Unicode character! */
 
        /* Non printing DECMCS or ISO Latin-1 character? */
        if (*inspec <= 0x9F) {
@@ -521,6 +521,16 @@ int utf8_flag;
     case ']':
     case '%':
     case '^':
+        /* Don't escape again if following character is 
+         * already something we escape.
+         */
+        if (strchr(".~!#&\'`()+@{},;[]%^=_", *(inspec+1))) {
+           *outspec = *inspec;
+           *output_cnt = 1;
+           return 1;
+           break;
+        }
+        /* But otherwise fall through and escape it. */
     case '=':
        /* Assume that this is to be escaped */
        outspec[0] = '^';
@@ -564,17 +574,26 @@ int scnt;
     if (*inspec == '^') {
        inspec++;
        switch (*inspec) {
+        /* Spaces and non-trailing dots should just be passed through, 
+         * but eat the escape character.
+         */
        case '.':
-           /* Non trailing dots should just be passed through, but eat the escape */
            *outspec = *inspec;
-           count++;
+           count += 2;
+           (*output_cnt)++;
            break;
        case '_': /* space */
            *outspec = ' ';
-           inspec++;
-           count++;
+           count += 2;
            (*output_cnt)++;
            break;
+       case '^':
+            /* Hmm.  Better leave the escape escaped. */
+            outspec[0] = '^';
+            outspec[1] = '^';
+           count += 2;
+           (*output_cnt) += 2;
+           break;
        case 'U': /* Unicode - FIX-ME this is wrong. */
            inspec++;
            count++;
@@ -6091,7 +6110,7 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
     }
     if ((*cp2 == '^')) {
        /* EFS file escape, pass the next character as is */
-       /* Fix me: HEX encoding for UNICODE not implemented */
+       /* Fix me: HEX encoding for Unicode not implemented */
        cp2++;
     }
     else if ( *cp2 == '.') {
@@ -6106,7 +6125,7 @@ static char *mp_do_tounixspec(pTHX_ const char *spec, char *buf, int ts, int * u
   for (; cp2 <= dirend; cp2++) {
     if ((*cp2 == '^')) {
        /* EFS file escape, pass the next character as is */
-       /* Fix me: HEX encoding for UNICODE not implemented */
+       /* Fix me: HEX encoding for Unicode not implemented */
        *(cp1++) = *(++cp2);
         /* An escaped dot stays as is -- don't convert to slash */
         if (*cp2 == '.') cp2++;
@@ -7559,6 +7578,14 @@ static char *mp_do_tovmsspec
     case '#':
     case '%':
     case '^':
+        /* Don't escape again if following character is 
+         * already something we escape.
+         */
+        if (strchr("\"~`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) {
+           *(cp1++) = *(cp2++);
+           break;
+        }
+        /* But otherwise fall through and escape it. */
     case '&':
     case '(':
     case ')':
@@ -8994,7 +9021,7 @@ Perl_readdir(pTHX_ DIR *dd)
     if (dd->flags & PERL_VMSDIR_M_UNIXSPECS) {
 
        /* Translate the encoded characters. */
-       /* Fixme: unicode handling could result in embedded 0 characters */
+       /* Fixme: Unicode handling could result in embedded 0 characters */
        if (strchr(dd->entry.d_name, '^') != NULL) {
            char new_name[256];
            char * q;
@@ -9008,7 +9035,7 @@ Perl_readdir(pTHX_ DIR *dd)
                /* fix-me */
                /* if outchars_added > 1, then this is a wide file specification */
                /* Wide file specifications need to be passed in Perl */
-               /* counted strings apparently with a unicode flag */
+               /* counted strings apparently with a Unicode flag */
            }
            *q = 0;
            strcpy(dd->entry.d_name, new_name);
@@ -12133,7 +12160,8 @@ Perl_vms_start_glob
 
 #ifdef HAS_SYMLINK
 static char *
-mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec, const int *utf8_fl);
+mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec,
+                  const int *utf8_fl);
 
 void
 vms_realpath_fromperl(pTHX_ CV *cv)
@@ -12246,7 +12274,8 @@ char *realpath(const char *file_name, char * resolved_name, ...);
  * on OpenVMS.
  */
 static char *
-mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
+mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
+                  const int *utf8_fl)
 {
     return realpath(filespec, outbuf);
 }
@@ -12381,7 +12410,7 @@ static int set_features
         vms_debug_on_exception = 0;
     }
 
-    /* Create VTF-7 filenames from UNICODE instead of UTF-8 */
+    /* Create VTF-7 filenames from Unicode instead of UTF-8 */
     vms_vtf7_filenames = 0;
     status = sys_trnlnm("PERL_VMS_VTF7_FILENAMES", val_str, sizeof(val_str));
     if ($VMS_STATUS_SUCCESS(status)) {