ebcdic fix for Data::Dumper from Peter Prymmer

p4raw-id: //depot/perl@4745

diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index 608879c..1478672 100644 (file)
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -550,25 +550,31 @@ my %esc = (
 sub qquote {
   local($_) = shift;
   s/([\\\"\@\$])/\\$1/g;
-  return qq("$_") unless /[^\040-\176]/;  # fast exit
+  return qq("$_") unless 
+    /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/;  # fast exit
 
   my $high = shift || "";
   s/([\a\b\t\n\f\r\e])/$esc{$1}/g;
 
-  # no need for 3 digits in escape for these
-  s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
-
-  s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
-  if ($high eq "iso8859") {
-    s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
-  } elsif ($high eq "utf8") {
-#   use utf8;
-#   $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
-  } elsif ($high eq "8bit") {
-      # leave it as it is
-  } else {
-    s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+  if (ord('^')==94)  { # ascii
+    # no need for 3 digits in escape for these
+    s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg;
+    s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg;
+    if ($high eq "iso8859") {
+      s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg;
+    } elsif ($high eq "utf8") {
+#     use utf8;
+#     $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge;
+    } elsif ($high eq "8bit") {
+        # leave it as it is
+    } else {
+      s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg;
+    }
+  }
+  else { # ebcdic
+      s/([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])/'\\'.sprintf('%03o',ord($1))/eg;
   }
+
   return qq("$_");
 }
 

diff --git a/regcomp.c b/regcomp.c
index 3e7c012..90500a4 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -2570,11 +2570,19 @@ tryagain:
                        p++;
                        break;
                    case 'e':
-                       ender = '\033';
+#ifdef ASCIIish
+                         ender = '\033';
+#else
+                         ender = '\047';
+#endif
                        p++;
                        break;
                    case 'a':
-                       ender = '\007';
+#ifdef ASCIIish
+                         ender = '\007';
+#else
+                         ender = '\057';
+#endif
                        p++;
                        break;
                    case 'x':
@@ -2910,8 +2918,13 @@ S_regclass(pTHX)
            case 't':   value = '\t';                   break;
            case 'f':   value = '\f';                   break;
            case 'b':   value = '\b';                   break;
+#ifdef ASCIIish
            case 'e':   value = '\033';                 break;
            case 'a':   value = '\007';                 break;
+#else
+           case 'e':   value = '\047';                 break;
+           case 'a':   value = '\057';                 break;
+#endif
            case 'x':
                value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen);
                PL_regcomp_parse += numlen;
@@ -3372,8 +3385,13 @@ S_regclassutf8(pTHX)
            case 't':           value = '\t';           break;
            case 'f':           value = '\f';           break;
            case 'b':           value = '\b';           break;
+#ifdef ASCIIish
            case 'e':           value = '\033';         break;
            case 'a':           value = '\007';         break;
+#else
+           case 'e':           value = '\047';         break;
+           case 'a':           value = '\057';         break;
+#endif
            case 'x':
                if (*PL_regcomp_parse == '{') {
                    e = strchr(PL_regcomp_parse++, '}');