Assimilate Pod-Escapes-1.04. This is a prereq for Pod::Simple,
Steve Peters [Tue, 29 Nov 2005 12:36:46 +0000 (12:36 +0000)]
which is now a prereq for podlators.

p4raw-id: //depot/perl@26224

MANIFEST
Porting/Maintainers.pl
lib/Pod/Escapes.pm [new file with mode: 0644]
lib/Pod/Escapes/ChangeLog [new file with mode: 0644]
lib/Pod/Escapes/README [new file with mode: 0644]
lib/Pod/Escapes/t/01_about_verbose.t [new file with mode: 0644]
lib/Pod/Escapes/t/10_main.t [new file with mode: 0644]
lib/Pod/Escapes/t/15_name2charnum.t [new file with mode: 0644]

index 4612cda..d403629 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1865,6 +1865,12 @@ lib/PerlIO/via/QuotedPrint.pm    PerlIO::via::QuotedPrint
 lib/PerlIO/via/t/QuotedPrint.t PerlIO::via::QuotedPrint
 lib/ph.t                       See if h2ph works
 lib/Pod/Checker.pm             Pod-Parser - check POD documents for syntax errors
+lib/Pod/Escapes/ChangeLog      ChangeLog for Pod::Escapes
+lib/Pod/Escapes/README         README for Pod::Escapes
+lib/Pod/Escapes/t/01_about_verbose.t   test Pod::Escapes
+lib/Pod/Escapes/t/10_main.t    test Pod::Escapes
+lib/Pod/Escapes/t/15_name2charnum.t    test Pod::Escapes
+lib/Pod/Escapes.pm             Pod::Escapes
 lib/Pod/Find.pm                        used by pod/splitpod
 lib/Pod/Functions.pm           used by pod/splitpod
 lib/Pod/Html.pm                        Convert POD data to HTML
index 518be66..643b489 100644 (file)
@@ -445,7 +445,14 @@ package Maintainers;
                'CPAN'          => 0,
                },
 
-       'Pod::Parser' => {
+       'Pod::Escapes' =>
+                {
+                'MAINTAINER'    => 'sburke',
+                'FILES'         => q[lib/Pod/Escapes.pm lib/Pod/Escapes]
+                'CPAN'          => 1,
+                },
+
+        'Pod::Parser' => {
                'MAINTAINER'    => 'marekr',
                'FILES' => q[lib/Pod/{InputObjects,Parser,ParseUtils,Select,PlainText,Usage,Checker,Find}.pm pod/pod{select,2usage,checker}.PL t/pod/testcmp.pl t/pod/testp2pt.pl t/pod/testpchk.pl t/pod/emptycmd.* t/pod/find.t t/pod/for.* t/pod/headings.* t/pod/include.* t/pod/included.* t/pod/lref.* t/pod/multiline_items.* t/pod/nested_items.* t/pod/nested_seqs.* t/pod/oneline_cmds.* t/pod/poderrs.* t/pod/pod2usage.* t/pod/podselect.* t/pod/special_seqs.*],
                'CPAN'          => 1,
diff --git a/lib/Pod/Escapes.pm b/lib/Pod/Escapes.pm
new file mode 100644 (file)
index 0000000..de4d75a
--- /dev/null
@@ -0,0 +1,721 @@
+
+require 5;
+#                        The documentation is at the end.
+# Time-stamp: "2004-05-07 15:31:25 ADT"
+package Pod::Escapes;
+require Exporter;
+@ISA = ('Exporter');
+$VERSION = '1.04';
+@EXPORT_OK = qw(
+  %Code2USASCII
+  %Name2character
+  %Name2character_number
+  %Latin1Code_to_fallback
+  %Latin1Char_to_fallback
+  e2char
+  e2charnum
+);
+%EXPORT_TAGS = ('ALL' => \@EXPORT_OK);
+
+#==========================================================================
+
+use strict;
+use vars qw(
+  %Code2USASCII
+  %Name2character
+  %Name2character_number
+  %Latin1Code_to_fallback
+  %Latin1Char_to_fallback
+  $FAR_CHAR
+  $FAR_CHAR_NUMBER
+  $NOT_ASCII
+);
+
+$FAR_CHAR = "?" unless defined $FAR_CHAR;
+$FAR_CHAR_NUMBER = ord($FAR_CHAR) unless defined $FAR_CHAR_NUMBER;
+
+$NOT_ASCII = 'A' ne chr(65) unless defined $NOT_ASCII;
+
+#--------------------------------------------------------------------------
+sub e2char {
+  my $in = $_[0];
+  return undef unless defined $in and length $in;
+  
+  # Convert to decimal:
+  if($in =~ m/^(0[0-7]*)$/s ) {
+    $in = oct $in;
+  } elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) {
+    $in = hex $1;
+  } # else it's decimal, or named
+
+  if($NOT_ASCII) {
+    # We're in bizarro world of not-ASCII!
+    # Cope with US-ASCII codes, use fallbacks for Latin-1, or use FAR_CHAR.
+    unless($in =~ m/^\d+$/s) {
+      # It's a named character reference.  Get its numeric Unicode value.
+      $in = $Name2character{$in};
+      return undef unless defined $in;  # (if there's no such name)
+      $in = ord $in; # (All ents must be one character long.)
+        # ...So $in holds the char's US-ASCII numeric value, which we'll
+        #  now go get the local equivalent for.
+    }
+
+    # It's numeric, whether by origin or by mutation from a known name
+    return $Code2USASCII{$in} # so "65" => "A" everywhere
+        || $Latin1Code_to_fallback{$in} # Fallback.
+        || $FAR_CHAR; # Fall further back
+  }
+  
+  # Normal handling:
+  if($in =~ m/^\d+$/s) {
+    if($] < 5.007  and  $in > 255) { # can't be trusted with Unicode
+      return $FAR_CHAR;
+    } else {
+      return chr($in);
+    }
+  } else {
+    return $Name2character{$in}; # returns undef if unknown
+  }
+}
+
+#--------------------------------------------------------------------------
+sub e2charnum {
+  my $in = $_[0];
+  return undef unless defined $in and length $in;
+  
+  # Convert to decimal:
+  if($in =~ m/^(0[0-7]*)$/s ) {
+    $in = oct $in;
+  } elsif($in =~ m/^0?x([0-9a-fA-F]+)$/s ) {
+    $in = hex $1;
+  } # else it's decimal, or named
+
+  if($in =~ m/^\d+$/s) {
+    return 0 + $in;
+  } else {
+    return $Name2character_number{$in}; # returns undef if unknown
+  }
+}
+
+#--------------------------------------------------------------------------
+
+%Name2character_number = (
+ # General XML/XHTML:
+ 'lt'   => 60,
+ 'gt'   => 62,
+ 'quot' => 34,
+ 'amp'  => 38,
+ 'apos' => 39,
+
+ # POD-specific:
+ 'sol'    => 47,
+ 'verbar' => 124,
+
+ 'lchevron' => 171, # legacy for laquo
+ 'rchevron' => 187, # legacy for raquo
+
+ # Remember, grave looks like \ (as in virtu\)
+ #           acute looks like / (as in re/sume/)
+ #           circumflex looks like ^ (as in papier ma^che/)
+ #           umlaut/dieresis looks like " (as in nai"ve, Chloe")
+
+ # From the XHTML 1 .ent files:
+ 'nbsp'     , 160,
+ 'iexcl'    , 161,
+ 'cent'     , 162,
+ 'pound'    , 163,
+ 'curren'   , 164,
+ 'yen'      , 165,
+ 'brvbar'   , 166,
+ 'sect'     , 167,
+ 'uml'      , 168,
+ 'copy'     , 169,
+ 'ordf'     , 170,
+ 'laquo'    , 171,
+ 'not'      , 172,
+ 'shy'      , 173,
+ 'reg'      , 174,
+ 'macr'     , 175,
+ 'deg'      , 176,
+ 'plusmn'   , 177,
+ 'sup2'     , 178,
+ 'sup3'     , 179,
+ 'acute'    , 180,
+ 'micro'    , 181,
+ 'para'     , 182,
+ 'middot'   , 183,
+ 'cedil'    , 184,
+ 'sup1'     , 185,
+ 'ordm'     , 186,
+ 'raquo'    , 187,
+ 'frac14'   , 188,
+ 'frac12'   , 189,
+ 'frac34'   , 190,
+ 'iquest'   , 191,
+ 'Agrave'   , 192,
+ 'Aacute'   , 193,
+ 'Acirc'    , 194,
+ 'Atilde'   , 195,
+ 'Auml'     , 196,
+ 'Aring'    , 197,
+ 'AElig'    , 198,
+ 'Ccedil'   , 199,
+ 'Egrave'   , 200,
+ 'Eacute'   , 201,
+ 'Ecirc'    , 202,
+ 'Euml'     , 203,
+ 'Igrave'   , 204,
+ 'Iacute'   , 205,
+ 'Icirc'    , 206,
+ 'Iuml'     , 207,
+ 'ETH'      , 208,
+ 'Ntilde'   , 209,
+ 'Ograve'   , 210,
+ 'Oacute'   , 211,
+ 'Ocirc'    , 212,
+ 'Otilde'   , 213,
+ 'Ouml'     , 214,
+ 'times'    , 215,
+ 'Oslash'   , 216,
+ 'Ugrave'   , 217,
+ 'Uacute'   , 218,
+ 'Ucirc'    , 219,
+ 'Uuml'     , 220,
+ 'Yacute'   , 221,
+ 'THORN'    , 222,
+ 'szlig'    , 223,
+ 'agrave'   , 224,
+ 'aacute'   , 225,
+ 'acirc'    , 226,
+ 'atilde'   , 227,
+ 'auml'     , 228,
+ 'aring'    , 229,
+ 'aelig'    , 230,
+ 'ccedil'   , 231,
+ 'egrave'   , 232,
+ 'eacute'   , 233,
+ 'ecirc'    , 234,
+ 'euml'     , 235,
+ 'igrave'   , 236,
+ 'iacute'   , 237,
+ 'icirc'    , 238,
+ 'iuml'     , 239,
+ 'eth'      , 240,
+ 'ntilde'   , 241,
+ 'ograve'   , 242,
+ 'oacute'   , 243,
+ 'ocirc'    , 244,
+ 'otilde'   , 245,
+ 'ouml'     , 246,
+ 'divide'   , 247,
+ 'oslash'   , 248,
+ 'ugrave'   , 249,
+ 'uacute'   , 250,
+ 'ucirc'    , 251,
+ 'uuml'     , 252,
+ 'yacute'   , 253,
+ 'thorn'    , 254,
+ 'yuml'     , 255,
+
+ 'fnof'     , 402,
+ 'Alpha'    , 913,
+ 'Beta'     , 914,
+ 'Gamma'    , 915,
+ 'Delta'    , 916,
+ 'Epsilon'  , 917,
+ 'Zeta'     , 918,
+ 'Eta'      , 919,
+ 'Theta'    , 920,
+ 'Iota'     , 921,
+ 'Kappa'    , 922,
+ 'Lambda'   , 923,
+ 'Mu'       , 924,
+ 'Nu'       , 925,
+ 'Xi'       , 926,
+ 'Omicron'  , 927,
+ 'Pi'       , 928,
+ 'Rho'      , 929,
+ 'Sigma'    , 931,
+ 'Tau'      , 932,
+ 'Upsilon'  , 933,
+ 'Phi'      , 934,
+ 'Chi'      , 935,
+ 'Psi'      , 936,
+ 'Omega'    , 937,
+ 'alpha'    , 945,
+ 'beta'     , 946,
+ 'gamma'    , 947,
+ 'delta'    , 948,
+ 'epsilon'  , 949,
+ 'zeta'     , 950,
+ 'eta'      , 951,
+ 'theta'    , 952,
+ 'iota'     , 953,
+ 'kappa'    , 954,
+ 'lambda'   , 955,
+ 'mu'       , 956,
+ 'nu'       , 957,
+ 'xi'       , 958,
+ 'omicron'  , 959,
+ 'pi'       , 960,
+ 'rho'      , 961,
+ 'sigmaf'   , 962,
+ 'sigma'    , 963,
+ 'tau'      , 964,
+ 'upsilon'  , 965,
+ 'phi'      , 966,
+ 'chi'      , 967,
+ 'psi'      , 968,
+ 'omega'    , 969,
+ 'thetasym' , 977,
+ 'upsih'    , 978,
+ 'piv'      , 982,
+ 'bull'     , 8226,
+ 'hellip'   , 8230,
+ 'prime'    , 8242,
+ 'Prime'    , 8243,
+ 'oline'    , 8254,
+ 'frasl'    , 8260,
+ 'weierp'   , 8472,
+ 'image'    , 8465,
+ 'real'     , 8476,
+ 'trade'    , 8482,
+ 'alefsym'  , 8501,
+ 'larr'     , 8592,
+ 'uarr'     , 8593,
+ 'rarr'     , 8594,
+ 'darr'     , 8595,
+ 'harr'     , 8596,
+ 'crarr'    , 8629,
+ 'lArr'     , 8656,
+ 'uArr'     , 8657,
+ 'rArr'     , 8658,
+ 'dArr'     , 8659,
+ 'hArr'     , 8660,
+ 'forall'   , 8704,
+ 'part'     , 8706,
+ 'exist'    , 8707,
+ 'empty'    , 8709,
+ 'nabla'    , 8711,
+ 'isin'     , 8712,
+ 'notin'    , 8713,
+ 'ni'       , 8715,
+ 'prod'     , 8719,
+ 'sum'      , 8721,
+ 'minus'    , 8722,
+ 'lowast'   , 8727,
+ 'radic'    , 8730,
+ 'prop'     , 8733,
+ 'infin'    , 8734,
+ 'ang'      , 8736,
+ 'and'      , 8743,
+ 'or'       , 8744,
+ 'cap'      , 8745,
+ 'cup'      , 8746,
+ 'int'      , 8747,
+ 'there4'   , 8756,
+ 'sim'      , 8764,
+ 'cong'     , 8773,
+ 'asymp'    , 8776,
+ 'ne'       , 8800,
+ 'equiv'    , 8801,
+ 'le'       , 8804,
+ 'ge'       , 8805,
+ 'sub'      , 8834,
+ 'sup'      , 8835,
+ 'nsub'     , 8836,
+ 'sube'     , 8838,
+ 'supe'     , 8839,
+ 'oplus'    , 8853,
+ 'otimes'   , 8855,
+ 'perp'     , 8869,
+ 'sdot'     , 8901,
+ 'lceil'    , 8968,
+ 'rceil'    , 8969,
+ 'lfloor'   , 8970,
+ 'rfloor'   , 8971,
+ 'lang'     , 9001,
+ 'rang'     , 9002,
+ 'loz'      , 9674,
+ 'spades'   , 9824,
+ 'clubs'    , 9827,
+ 'hearts'   , 9829,
+ 'diams'    , 9830,
+ 'OElig'    , 338,
+ 'oelig'    , 339,
+ 'Scaron'   , 352,
+ 'scaron'   , 353,
+ 'Yuml'     , 376,
+ 'circ'     , 710,
+ 'tilde'    , 732,
+ 'ensp'     , 8194,
+ 'emsp'     , 8195,
+ 'thinsp'   , 8201,
+ 'zwnj'     , 8204,
+ 'zwj'      , 8205,
+ 'lrm'      , 8206,
+ 'rlm'      , 8207,
+ 'ndash'    , 8211,
+ 'mdash'    , 8212,
+ 'lsquo'    , 8216,
+ 'rsquo'    , 8217,
+ 'sbquo'    , 8218,
+ 'ldquo'    , 8220,
+ 'rdquo'    , 8221,
+ 'bdquo'    , 8222,
+ 'dagger'   , 8224,
+ 'Dagger'   , 8225,
+ 'permil'   , 8240,
+ 'lsaquo'   , 8249,
+ 'rsaquo'   , 8250,
+ 'euro'     , 8364,
+);
+
+
+# Fill out %Name2character...
+{
+  %Name2character = ();
+  my($name, $number);
+  while( ($name, $number) = each %Name2character_number) {
+    if($] < 5.007  and  $number > 255) {
+      $Name2character{$name} = $FAR_CHAR;
+      # substitute for Unicode characters, for perls
+      #  that can't reliable handle them
+    } else {
+      $Name2character{$name} = chr $number;
+      # normal case
+    }
+  }
+  # So they resolve 'right' even in EBCDIC-land
+  $Name2character{'lt'  }   = '<';
+  $Name2character{'gt'  }   = '>';
+  $Name2character{'quot'}   = '"';
+  $Name2character{'amp' }   = '&';
+  $Name2character{'apos'}   = "'";
+  $Name2character{'sol' }   = '/';
+  $Name2character{'verbar'} = '|';
+}
+
+#--------------------------------------------------------------------------
+
+%Code2USASCII = (
+# mostly generated by
+#  perl -e "printf qq{  \x25 3s, '\x25s',\n}, $_, chr($_) foreach (32 .. 126)"
+   32, ' ',
+   33, '!',
+   34, '"',
+   35, '#',
+   36, '$',
+   37, '%',
+   38, '&',
+   39, "'", #!
+   40, '(',
+   41, ')',
+   42, '*',
+   43, '+',
+   44, ',',
+   45, '-',
+   46, '.',
+   47, '/',
+   48, '0',
+   49, '1',
+   50, '2',
+   51, '3',
+   52, '4',
+   53, '5',
+   54, '6',
+   55, '7',
+   56, '8',
+   57, '9',
+   58, ':',
+   59, ';',
+   60, '<',
+   61, '=',
+   62, '>',
+   63, '?',
+   64, '@',
+   65, 'A',
+   66, 'B',
+   67, 'C',
+   68, 'D',
+   69, 'E',
+   70, 'F',
+   71, 'G',
+   72, 'H',
+   73, 'I',
+   74, 'J',
+   75, 'K',
+   76, 'L',
+   77, 'M',
+   78, 'N',
+   79, 'O',
+   80, 'P',
+   81, 'Q',
+   82, 'R',
+   83, 'S',
+   84, 'T',
+   85, 'U',
+   86, 'V',
+   87, 'W',
+   88, 'X',
+   89, 'Y',
+   90, 'Z',
+   91, '[',
+   92, "\\", #!
+   93, ']',
+   94, '^',
+   95, '_',
+   96, '`',
+   97, 'a',
+   98, 'b',
+   99, 'c',
+  100, 'd',
+  101, 'e',
+  102, 'f',
+  103, 'g',
+  104, 'h',
+  105, 'i',
+  106, 'j',
+  107, 'k',
+  108, 'l',
+  109, 'm',
+  110, 'n',
+  111, 'o',
+  112, 'p',
+  113, 'q',
+  114, 'r',
+  115, 's',
+  116, 't',
+  117, 'u',
+  118, 'v',
+  119, 'w',
+  120, 'x',
+  121, 'y',
+  122, 'z',
+  123, '{',
+  124, '|',
+  125, '}',
+  126, '~',
+);
+
+#--------------------------------------------------------------------------
+
+%Latin1Code_to_fallback = ();
+@Latin1Code_to_fallback{0xA0 .. 0xFF} = (
+# Copied from Text/Unidecode/x00.pm:
+
+' ', qq{!}, qq{C/}, 'PS', qq{\$?}, qq{Y=}, qq{|}, 'SS', qq{"}, qq{(c)}, 'a', qq{<<}, qq{!}, "", qq{(r)}, qq{-},
+'deg', qq{+-}, '2', '3', qq{'}, 'u', 'P', qq{*}, qq{,}, '1', 'o', qq{>>}, qq{1/4}, qq{1/2}, qq{3/4}, qq{?},
+'A', 'A', 'A', 'A', 'A', 'A', 'AE', 'C', 'E', 'E', 'E', 'E', 'I', 'I', 'I', 'I',
+'D', 'N', 'O', 'O', 'O', 'O', 'O', 'x', 'O', 'U', 'U', 'U', 'U', 'U', 'Th', 'ss',
+'a', 'a', 'a', 'a', 'a', 'a', 'ae', 'c', 'e', 'e', 'e', 'e', 'i', 'i', 'i', 'i',
+'d', 'n', 'o', 'o', 'o', 'o', 'o', qq{/}, 'o', 'u', 'u', 'u', 'u', 'y', 'th', 'y',
+
+);
+
+{
+  # Now stuff %Latin1Char_to_fallback:
+  %Latin1Char_to_fallback = ();
+  my($k,$v);
+  while( ($k,$v) = each %Latin1Code_to_fallback) {
+    $Latin1Char_to_fallback{chr $k} = $v;
+    #print chr($k), ' => ', $v, "\n";
+  }
+}
+
+#--------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+Pod::Escapes -- for resolving Pod EE<lt>...E<gt> sequences
+
+=head1 SYNOPSIS
+
+  use Pod::Escapes qw(e2char);
+  ...la la la, parsing POD, la la la...
+  $text = e2char($e_node->label);
+  unless(defined $text) {
+    print "Unknown E sequence \"", $e_node->label, "\"!";
+  }
+  ...else print/interpolate $text...
+
+=head1 DESCRIPTION
+
+This module provides things that are useful in decoding
+Pod EE<lt>...E<gt> sequences.  Presumably, it should be used
+only by Pod parsers and/or formatters.
+
+By default, Pod::Escapes exports none of its symbols.  But
+you can request any of them to be exported.
+Either request them individually, as with
+C<use Pod::Escapes qw(symbolname symbolname2...);>,
+or you can do C<use Pod::Escapes qw(:ALL);> to get all
+exportable symbols.
+
+=head1 GOODIES
+
+=over
+
+=item e2char($e_content)
+
+Given a name or number that could appear in a
+C<EE<lt>name_or_numE<gt>> sequence, this returns the string that
+it stands for.  For example, C<e2char('sol')>, C<e2char('47')>,
+C<e2char('0x2F')>, and C<e2char('057')> all return "/",
+because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>,
+and C<EE<lt>057E<gt>>, all mean "/".  If
+the name has no known value (as with a name of "qacute") or is
+syntactally invalid (as with a name of "1/4"), this returns undef.
+
+=item e2charnum($e_content)
+
+Given a name or number that could appear in a
+C<EE<lt>name_or_numE<gt>> sequence, this returns the number of
+the Unicode character that this stands for.  For example,
+C<e2char('sol')>, C<e2char('47')>,
+C<e2char('0x2F')>, and C<e2char('057')> all return 47,
+because C<EE<lt>solE<gt>>, C<EE<lt>47E<gt>>, C<EE<lt>0x2fE<gt>>,
+and C<EE<lt>057E<gt>>, all mean "/", whose Unicode number is 47.  If
+the name has no known value (as with a name of "qacute") or is
+syntactally invalid (as with a name of "1/4"), this returns undef.
+
+=item $Name2character{I<name>}
+
+Maps from names (as in C<EE<lt>I<name>E<gt>>) like "eacute" or "sol"
+to the string that each stands for.  Note that this does not
+include numerics (like "64" or "x981c").  Under old Perl versions
+(before 5.7) you get a "?" in place of characters whose Unicode
+value is over 255.
+
+=item $Name2character_number{I<name>}
+
+Maps from names (as in C<EE<lt>I<name>E<gt>>) like "eacute" or "sol"
+to the Unicode value that each stands for.  For example,
+C<$Name2character_number{'eacute'}> is 201, and
+C<$Name2character_number{'eacute'}> is 8364.  You get the correct
+Unicode value, regardless of the version of Perl you're using --
+which differs from C<%Name2character>'s behavior under pre-5.7 Perls.
+
+Note that this hash does not
+include numerics (like "64" or "x981c").
+
+=item $Latin1Code_to_fallback{I<integer>}
+
+For numbers in the range 160 (0x00A0) to 255 (0x00FF), this maps
+from the character code for a Latin-1 character (like 233 for
+lowercase e-acute) to the US-ASCII character that best aproximates
+it (like "e").  You may find this useful if you are rendering
+POD in a format that you think deals well only with US-ASCII
+characters.
+
+=item $Latin1Char_to_fallback{I<character>}
+
+Just as above, but maps from characters (like "\xE9", 
+lowercase e-acute) to characters (like "e").
+
+=item $Code2USASCII{I<integer>}
+
+This maps from US-ASCII codes (like 32) to the corresponding
+character (like space, for 32).  Only characters 32 to 126 are
+defined.  This is meant for use by C<e2char($x)> when it senses
+that it's running on a non-ASCII platform (where chr(32) doesn't
+get you a space -- but $Code2USASCII{32} will).  It's
+documented here just in case you might find it useful.
+
+=back
+
+=head1 CAVEATS
+
+On Perl versions before 5.7, Unicode characters with a value
+over 255 (like lambda or emdash) can't be conveyed.  This
+module does work under such early Perl versions, but in the
+place of each such character, you get a "?".  Latin-1
+characters (characters 160-255) are unaffected.
+
+Under EBCDIC platforms, C<e2char($n)> may not always be the
+same as C<chr(e2charnum($n))>, and ditto for
+C<$Name2character{$name}> and
+C<chr($Name2character_number{$name})>.
+
+=head1 SEE ALSO
+
+L<perlpod|perlpod>
+
+L<perlpodspec|perlpodspec>
+
+L<Text::Unidecode|Text::Unidecode>
+
+=head1 COPYRIGHT AND DISCLAIMERS
+
+Copyright (c) 2001-2004 Sean M. Burke.  All rights reserved.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+This program is distributed in the hope that it will be useful, but
+without any warranty; without even the implied warranty of
+merchantability or fitness for a particular purpose.
+
+Portions of the data tables in this module are derived from the
+entity declarations in the W3C XHTML specification.
+
+Currently (October 2001), that's these three:
+
+ http://www.w3.org/TR/xhtml1/DTD/xhtml-lat1.ent
+ http://www.w3.org/TR/xhtml1/DTD/xhtml-special.ent
+ http://www.w3.org/TR/xhtml1/DTD/xhtml-symbol.ent
+
+=head1 AUTHOR
+
+Sean M. Burke C<sburke@cpan.org>
+
+=cut
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# What I used for reading the XHTML .ent files:
+
+use strict;
+my(@norms, @good, @bad);
+my $dir = 'c:/sgml/docbook/';
+my %escapes;
+foreach my $file (qw(
+  xhtml-symbol.ent
+  xhtml-lat1.ent
+  xhtml-special.ent
+)) {
+  open(IN, "<$dir$file") or die "can't read-open $dir$file: $!";
+  print "Reading $file...\n";
+  while(<IN>) {
+    if(m/<!ENTITY\s+(\S+)\s+"&#([^;]+);">/) {
+      my($name, $value) = ($1,$2);
+      next if $name eq 'quot' or $name eq 'apos' or $name eq 'gt';
+    
+      $value = hex $1 if $value =~ m/^x([a-fA-F0-9]+)$/s;
+      print "ILLEGAL VALUE $value" unless $value =~ m/^\d+$/s;
+      if($value > 255) {
+        push @good , sprintf "   %-10s , chr(%s),\n", "'$name'", $value;
+        push @bad  , sprintf "   %-10s , \$bad,\n", "'$name'", $value;
+      } else {
+        push @norms, sprintf " %-10s , chr(%s),\n", "'$name'", $value;
+      }
+    } elsif(m/<!ENT/) {
+      print "# Skipping $_";
+    }
+  
+  }
+  close(IN);
+}
+
+print @norms;
+print "\n ( \$] .= 5.006001 ? (\n";
+print @good;
+print " ) : (\n";
+print @bad;
+print " )\n);\n";
+
+__END__
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
diff --git a/lib/Pod/Escapes/ChangeLog b/lib/Pod/Escapes/ChangeLog
new file mode 100644 (file)
index 0000000..11a9608
--- /dev/null
@@ -0,0 +1,26 @@
+Revision history for Perl extension Pod::Escapes
+                                        Time-stamp: "2004-05-07 15:44:30 ADT"
+
+2004-05-07  Sean M. Burke  sburke@cpan.org
+
+       * Release 1.04 -- adding support for E<x123> as an alternate form
+       for E<0x123>.  Adding the function e2charnum nad the hash
+       %Name2character_number.
+
+       Tests rearranged, and new ones added.   
+
+2002-08-27  Sean M. Burke  sburke@cpan.org
+
+       * Release 1.03 -- previous version mistakenly thought that "x4f"
+       was the syntax for hex escapes in Pod.  Perlpod says it's 0x4f, so
+       Pod::Escapes has been changed to support this syntax instead
+       (instead!).
+       
+2001-12-14  Sean M. Burke  sburke@cpan.org
+       
+       * Release 1.02 -- added %Name2character_number and e2charnum, at
+       the suggestion of Tim Jenness.
+       
+2001-10-24  Sean M. Burke  sburke@cpan.org
+
+       * Release 1.01 -- first release version
diff --git a/lib/Pod/Escapes/README b/lib/Pod/Escapes/README
new file mode 100644 (file)
index 0000000..d044647
--- /dev/null
@@ -0,0 +1,91 @@
+README for Pod::Escapes
+                                        Time-stamp: "2004-04-27 19:55:10 ADT"
+
+NAME
+    Pod::Escapes -- for resolving Pod E<...> sequences
+
+SYNOPSIS
+      use Pod::Escapes qw(e2char);
+      ...la la la, parsing POD, la la la...
+      $text = e2char($e_node->label);
+      unless(defined $text) {
+        print "Unknown E sequence \"", $e_node->label, "\"!";
+      }
+      ...else print/interpolate $text...
+
+DESCRIPTION
+    This module provides things that are useful in decoding Pod E<...>
+    sequences. Presumably, it should be used only by Pod parsers and/or
+    formatters.
+
+    By default, Pod::Escapes exports none of its symbols. But you can request
+    any of them to be exported. Either request them individually, as with `use
+    Pod::Escapes qw(symbolname symbolname2...);', or you can do `use
+    Pod::Escapes qw(:ALL);' to get all exportable symbols.
+
+[...]
+
+CAVEATS
+    On Perl versions before 5.7, Unicode characters with a value over 255 (like
+    lambda or emdash) can't be conveyed. This module does work under such early
+    Perl versions, but in the place of each such character, you get a "?".
+    Latin-1 characters (characters 160-255) are unaffected.
+
+SEE ALSO
+    perlpod
+
+    perlpodspec
+
+    Text::Unidecode
+
+[...]
+
+
+PREREQUISITES
+
+This suite requires Perl 5; I've only used it under Perl 5.004, so for
+anything lower, you're on your own.
+
+Pod::Escapes doesn't use any nonstandard modules.
+
+
+INSTALLATION
+
+You install Pod::Escapes, as you would install any perl module
+library, by running these commands:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+If you want to install a private copy of Pod::Escapes in your home
+directory, then you should try to produce the initial Makefile with
+something like this command:
+
+  perl Makefile.PL LIB=~/perl
+
+
+DOCUMENTATION
+
+POD-format documentation is included in Escapes.pm.  POD is readable
+with the 'perldoc' utility.  See ChangeLog for recent changes.
+
+
+MACPERL INSTALLATION NOTES
+
+Don't bother with the makefiles.  Just make a Pod directory in your
+MacPerl site_lib or lib directory, and move Escapes.pm into there.
+
+
+SUPPORT
+
+Questions, bug reports, useful code bits, and suggestions for
+Pod::Escapes should just be sent to me at sburke@cpan.org
+
+
+AVAILABILITY
+
+The latest version of Pod::Escapes is available from the
+Comprehensive Perl Archive Network (CPAN).  Visit
+<http://www.perl.com/CPAN/> to find a CPAN site near you.
diff --git a/lib/Pod/Escapes/t/01_about_verbose.t b/lib/Pod/Escapes/t/01_about_verbose.t
new file mode 100644 (file)
index 0000000..61bc627
--- /dev/null
@@ -0,0 +1,93 @@
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+require 5;
+# Time-stamp: "2004-04-27 19:44:49 ADT"
+
+# Summary of, well, things.
+
+use Test;
+BEGIN {plan tests => 2};
+
+ok 1;
+
+use Pod::Escapes ();
+
+#chdir "t" if -e "t";
+
+{
+  my @out;
+  push @out,
+    "\n\nPerl v",
+    defined($^V) ? sprintf('%vd', $^V) : $],
+    " under $^O ",
+    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
+      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
+    (defined $MacPerl::Version)
+      ? ("(MacPerl version $MacPerl::Version)") : (),
+    "\n"
+  ;
+
+  # Ugly code to walk the symbol tables:
+  my %v;
+  my @stack = ('');  # start out in %::
+  my $this;
+  my $count = 0;
+  my $pref;
+  while(@stack) {
+    $this = shift @stack;
+    die "Too many packages?" if ++$count > 1000;
+    next if exists $v{$this};
+    next if $this eq 'main'; # %main:: is %::
+
+    #print "Peeking at $this => ${$this . '::VERSION'}\n";
+    
+    if(defined ${$this . '::VERSION'} ) {
+      $v{$this} = ${$this . '::VERSION'}
+    } elsif(
+       defined *{$this . '::ISA'} or defined &{$this . '::import'}
+       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
+       # If it has an ISA, an import, or any subs...
+    ) {
+      # It's a class/module with no version.
+      $v{$this} = undef;
+    } else {
+      # It's probably an unpopulated package.
+      ## $v{$this} = '...';
+    }
+    
+    $pref = length($this) ? "$this\::" : '';
+    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
+    #print "Stack: @stack\n";
+  }
+  push @out, " Modules in memory:\n";
+  delete @v{'', '[none]'};
+  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
+    $indent = ' ' x (2 + ($p =~ tr/:/:/));
+    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
+  }
+  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
+    scalar(gmtime), scalar(localtime);
+  my $x = join '', @out;
+  $x =~ s/^/#/mg;
+  print $x;
+}
+
+print "# Running",
+  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
+  "#\n",
+;
+
+print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
+
+print "# \%INC:\n";
+foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
+  print "#   [$x] = [", $INC{$x} || '', "]\n";
+}
+
+ok 1;
+
diff --git a/lib/Pod/Escapes/t/10_main.t b/lib/Pod/Escapes/t/10_main.t
new file mode 100644 (file)
index 0000000..b42205c
--- /dev/null
@@ -0,0 +1,120 @@
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+# Time-stamp: "2004-05-07 15:43:11 ADT"
+
+use strict;
+use Test;
+
+my @them;
+BEGIN { plan('tests' => 63) };
+BEGIN { print "# Perl version $] under $^O\n" }
+
+use Pod::Escapes qw(:ALL);
+ok 1;
+
+eval " binmode(STDOUT, ':utf8') ";
+
+print "# Pod::Escapes version $Pod::Escapes::VERSION\n";
+print "# I'm ", (chr(65) eq 'A') ? '' : 'not ', "in ASCII world.\n";
+print "#\n#------------------------\n#\n";
+
+foreach my $quotie (qw( \n \r \cm \cj \t \f \b \a \e )) {
+  my $val = eval "\"$quotie\"";
+  if($@) {
+    ok 0;
+    print "# Error in evalling quotie \"$quotie\"\n";
+  } elsif(!defined $val) {
+    ok 0;
+    print "# \"$quotie\" is undef!?\n";
+  } else {
+    ok 1;
+    print "# \"$quotie\" is ", ord($val), "\n";
+  }
+}
+
+print "#\n#------------------------\n#\n";
+
+print "# 'A' tests...\n";
+ok e2char('65'), 'A';
+ok e2char('x41'), 'A';
+ok e2char('x041'), 'A';
+ok e2char('x0041'), 'A';
+ok e2char('x00041'), 'A';
+ok e2char('0101'), 'A';
+ok e2char('00101'), 'A';
+ok e2char('000101'), 'A';
+ok e2char('0000101'), 'A';
+
+print "# '<' tests...\n";
+ok e2char('lt'), '<';
+ok e2char('60'), '<';
+ok e2char('074'), '<';
+ok e2char('0074'), '<';
+ok e2char('00074'), '<';
+ok e2char('000074'), '<';
+
+ok e2char('x3c'), '<';
+ok e2char('x3C'), '<';
+ok e2char('x03c'), '<';
+ok e2char('x003c'), '<';
+ok e2char('x0003c'), '<';
+ok e2char('x00003c'), '<';
+ok e2char('0x3c'), '<';
+ok e2char('0x3C'), '<';
+ok e2char('0x03c'), '<';
+ok e2char('0x003c'), '<';
+ok e2char('0x0003c'), '<';
+ok e2char('0x00003c'), '<';
+
+ok e2char('65') ne e2char('lt');
+
+print "# eacute tests...\n";
+ok defined e2char('eacute');
+
+print "#    eacute is <", e2char('eacute'), "> which is code ",
+      ord(e2char('eacute')), "\n";
+
+ok e2char('eacute'), e2char('233');
+ok e2char('eacute'), e2char('0351');
+ok e2char('eacute'), e2char('xe9');
+ok e2char('eacute'), e2char('xE9');
+
+print "# pi tests...\n";
+ok defined e2char('pi');
+
+print "#    pi is <", e2char('pi'), "> which is code ",
+      ord(e2char('pi')), "\n";
+
+ok e2char('pi'), e2char('960');
+ok e2char('pi'), e2char('01700');
+ok e2char('pi'), e2char('001700');
+ok e2char('pi'), e2char('0001700');
+ok e2char('pi'), e2char('x3c0');
+ok e2char('pi'), e2char('x3C0');
+ok e2char('pi'), e2char('x03C0');
+ok e2char('pi'), e2char('x003C0');
+ok e2char('pi'), e2char('x0003C0');
+
+
+print "# various hash tests...\n";
+
+ok scalar keys %Name2character;
+ok defined $Name2character{'eacute'};
+ok $Name2character{'lt'} eq '<';
+
+ok scalar keys %Latin1Code_to_fallback;
+ok defined $Latin1Code_to_fallback{233};
+
+ok scalar keys %Latin1Char_to_fallback;
+ok defined $Latin1Char_to_fallback{chr(233)};
+
+ok scalar keys %Code2USASCII;
+ok defined $Code2USASCII{65};
+ok $Code2USASCII{65} eq 'A';
+
+
diff --git a/lib/Pod/Escapes/t/15_name2charnum.t b/lib/Pod/Escapes/t/15_name2charnum.t
new file mode 100644 (file)
index 0000000..2ce1fa0
--- /dev/null
@@ -0,0 +1,87 @@
+BEGIN {
+    if($ENV{PERL_CORE}) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+# Time-stamp: "2004-04-27 19:53:22 ADT"
+
+use strict;
+use Test;
+
+my @them;
+BEGIN { plan('tests' => 41) };
+BEGIN { print "# Perl version $] under $^O\n" }
+
+use Pod::Escapes qw(:ALL);
+ok 1;
+
+eval " binmode(STDOUT, ':utf8') ";
+
+print "# Pod::Escapes version $Pod::Escapes::VERSION\n";
+print "# I'm ", (chr(65) eq 'A') ? '' : 'not ', "in ASCII world.\n";
+print "#\n#------------------------\n#\n";
+
+print "# 'A' tests...\n";
+ok e2charnum('65'), '65';
+ok e2charnum('x41'), '65';
+ok e2charnum('x041'), '65';
+ok e2charnum('x0041'), '65';
+ok e2charnum('x00041'), '65';
+ok e2charnum('0101'), '65';
+ok e2charnum('00101'), '65';
+ok e2charnum('000101'), '65';
+ok e2charnum('0000101'), '65';
+
+print "# '<' tests...\n";
+ok e2charnum('lt'), '60';
+ok e2charnum('60'), '60';
+ok e2charnum('074'), '60';
+ok e2charnum('0074'), '60';
+ok e2charnum('00074'), '60';
+ok e2charnum('000074'), '60';
+ok e2charnum('x3c'), '60';
+ok e2charnum('x3C'), '60';
+ok e2charnum('x03c'), '60';
+ok e2charnum('x003c'), '60';
+ok e2charnum('x0003c'), '60';
+ok e2charnum('x00003c'), '60';
+
+ok e2charnum('65') ne e2charnum('lt');
+
+print "# eacute tests...\n";
+ok defined e2charnum('eacute');
+
+print "#    eacute is <", e2charnum('eacute'), "> which is code ",
+      ord(e2charnum('eacute')), "\n";
+
+ok e2charnum('eacute'), e2charnum('233');
+ok e2charnum('eacute'), e2charnum('0351');
+ok e2charnum('eacute'), e2charnum('xe9');
+ok e2charnum('eacute'), e2charnum('xE9');
+
+print "# pi tests...\n";
+ok defined e2charnum('pi');
+
+print "#    pi is <", e2charnum('pi'), "> which is code ",
+      e2charnum('pi'), "\n";
+
+ok e2charnum('pi'), e2charnum('960');
+ok e2charnum('pi'), e2charnum('01700');
+ok e2charnum('pi'), e2charnum('001700');
+ok e2charnum('pi'), e2charnum('0001700');
+ok e2charnum('pi'), e2charnum('x3c0');
+ok e2charnum('pi'), e2charnum('x3C0');
+ok e2charnum('pi'), e2charnum('x03C0');
+ok e2charnum('pi'), e2charnum('x003C0');
+ok e2charnum('pi'), e2charnum('x0003C0');
+
+
+print "# %Name2character_number test...\n";
+
+ok scalar keys %Name2character_number;
+ok defined $Name2character_number{'eacute'};
+ok $Name2character_number{'lt'} eq '60';
+
+# End