home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _3cc1e3c1c200c47c917ca4166ed3dd4e < prev    next >
Text File  |  2004-06-01  |  13KB  |  457 lines
  1. package HTML::Entities;
  2.  
  3. # $Id: Entities.pm,v 1.27 2003/10/10 09:56:18 gisle Exp $
  4.  
  5. =head1 NAME
  6.  
  7. HTML::Entities - Encode or decode strings with HTML entities
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  use HTML::Entities;
  12.  
  13.  $a = "Våre norske tegn bør æres";
  14.  decode_entities($a);
  15.  encode_entities($a, "\200-\377");
  16.  
  17. For example, this:
  18.  
  19.  $input = "vis-α-vis BeyoncΘ's na∩ve\npapier-mΓchΘ rΘsumΘ";
  20.  print encode_entities($in), "\n"
  21.  
  22. Prints this out:
  23.  
  24.  vis-à-vis Beyoncé's naïve
  25.  papier-mâché résumé
  26.  
  27. =head1 DESCRIPTION
  28.  
  29. This module deals with encoding and decoding of strings with HTML
  30. character entities.  The module provides the following functions:
  31.  
  32. =over 4
  33.  
  34. =item decode_entities( $string )
  35.  
  36. This routine replaces HTML entities found in the $string with the
  37. corresponding ISO-8859-1 character, and if possible (under perl 5.8
  38. or later) will replace to Unicode characters.  Unrecognized
  39. entities are left alone.
  40.  
  41. This routine is exported by default.
  42.  
  43. =item encode_entities( $string )
  44.  
  45. =item encode_entities( $string, $unsafe_chars )
  46.  
  47. This routine replaces unsafe characters in $string with their entity
  48. representation. A second argument can be given to specify which
  49. characters to consider unsafe (i.e., which to escape). The default set
  50. of characters to encode are control chars, high-bit chars, and the
  51. C<< < >>, C<< & >>, C<< > >>, and C<< " >>
  52. characters.  But this, for example, would encode I<just> the
  53. C<< < >>, C<< & >>, C<< > >>, and C<< " >> characters:
  54.  
  55.   $escaped = encode_entities($input, '<>&"');
  56.  
  57. This routine is exported by default.
  58.  
  59. =item encode_entities_numeric( $string )
  60.  
  61. =item encode_entities_numeric( $string, $unsafe_chars )
  62.  
  63. This routine works just like encode_entities, except that the replacement
  64. entities are always C<&#xI<hexnum>;> and never C<&I<entname>;>.  For
  65. example, C<escape_entities("r\xF4le")> returns "rôle", but
  66. C<escape_entities_numeric("r\xF4le")> returns "rôle".
  67.  
  68. This routine is I<not> exported by default.  But you can always
  69. export it with C<use HTML::Entities qw(encode_entities_numeric);>
  70. or even C<use HTML::Entities qw(:DEFAULT encode_entities_numeric);>
  71.  
  72. =back
  73.  
  74. All these routines modify the string passed as the first argument, if
  75. called in a void context.  In scalar and array contexts, the encoded or
  76. decoded string is returned (without changing the input string).
  77.  
  78. If you prefer not to import these routines into your namespace, you can
  79. call them as:
  80.  
  81.   use HTML::Entities ();
  82.   $decoded = HTML::Entities::decode($a);
  83.   $encoded = HTML::Entities::encode($a);
  84.   $encoded = HTML::Entities::encode_numeric($a);
  85.  
  86. The module can also export the %char2entity and the %entity2char
  87. hashes, which contain the mapping from all characters to the
  88. corresponding entities (and vice versa, respectively).
  89.  
  90. =head1 COPYRIGHT
  91.  
  92. Copyright 1995-2003 Gisle Aas. All rights reserved.
  93.  
  94. This library is free software; you can redistribute it and/or
  95. modify it under the same terms as Perl itself.
  96.  
  97. =cut
  98.  
  99. use strict;
  100. use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  101. use vars qw(%entity2char %char2entity);
  102.  
  103. require 5.004;
  104. require Exporter;
  105. @ISA = qw(Exporter);
  106.  
  107. @EXPORT = qw(encode_entities decode_entities _decode_entities);
  108. @EXPORT_OK = qw(%entity2char %char2entity encode_entities_numeric);
  109.  
  110. $VERSION = sprintf("%d.%02d", q$Revision: 1.27 $ =~ /(\d+)\.(\d+)/);
  111. sub Version { $VERSION; }
  112.  
  113. require HTML::Parser;  # for fast XS implemented decode_entities
  114.  
  115.  
  116. %entity2char = (
  117.  # Some normal chars that have special meaning in SGML context
  118.  amp    => '&',  # ampersand 
  119. 'gt'    => '>',  # greater than
  120. 'lt'    => '<',  # less than
  121.  quot   => '"',  # double quote
  122.  apos   => "'",  # single quote
  123.  
  124.  # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
  125.  AElig    => '╞',  # capital AE diphthong (ligature)
  126.  Aacute    => '┴',  # capital A, acute accent
  127.  Acirc    => '┬',  # capital A, circumflex accent
  128.  Agrave    => '└',  # capital A, grave accent
  129.  Aring    => '┼',  # capital A, ring
  130.  Atilde    => '├',  # capital A, tilde
  131.  Auml    => '─',  # capital A, dieresis or umlaut mark
  132.  Ccedil    => '╟',  # capital C, cedilla
  133.  ETH    => '╨',  # capital Eth, Icelandic
  134.  Eacute    => '╔',  # capital E, acute accent
  135.  Ecirc    => '╩',  # capital E, circumflex accent
  136.  Egrave    => '╚',  # capital E, grave accent
  137.  Euml    => '╦',  # capital E, dieresis or umlaut mark
  138.  Iacute    => '═',  # capital I, acute accent
  139.  Icirc    => '╬',  # capital I, circumflex accent
  140.  Igrave    => '╠',  # capital I, grave accent
  141.  Iuml    => '╧',  # capital I, dieresis or umlaut mark
  142.  Ntilde    => '╤',  # capital N, tilde
  143.  Oacute    => '╙',  # capital O, acute accent
  144.  Ocirc    => '╘',  # capital O, circumflex accent
  145.  Ograve    => '╥',  # capital O, grave accent
  146.  Oslash    => '╪',  # capital O, slash
  147.  Otilde    => '╒',  # capital O, tilde
  148.  Ouml    => '╓',  # capital O, dieresis or umlaut mark
  149.  THORN    => '▐',  # capital THORN, Icelandic
  150.  Uacute    => '┌',  # capital U, acute accent
  151.  Ucirc    => '█',  # capital U, circumflex accent
  152.  Ugrave    => '┘',  # capital U, grave accent
  153.  Uuml    => '▄',  # capital U, dieresis or umlaut mark
  154.  Yacute    => '▌',  # capital Y, acute accent
  155.  aacute    => 'ß',  # small a, acute accent
  156.  acirc    => 'Γ',  # small a, circumflex accent
  157.  aelig    => 'µ',  # small ae diphthong (ligature)
  158.  agrave    => 'α',  # small a, grave accent
  159.  aring    => 'σ',  # small a, ring
  160.  atilde    => 'π',  # small a, tilde
  161.  auml    => 'Σ',  # small a, dieresis or umlaut mark
  162.  ccedil    => 'τ',  # small c, cedilla
  163.  eacute    => 'Θ',  # small e, acute accent
  164.  ecirc    => 'Ω',  # small e, circumflex accent
  165.  egrave    => 'Φ',  # small e, grave accent
  166.  eth    => '≡',  # small eth, Icelandic
  167.  euml    => 'δ',  # small e, dieresis or umlaut mark
  168.  iacute    => 'φ',  # small i, acute accent
  169.  icirc    => 'ε',  # small i, circumflex accent
  170.  igrave    => '∞',  # small i, grave accent
  171.  iuml    => '∩',  # small i, dieresis or umlaut mark
  172.  ntilde    => '±',  # small n, tilde
  173.  oacute    => '≤',  # small o, acute accent
  174.  ocirc    => '⌠',  # small o, circumflex accent
  175.  ograve    => '≥',  # small o, grave accent
  176.  oslash    => '°',  # small o, slash
  177.  otilde    => '⌡',  # small o, tilde
  178.  ouml    => '÷',  # small o, dieresis or umlaut mark
  179.  szlig    => '▀',  # small sharp s, German (sz ligature)
  180.  thorn    => '■',  # small thorn, Icelandic
  181.  uacute    => '·',  # small u, acute accent
  182.  ucirc    => '√',  # small u, circumflex accent
  183.  ugrave    => '∙',  # small u, grave accent
  184.  uuml    => 'ⁿ',  # small u, dieresis or umlaut mark
  185.  yacute    => '²',  # small y, acute accent
  186.  yuml    => ' ',  # small y, dieresis or umlaut mark
  187.  
  188.  # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
  189.  copy   => '⌐',  # copyright sign
  190.  reg    => '«',  # registered sign
  191.  nbsp   => "\240", # non breaking space
  192.  
  193.  # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
  194.  iexcl  => 'í',
  195.  cent   => 'ó',
  196.  pound  => 'ú',
  197.  curren => 'ñ',
  198.  yen    => 'Ñ',
  199.  brvbar => 'ª',
  200.  sect   => 'º',
  201.  uml    => '¿',
  202.  ordf   => '¬',
  203.  laquo  => '½',
  204. 'not'   => '¼',    # not is a keyword in perl
  205.  shy    => '¡',
  206.  macr   => '»',
  207.  deg    => '░',
  208.  plusmn => '▒',
  209.  sup1   => '╣',
  210.  sup2   => '▓',
  211.  sup3   => '│',
  212.  acute  => '┤',
  213.  micro  => '╡',
  214.  para   => '╢',
  215.  middot => '╖',
  216.  cedil  => '╕',
  217.  ordm   => '║',
  218.  raquo  => '╗',
  219.  frac14 => '╝',
  220.  frac12 => '╜',
  221.  frac34 => '╛',
  222.  iquest => '┐',
  223. 'times' => '╫',    # times is a keyword in perl
  224.  divide => '≈',
  225.  
  226.  ( $] > 5.007 ? (
  227.    OElig    => chr(338),
  228.    oelig    => chr(339),
  229.    Scaron   => chr(352),
  230.    scaron   => chr(353),
  231.    Yuml     => chr(376),
  232.    fnof     => chr(402),
  233.    circ     => chr(710),
  234.    tilde    => chr(732),
  235.    Alpha    => chr(913),
  236.    Beta     => chr(914),
  237.    Gamma    => chr(915),
  238.    Delta    => chr(916),
  239.    Epsilon  => chr(917),
  240.    Zeta     => chr(918),
  241.    Eta      => chr(919),
  242.    Theta    => chr(920),
  243.    Iota     => chr(921),
  244.    Kappa    => chr(922),
  245.    Lambda   => chr(923),
  246.    Mu       => chr(924),
  247.    Nu       => chr(925),
  248.    Xi       => chr(926),
  249.    Omicron  => chr(927),
  250.    Pi       => chr(928),
  251.    Rho      => chr(929),
  252.    Sigma    => chr(931),
  253.    Tau      => chr(932),
  254.    Upsilon  => chr(933),
  255.    Phi      => chr(934),
  256.    Chi      => chr(935),
  257.    Psi      => chr(936),
  258.    Omega    => chr(937),
  259.    alpha    => chr(945),
  260.    beta     => chr(946),
  261.    gamma    => chr(947),
  262.    delta    => chr(948),
  263.    epsilon  => chr(949),
  264.    zeta     => chr(950),
  265.    eta      => chr(951),
  266.    theta    => chr(952),
  267.    iota     => chr(953),
  268.    kappa    => chr(954),
  269.    lambda   => chr(955),
  270.    mu       => chr(956),
  271.    nu       => chr(957),
  272.    xi       => chr(958),
  273.    omicron  => chr(959),
  274.    pi       => chr(960),
  275.    rho      => chr(961),
  276.    sigmaf   => chr(962),
  277.    sigma    => chr(963),
  278.    tau      => chr(964),
  279.    upsilon  => chr(965),
  280.    phi      => chr(966),
  281.    chi      => chr(967),
  282.    psi      => chr(968),
  283.    omega    => chr(969),
  284.    thetasym => chr(977),
  285.    upsih    => chr(978),
  286.    piv      => chr(982),
  287.    ensp     => chr(8194),
  288.    emsp     => chr(8195),
  289.    thinsp   => chr(8201),
  290.    zwnj     => chr(8204),
  291.    zwj      => chr(8205),
  292.    lrm      => chr(8206),
  293.    rlm      => chr(8207),
  294.    ndash    => chr(8211),
  295.    mdash    => chr(8212),
  296.    lsquo    => chr(8216),
  297.    rsquo    => chr(8217),
  298.    sbquo    => chr(8218),
  299.    ldquo    => chr(8220),
  300.    rdquo    => chr(8221),
  301.    bdquo    => chr(8222),
  302.    dagger   => chr(8224),
  303.    Dagger   => chr(8225),
  304.    bull     => chr(8226),
  305.    hellip   => chr(8230),
  306.    permil   => chr(8240),
  307.    prime    => chr(8242),
  308.    Prime    => chr(8243),
  309.    lsaquo   => chr(8249),
  310.    rsaquo   => chr(8250),
  311.    oline    => chr(8254),
  312.    frasl    => chr(8260),
  313.    euro     => chr(8364),
  314.    image    => chr(8465),
  315.    weierp   => chr(8472),
  316.    real     => chr(8476),
  317.    trade    => chr(8482),
  318.    alefsym  => chr(8501),
  319.    larr     => chr(8592),
  320.    uarr     => chr(8593),
  321.    rarr     => chr(8594),
  322.    darr     => chr(8595),
  323.    harr     => chr(8596),
  324.    crarr    => chr(8629),
  325.    lArr     => chr(8656),
  326.    uArr     => chr(8657),
  327.    rArr     => chr(8658),
  328.    dArr     => chr(8659),
  329.    hArr     => chr(8660),
  330.    forall   => chr(8704),
  331.    part     => chr(8706),
  332.    exist    => chr(8707),
  333.    empty    => chr(8709),
  334.    nabla    => chr(8711),
  335.    isin     => chr(8712),
  336.    notin    => chr(8713),
  337.    ni       => chr(8715),
  338.    prod     => chr(8719),
  339.    sum      => chr(8721),
  340.    minus    => chr(8722),
  341.    lowast   => chr(8727),
  342.    radic    => chr(8730),
  343.    prop     => chr(8733),
  344.    infin    => chr(8734),
  345.    ang      => chr(8736),
  346.   'and'     => chr(8743),
  347.   'or'      => chr(8744),
  348.    cap      => chr(8745),
  349.    cup      => chr(8746),
  350.   'int'     => chr(8747),
  351.    there4   => chr(8756),
  352.    sim      => chr(8764),
  353.    cong     => chr(8773),
  354.    asymp    => chr(8776),
  355.   'ne'      => chr(8800),
  356.    equiv    => chr(8801),
  357.   'le'      => chr(8804),
  358.   'ge'      => chr(8805),
  359.   'sub'     => chr(8834),
  360.    sup      => chr(8835),
  361.    nsub     => chr(8836),
  362.    sube     => chr(8838),
  363.    supe     => chr(8839),
  364.    oplus    => chr(8853),
  365.    otimes   => chr(8855),
  366.    perp     => chr(8869),
  367.    sdot     => chr(8901),
  368.    lceil    => chr(8968),
  369.    rceil    => chr(8969),
  370.    lfloor   => chr(8970),
  371.    rfloor   => chr(8971),
  372.    lang     => chr(9001),
  373.    rang     => chr(9002),
  374.    loz      => chr(9674),
  375.    spades   => chr(9824),
  376.    clubs    => chr(9827),
  377.    hearts   => chr(9829),
  378.    diams    => chr(9830),
  379.  ) : ())
  380. );
  381.  
  382.  
  383. # Make the opposite mapping
  384. while (my($entity, $char) = each(%entity2char)) {
  385.     $char2entity{$char} = "&$entity;";
  386. }
  387. delete $char2entity{"'"};  # only one-way decoding
  388.  
  389. # Fill in missing entities
  390. for (0 .. 255) {
  391.     next if exists $char2entity{chr($_)};
  392.     $char2entity{chr($_)} = "&#$_;";
  393. }
  394.  
  395. my %subst;  # compiled encoding regexps
  396.  
  397. sub decode_entities_old
  398. {
  399.     my $array;
  400.     if (defined wantarray) {
  401.     $array = [@_]; # copy
  402.     } else {
  403.     $array = \@_;  # modify in-place
  404.     }
  405.     my $c;
  406.     for (@$array) {
  407.     s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
  408.     s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
  409.     s/(&(\w+);?)/$entity2char{$2} || $1/eg;
  410.     }
  411.     wantarray ? @$array : $array->[0];
  412. }
  413.  
  414. sub encode_entities
  415. {
  416.     my $ref;
  417.     if (defined wantarray) {
  418.     my $x = $_[0];
  419.     $ref = \$x;     # copy
  420.     } else {
  421.     $ref = \$_[0];  # modify in-place
  422.     }
  423.     if (defined $_[1] and length $_[1]) {
  424.     unless (exists $subst{$_[1]}) {
  425.         # Because we can't compile regex we fake it with a cached sub
  426.         my $code = "sub {\$_[0] =~ s/([$_[1]])/\$char2entity{\$1} || num_entity(\$1)/ge; }";
  427.         $subst{$_[1]} = eval $code;
  428.         die( $@ . " while trying to turn range: \"$_[1]\"\n "
  429.           . "into code: $code\n "
  430.         ) if $@;
  431.     }
  432.     &{$subst{$_[1]}}($$ref);
  433.     } else {
  434.     # Encode control chars, high bit chars and '<', '&', '>', '"'
  435.     $$ref =~ s/([^\n\r\t !\#\$%\'-;=?-~])/$char2entity{$1} || num_entity($1)/ge;
  436.     }
  437.     $$ref;
  438. }
  439.  
  440. sub encode_entities_numeric {
  441.     local %char2entity;
  442.     return &encode_entities;   # a goto &encode_entities wouldn't work
  443. }
  444.  
  445.  
  446. sub num_entity {
  447.     sprintf "&#x%X;", ord($_[0]);
  448. }
  449.  
  450. # Set up aliases
  451. *encode = \&encode_entities;
  452. *encode_numeric = \&encode_entities_numeric;
  453. *encode_numerically = \&encode_entities_numeric;
  454. *decode = \&decode_entities;
  455.  
  456. 1;
  457.