This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perlebcdic: Clean-up
authorKarl Williamson <khw@cpan.org>
Sat, 31 May 2014 23:11:10 +0000 (17:11 -0600)
committerKarl Williamson <khw@cpan.org>
Sun, 1 Jun 2014 01:09:22 +0000 (19:09 -0600)
There are much simpler ways to do some things than were given.  This
also makes some clarifications, and removes obsolete text, shortens some
too long verbatim lines.

pod/perlebcdic.pod
t/porting/known_pod_issues.dat

index 28f5981..c7efd98 100644 (file)
@@ -125,7 +125,7 @@ This causes a problem with the semantics of the pack/unpack "U", which
 are supposed to pack Unicode code points to characters and back to numbers.
 The problem is: which code points to use for code points less than 256?
 (for 256 and over there's no problem: Unicode code points are used)
-In EBCDIC, for the low 256 the EBCDIC code points are used.  This
+In EBCDIC, the EBCDIC code points are used for the low 256.  This
 means that the equivalences
 
     pack("U", ord($character)) eq $character
@@ -142,12 +142,8 @@ equal I<A with acute> or chr(101), and unpack("U", "A") would equal
 
 =item *
 
-Many of the remaining problems seem to be related to case-insensitive matching
-
-=item *
-
 The extensions Unicode::Collate and Unicode::Normalized are not
-supported under EBCDIC, likewise for the encoding pragma.
+supported under EBCDIC, likewise for the (now deprecated) encoding pragma.
 
 =back
 
@@ -269,7 +265,8 @@ might want to write:
 
  open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
  while (<FH>) {
-     if (/(.{29})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/)
+     if (/(.{29})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)
+                                                     \s+(\d+)\.?(\d*)/x)
      {
          if ($7 ne '' && $9 ne '') {
              printf(
@@ -310,7 +307,8 @@ Or, in order to retain the UTF-x code points in hexadecimal:
 
  open(FH,"<perlebcdic.pod") or die "Could not open perlebcdic.pod: $!";
  while (<FH>) {
-     if (/(.{29})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)\s+(\d+)\.?(\d*)/)
+     if (/(.{29})(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\.?(\d*)
+                                                     \s+(\d+)\.?(\d*)/x)
      {
          if ($7 ne '' && $9 ne '') {
              printf(
@@ -330,8 +328,8 @@ Or, in order to retain the UTF-x code points in hexadecimal:
 
 
                           ISO
-                         8859-1             POS-
-                         CCSID  CCSID CCSID IX-
+                         8859-1             POS-         CCSID
+                         CCSID  CCSID CCSID IX-          1047
   chr                     0819   0037 1047  BC  UTF-8  UTF-EBCDIC
  ---------------------------------------------------------------------
  <NUL>                       0    0    0    0    0        0
@@ -973,17 +971,23 @@ work on any platform as follows:
 
     sub Is_c0 {
         my $char = substr(shift,0,1);
-        return $char =~ /[[:cntrl:]]/
-               && $char =~ /[[:ascii:]]/
-               && ! Is_delete($char);
+        return $char =~ /[[:cntrl:]]/a && ! Is_delete($char);
+
+        # Alternatively:
+        # return $char =~ /[[:cntrl:]]/
+        #        && $char =~ /[[:ascii:]]/
+        #        && ! Is_delete($char);
     }
 
     sub Is_print_ascii {
         my $char = substr(shift,0,1);
 
-        return $char =~ /[[:print:]]/ && $char =~ /[[:ascii:]]/;
+        return $char =~ /[[:print:]]/a;
 
         # Alternatively:
+        # return $char =~ /[[:print:]]/ && $char =~ /[[:ascii:]]/;
+
+        # Or
         # return $char
         #      =~ /[ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/;
     }
@@ -1012,7 +1016,8 @@ to use the characters in the range explicitly:
 
     sub Is_latin_1 {
         my $char = substr(shift,0,1);
-        $char =~ /[ ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ]/;
+        $char =~ /[ ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏ]
+                  [ÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ]/x;
     }
 
 Although that form may run into trouble in network transit (due to the
@@ -1112,65 +1117,24 @@ may also be expressed as either of:
     http://www.pvhp.com/%7epvhp/
 
 where 7E is the hexadecimal ASCII code point for '~'.  Here is an example
-of decoding such a URL under CCSID 1047:
+of decoding such a URL in any EBCDIC code page:
 
     $url = 'http://www.pvhp.com/%7Epvhp/';
-    # this array assumes code page 1047
-    my @a2e_1047 = (
-          0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
-         16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
-         64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
-        240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
-        124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
-        215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
-        121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
-        151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
-         32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
-         48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
-         65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
-        144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
-        100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
-        172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
-         68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
-        140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
-    );
-    $url =~ s/%([0-9a-fA-F]{2})/pack("c",$a2e_1047[hex($1)])/ge;
+    $url =~ s/%([0-9a-fA-F]{2})/
+              pack("c",utf8::unicode_to_native(hex($1)))/xge;
 
 Conversely, here is a partial solution for the task of encoding such
-a URL under the 1047 code page:
+a URL in any EBCDIC code page:
 
     $url = 'http://www.pvhp.com/~pvhp/';
-    # this array assumes code page 1047
-    my @e2a_1047 = (
-          0,  1,  2,  3,156,  9,134,127,151,141,142, 11, 12, 13, 14, 15,
-         16, 17, 18, 19,157, 10,  8,135, 24, 25,146,143, 28, 29, 30, 31,
-        128,129,130,131,132,133, 23, 27,136,137,138,139,140,  5,  6,  7,
-        144,145, 22,147,148,149,150,  4,152,153,154,155, 20, 21,158, 26,
-         32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
-         38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
-         45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
-        248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
-        216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
-        176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
-        181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
-        172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
-        123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
-        125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
-         92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
-         48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
-    );
     # The following regular expression does not address the
     # mappings for: ('.' => '%2E', '/' => '%2F', ':' => '%3A')
     $url =~ s/([\t "#%&\(\),;<=>\?\@\[\\\]^`{|}~])/
-                sprintf("%%%02X",$e2a_1047[ord($1)])/xge;
+               sprintf("%%%02X",utf8::native_to_unicode(ord($1)))/xge;
 
 where a more complete solution would split the URL into components
 and apply a full s/// substitution only to the appropriate parts.
 
-In the remaining examples a @e2a or @a2e array may be employed
-but the assignment will not be shown explicitly.  For code page 1047
-you could use the @a2e_1047 or @e2a_1047 arrays just shown.
-
 =head2 uu encoding and decoding
 
 The C<u> template to pack() or unpack() will render EBCDIC data in EBCDIC
@@ -1196,19 +1160,17 @@ following will print "Yes indeed\n" on either an ASCII or EBCDIC computer:
         print "indeed\n";
     }
 
-Here is a very spartan uudecoder that will work on EBCDIC provided
-that the @e2a array is filled in appropriately:
+Here is a very spartan uudecoder that will work on EBCDIC:
 
     #!/usr/local/bin/perl
-    @e2a = ( # this must be filled in
-           );
     $_ = <> until ($mode,$file) = /^begin\s*(\d*)\s*(\S*)/;
     open(OUT, "> $file") if $file ne "";
     while(<>) {
         last if /^end/;
         next if /[a-z]/;
-        next unless int(((($e2a[ord()] - 32 ) & 077) + 2) / 3) ==
-            int(length() / 4);
+        next unless int((((utf8::native_to_unicode(ord()) - 32 ) & 077)
+                                                               + 2) / 3)
+                    == int(length() / 4);
         print OUT unpack("u", $_);
     }
     close(OUT);
@@ -1224,36 +1186,28 @@ the printable set using:
     $qp_string =~ s/([=\x00-\x1F\x80-\xFF])/sprintf("=%02X",ord($1))/ge;
 
 Whereas a QP encoder that works on both ASCII and EBCDIC platforms
-would look somewhat like the following (where the EBCDIC branch @e2a
-array is omitted for brevity):
+would look somewhat like the following:
 
-    if (ord('A') == 65) {    # ASCII
-        $delete = "\x7F";    # ASCII
-        @e2a = (0 .. 255)    # ASCII to ASCII identity map
-    }
-    else {                   # EBCDIC
-        $delete = "\x07";    # EBCDIC
-        @e2a =               # EBCDIC to ASCII map (as shown above)
-    }
+    $delete = utf8::unicode_to_native(ord("\x7F"));
     $qp_string =~
-      s/([^ !"\#\$%&'()*+,\-.\/0-9:;<>?\@A-Z[\\\]^_`a-z{|}~$delete])/
-         sprintf("=%02X",$e2a[ord($1)])/xge;
+      s/([^[:print:]$delete])/
+         sprintf("=%02X",utf8::native_to_unicode(ord($1)))/xage;
 
 (although in production code the substitutions might be done
-in the EBCDIC branch with the @e2a array and separately in the
+in the EBCDIC branch with the function call and separately in the
 ASCII branch without the expense of the identity map).
 
 Such QP strings can be decoded with:
 
     # This QP decoder is limited to ASCII only
-    $string =~ s/=([0-9A-Fa-f][0-9A-Fa-f])/chr hex $1/ge;
+    $string =~ s/=([[:xdigit:][[:xdigit:])/chr hex $1/ge;
     $string =~ s/=[\n\r]+$//;
 
 Whereas a QP decoder that works on both ASCII and EBCDIC platforms
-would look somewhat like the following (where the @a2e array is
-omitted for brevity):
+would look somewhat like the following:
 
-    $string =~ s/=([0-9A-Fa-f][0-9A-Fa-f])/chr $a2e[hex $1]/ge;
+    $string =~ s/=([[:xdigit:][:xdigit:]])/
+                                chr utf8::native_to_unicode(hex $1)/xge;
     $string =~ s/=[\n\r]+$//;
 
 =head2 Caesarean ciphers
index 4f3d2c0..b53fc85 100644 (file)
@@ -247,7 +247,6 @@ pod/perldebtut.pod  Verbatim line length including indents exceeds 79 by    22
 pod/perldebug.pod      Verbatim line length including indents exceeds 79 by    3
 pod/perldsc.pod        Verbatim line length including indents exceeds 79 by    4
 pod/perldtrace.pod     Verbatim line length including indents exceeds 79 by    26
-pod/perlebcdic.pod     Verbatim line length including indents exceeds 79 by    3
 pod/perlfunc.pod       ? Should you be using F<...> or maybe L<...> instead of 1
 pod/perlgit.pod        Verbatim line length including indents exceeds 79 by    12
 pod/perlgpl.pod        Verbatim line length including indents exceeds 79 by    50