home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / HTML / Entities.pm < prev    next >
Text File  |  1997-09-05  |  7KB  |  231 lines
  1. package HTML::Entities;
  2.  
  3. # $Id: Entities.pm,v 1.10 1997/09/05 09:02:04 aas Exp $
  4.  
  5. =head1 NAME
  6.  
  7. decode - Expand HTML entities in a string
  8.  
  9. encode - Encode chars in a string using HTML entities
  10.  
  11. =head1 SYNOPSIS
  12.  
  13.  use HTML::Entities;
  14.  
  15.  $a = "Våre norske tegn bør æres";
  16.  decode_entities($a);
  17.  encode_entities($a, "\200-\377");
  18.  
  19. =head1 DESCRIPTION
  20.  
  21. The decode_entities() routine replaces valid HTML entities found
  22. in the string with the corresponding ISO-8859/1 character.
  23.  
  24. The encode_entities() routine replaces the characters specified by the
  25. second argument with their entity representation.  The default set of
  26. characters to expand are control chars, high-bit chars and the '<',
  27. '&', '>' and '"' character.
  28.  
  29. Both routines modify the string passed in as the first argument and
  30. return it.
  31.  
  32. If you prefer not to import these routines into your namespace you can
  33. call them as:
  34.  
  35.   use HTML::Entities ();
  36.   $encoded = HTML::Entities::encode($a);
  37.   $decoded = HTML::Entities::decode($a);
  38.  
  39. The module can also export the %char2entity and the %entity2char
  40. hashes which contains the mapping from all characters to the
  41. corresponding entities.
  42.  
  43. =head1 COPYRIGHT
  44.  
  45. Copyright 1995-1997 Gisle Aas. All rights reserved.
  46.  
  47. This library is free software; you can redistribute it and/or
  48. modify it under the same terms as Perl itself.
  49.  
  50. =cut
  51.  
  52. require 5.004;
  53. require Exporter;
  54. @ISA = qw(Exporter);
  55.  
  56. @EXPORT = qw(encode_entities decode_entities);
  57. @EXPORT_OK = qw(%entity2char %char2entity);
  58.  
  59. $VERSION = sprintf("%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/);
  60. sub Version { $VERSION; }
  61.  
  62.  
  63. %entity2char = (
  64.  # Some normal chars that have special meaning in SGML context
  65.  amp    => '&',  # ampersand 
  66. 'gt'    => '>',  # greater than
  67. 'lt'    => '<',  # less than
  68.  quot   => '"',  # double quote
  69.  
  70.  # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
  71.  AElig    => '╞',  # capital AE diphthong (ligature)
  72.  Aacute    => '┴',  # capital A, acute accent
  73.  Acirc    => '┬',  # capital A, circumflex accent
  74.  Agrave    => '└',  # capital A, grave accent
  75.  Aring    => '┼',  # capital A, ring
  76.  Atilde    => '├',  # capital A, tilde
  77.  Auml    => '─',  # capital A, dieresis or umlaut mark
  78.  Ccedil    => '╟',  # capital C, cedilla
  79.  ETH    => '╨',  # capital Eth, Icelandic
  80.  Eacute    => '╔',  # capital E, acute accent
  81.  Ecirc    => '╩',  # capital E, circumflex accent
  82.  Egrave    => '╚',  # capital E, grave accent
  83.  Euml    => '╦',  # capital E, dieresis or umlaut mark
  84.  Iacute    => '═',  # capital I, acute accent
  85.  Icirc    => '╬',  # capital I, circumflex accent
  86.  Igrave    => '╠',  # capital I, grave accent
  87.  Iuml    => '╧',  # capital I, dieresis or umlaut mark
  88.  Ntilde    => '╤',  # capital N, tilde
  89.  Oacute    => '╙',  # capital O, acute accent
  90.  Ocirc    => '╘',  # capital O, circumflex accent
  91.  Ograve    => '╥',  # capital O, grave accent
  92.  Oslash    => '╪',  # capital O, slash
  93.  Otilde    => '╒',  # capital O, tilde
  94.  Ouml    => '╓',  # capital O, dieresis or umlaut mark
  95.  THORN    => '▐',  # capital THORN, Icelandic
  96.  Uacute    => '┌',  # capital U, acute accent
  97.  Ucirc    => '█',  # capital U, circumflex accent
  98.  Ugrave    => '┘',  # capital U, grave accent
  99.  Uuml    => '▄',  # capital U, dieresis or umlaut mark
  100.  Yacute    => '▌',  # capital Y, acute accent
  101.  aacute    => 'ß',  # small a, acute accent
  102.  acirc    => 'Γ',  # small a, circumflex accent
  103.  aelig    => 'µ',  # small ae diphthong (ligature)
  104.  agrave    => 'α',  # small a, grave accent
  105.  aring    => 'σ',  # small a, ring
  106.  atilde    => 'π',  # small a, tilde
  107.  auml    => 'Σ',  # small a, dieresis or umlaut mark
  108.  ccedil    => 'τ',  # small c, cedilla
  109.  eacute    => 'Θ',  # small e, acute accent
  110.  ecirc    => 'Ω',  # small e, circumflex accent
  111.  egrave    => 'Φ',  # small e, grave accent
  112.  eth    => '≡',  # small eth, Icelandic
  113.  euml    => 'δ',  # small e, dieresis or umlaut mark
  114.  iacute    => 'φ',  # small i, acute accent
  115.  icirc    => 'ε',  # small i, circumflex accent
  116.  igrave    => '∞',  # small i, grave accent
  117.  iuml    => '∩',  # small i, dieresis or umlaut mark
  118.  ntilde    => '±',  # small n, tilde
  119.  oacute    => '≤',  # small o, acute accent
  120.  ocirc    => '⌠',  # small o, circumflex accent
  121.  ograve    => '≥',  # small o, grave accent
  122.  oslash    => '°',  # small o, slash
  123.  otilde    => '⌡',  # small o, tilde
  124.  ouml    => '÷',  # small o, dieresis or umlaut mark
  125.  szlig    => '▀',  # small sharp s, German (sz ligature)
  126.  thorn    => '■',  # small thorn, Icelandic
  127.  uacute    => '·',  # small u, acute accent
  128.  ucirc    => '√',  # small u, circumflex accent
  129.  ugrave    => '∙',  # small u, grave accent
  130.  uuml    => 'ⁿ',  # small u, dieresis or umlaut mark
  131.  yacute    => '²',  # small y, acute accent
  132.  yuml    => ' ',  # small y, dieresis or umlaut mark
  133.  
  134.  # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
  135.  copy   => '⌐',  # copyright sign
  136.  reg    => '«',  # registered sign
  137.  nbsp   => "\240", # non breaking space
  138.  
  139.  # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
  140.  iexcl  => 'í',
  141.  cent   => 'ó',
  142.  pound  => 'ú',
  143.  curren => 'ñ',
  144.  yen    => 'Ñ',
  145.  brvbar => 'ª',
  146.  sect   => 'º',
  147.  uml    => '¿',
  148.  ordf   => '¬',
  149.  laquo  => '½',
  150. 'not'   => '¼',    # not is a keyword in perl
  151.  shy    => '¡',
  152.  macr   => '»',
  153.  deg    => '░',
  154.  plusmn => '▒',
  155.  sup1   => '╣',
  156.  sup2   => '▓',
  157.  sup3   => '│',
  158.  acute  => '┤',
  159.  micro  => '╡',
  160.  para   => '╢',
  161.  middot => '╖',
  162.  cedil  => '╕',
  163.  ordm   => '║',
  164.  raquo  => '╗',
  165.  frac14 => '╝',
  166.  frac12 => '╜',
  167.  frac34 => '╛',
  168.  iquest => '┐',
  169. 'times' => '╫',    # times is a keyword in perl
  170.  divide => '≈',
  171. );
  172.  
  173. # Make the oposite mapping
  174. while (($entity, $char) = each(%entity2char)) {
  175.     $char2entity{$char} = "&$entity;";
  176. }
  177.  
  178. # Fill inn missing entities
  179. for (0 .. 255) {
  180.     next if exists $char2entity{chr($_)};
  181.     $char2entity{chr($_)} = "&#$_;";
  182. }
  183.  
  184.  
  185. sub decode_entities
  186. {
  187.     my $array;
  188.     if (defined wantarray) {
  189.     $array = [@_]; # copy
  190.     } else {
  191.     $array = \@_;  # modify in-place
  192.     }
  193.     my $c;
  194.     for (@$array) {
  195.     s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
  196.     s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
  197.     s/(&(\w+);?)/$entity2char{$2} || $1/eg;
  198.     }
  199.     wantarray ? @$array : $array->[0];
  200. }
  201.  
  202. sub encode_entities
  203. {
  204.     my $ref;
  205.     if (defined wantarray) {
  206.     my $x = $_[0];
  207.     $ref = \$x;     # copy
  208.     } else {
  209.     $ref = \$_[0];  # modify in-place
  210.     }
  211.     if (defined $_[1]) {
  212.     unless (exists $subst{$_[1]}) {
  213.         # Because we can't compile regex we fake it with a cached sub
  214.         $subst{$_[1]} =
  215.           eval "sub {\$_[0] =~ s/([$_[1]])/\$char2entity{\$1}/g; }";
  216.         die $@ if $@;
  217.     }
  218.     &{$subst{$_[1]}}($$ref);
  219.     } else {
  220.     # Encode control chars, high bit chars and '<', '&', '>', '"'
  221.     $$ref =~ s/([^\n\t !\#\$%\'-;=?-~])/$char2entity{$1}/g;
  222.     }
  223.     $$ref;
  224. }
  225.  
  226. # Set up aliases
  227. *encode = \&encode_entities;
  228. *decode = \&decode_entities;
  229.  
  230. 1;
  231.