home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Perl_Libs / site_perl / HTML / Entities.pm < prev    next >
Text File  |  1997-12-02  |  7KB  |  244 lines
  1. package HTML::Entities;
  2.  
  3. # $Id: Entities.pm,v 1.11 1997/12/02 11:23:46 aas 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. =head1 DESCRIPTION
  18.  
  19. This module deals with encoding and decoding of strings with HTML
  20. character entites.  The module provide the following functions:
  21.  
  22. =over 4
  23.  
  24. =item decode_entities($string)
  25.  
  26. This routine replaces HTML entities found in the $string with the
  27. corresponding ISO-8859/1 character.  Unrecognized entities are left
  28. alone.
  29.  
  30. =item endode_entities($string, [$unsafe_chars])
  31.  
  32. This routine replaces unsafe characters in $string with their entity
  33. representation.  A second argument can be given to specify which
  34. characters to concider as unsafe.  The default set of characters to
  35. expand are control chars, high-bit chars and the '<', '&', '>' and '"'
  36. character.
  37.  
  38. =back
  39.  
  40. Both routines modify the string passed in as the first argument if
  41. called in void context.  In scalar and array context the encoded or
  42. decoded string is returned (and the argument string is left
  43. unchanged).
  44.  
  45. If you prefer not to import these routines into your namespace you can
  46. call them as:
  47.  
  48.   use HTML::Entities ();
  49.   $encoded = HTML::Entities::encode($a);
  50.   $decoded = HTML::Entities::decode($a);
  51.  
  52. The module can also export the %char2entity and the %entity2char
  53. hashes which contains the mapping from all characters to the
  54. corresponding entities.
  55.  
  56. =head1 COPYRIGHT
  57.  
  58. Copyright 1995-1997 Gisle Aas. All rights reserved.
  59.  
  60. This library is free software; you can redistribute it and/or
  61. modify it under the same terms as Perl itself.
  62.  
  63. =cut
  64.  
  65. require 5.004;
  66. require Exporter;
  67. @ISA = qw(Exporter);
  68.  
  69. @EXPORT = qw(encode_entities decode_entities);
  70. @EXPORT_OK = qw(%entity2char %char2entity);
  71.  
  72. $VERSION = sprintf("%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/);
  73. sub Version { $VERSION; }
  74.  
  75.  
  76. %entity2char = (
  77.  # Some normal chars that have special meaning in SGML context
  78.  amp    => '&',  # ampersand 
  79. 'gt'    => '>',  # greater than
  80. 'lt'    => '<',  # less than
  81.  quot   => '"',  # double quote
  82.  
  83.  # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
  84.  AElig    => 'Æ',  # capital AE diphthong (ligature)
  85.  Aacute    => 'Á',  # capital A, acute accent
  86.  Acirc    => 'Â',  # capital A, circumflex accent
  87.  Agrave    => 'À',  # capital A, grave accent
  88.  Aring    => 'Å',  # capital A, ring
  89.  Atilde    => 'Ã',  # capital A, tilde
  90.  Auml    => 'Ä',  # capital A, dieresis or umlaut mark
  91.  Ccedil    => 'Ç',  # capital C, cedilla
  92.  ETH    => 'Ð',  # capital Eth, Icelandic
  93.  Eacute    => 'É',  # capital E, acute accent
  94.  Ecirc    => 'Ê',  # capital E, circumflex accent
  95.  Egrave    => 'È',  # capital E, grave accent
  96.  Euml    => 'Ë',  # capital E, dieresis or umlaut mark
  97.  Iacute    => 'Í',  # capital I, acute accent
  98.  Icirc    => 'Î',  # capital I, circumflex accent
  99.  Igrave    => 'Ì',  # capital I, grave accent
  100.  Iuml    => 'Ï',  # capital I, dieresis or umlaut mark
  101.  Ntilde    => 'Ñ',  # capital N, tilde
  102.  Oacute    => 'Ó',  # capital O, acute accent
  103.  Ocirc    => 'Ô',  # capital O, circumflex accent
  104.  Ograve    => 'Ò',  # capital O, grave accent
  105.  Oslash    => 'Ø',  # capital O, slash
  106.  Otilde    => 'Õ',  # capital O, tilde
  107.  Ouml    => 'Ö',  # capital O, dieresis or umlaut mark
  108.  THORN    => 'Þ',  # capital THORN, Icelandic
  109.  Uacute    => 'Ú',  # capital U, acute accent
  110.  Ucirc    => 'Û',  # capital U, circumflex accent
  111.  Ugrave    => 'Ù',  # capital U, grave accent
  112.  Uuml    => 'Ü',  # capital U, dieresis or umlaut mark
  113.  Yacute    => 'Ý',  # capital Y, acute accent
  114.  aacute    => 'á',  # small a, acute accent
  115.  acirc    => 'â',  # small a, circumflex accent
  116.  aelig    => 'æ',  # small ae diphthong (ligature)
  117.  agrave    => 'à',  # small a, grave accent
  118.  aring    => 'å',  # small a, ring
  119.  atilde    => 'ã',  # small a, tilde
  120.  auml    => 'ä',  # small a, dieresis or umlaut mark
  121.  ccedil    => 'ç',  # small c, cedilla
  122.  eacute    => 'é',  # small e, acute accent
  123.  ecirc    => 'ê',  # small e, circumflex accent
  124.  egrave    => 'è',  # small e, grave accent
  125.  eth    => 'ð',  # small eth, Icelandic
  126.  euml    => 'ë',  # small e, dieresis or umlaut mark
  127.  iacute    => 'í',  # small i, acute accent
  128.  icirc    => 'î',  # small i, circumflex accent
  129.  igrave    => 'ì',  # small i, grave accent
  130.  iuml    => 'ï',  # small i, dieresis or umlaut mark
  131.  ntilde    => 'ñ',  # small n, tilde
  132.  oacute    => 'ó',  # small o, acute accent
  133.  ocirc    => 'ô',  # small o, circumflex accent
  134.  ograve    => 'ò',  # small o, grave accent
  135.  oslash    => 'ø',  # small o, slash
  136.  otilde    => 'õ',  # small o, tilde
  137.  ouml    => 'ö',  # small o, dieresis or umlaut mark
  138.  szlig    => 'ß',  # small sharp s, German (sz ligature)
  139.  thorn    => 'þ',  # small thorn, Icelandic
  140.  uacute    => 'ú',  # small u, acute accent
  141.  ucirc    => 'û',  # small u, circumflex accent
  142.  ugrave    => 'ù',  # small u, grave accent
  143.  uuml    => 'ü',  # small u, dieresis or umlaut mark
  144.  yacute    => 'ý',  # small y, acute accent
  145.  yuml    => 'ÿ',  # small y, dieresis or umlaut mark
  146.  
  147.  # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
  148.  copy   => '©',  # copyright sign
  149.  reg    => '®',  # registered sign
  150.  nbsp   => "\240", # non breaking space
  151.  
  152.  # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
  153.  iexcl  => '¡',
  154.  cent   => '¢',
  155.  pound  => '£',
  156.  curren => '¤',
  157.  yen    => '¥',
  158.  brvbar => '¦',
  159.  sect   => '§',
  160.  uml    => '¨',
  161.  ordf   => 'ª',
  162.  laquo  => '«',
  163. 'not'   => '¬',    # not is a keyword in perl
  164.  shy    => '­',
  165.  macr   => '¯',
  166.  deg    => '°',
  167.  plusmn => '±',
  168.  sup1   => '¹',
  169.  sup2   => '²',
  170.  sup3   => '³',
  171.  acute  => '´',
  172.  micro  => 'µ',
  173.  para   => '¶',
  174.  middot => '·',
  175.  cedil  => '¸',
  176.  ordm   => 'º',
  177.  raquo  => '»',
  178.  frac14 => '¼',
  179.  frac12 => '½',
  180.  frac34 => '¾',
  181.  iquest => '¿',
  182. 'times' => '×',    # times is a keyword in perl
  183.  divide => '÷',
  184. );
  185.  
  186. # Make the oposite mapping
  187. while (($entity, $char) = each(%entity2char)) {
  188.     $char2entity{$char} = "&$entity;";
  189. }
  190.  
  191. # Fill inn missing entities
  192. for (0 .. 255) {
  193.     next if exists $char2entity{chr($_)};
  194.     $char2entity{chr($_)} = "&#$_;";
  195. }
  196.  
  197.  
  198. sub decode_entities
  199. {
  200.     my $array;
  201.     if (defined wantarray) {
  202.     $array = [@_]; # copy
  203.     } else {
  204.     $array = \@_;  # modify in-place
  205.     }
  206.     my $c;
  207.     for (@$array) {
  208.     s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
  209.     s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
  210.     s/(&(\w+);?)/$entity2char{$2} || $1/eg;
  211.     }
  212.     wantarray ? @$array : $array->[0];
  213. }
  214.  
  215. sub encode_entities
  216. {
  217.     my $ref;
  218.     if (defined wantarray) {
  219.     my $x = $_[0];
  220.     $ref = \$x;     # copy
  221.     } else {
  222.     $ref = \$_[0];  # modify in-place
  223.     }
  224.     if (defined $_[1]) {
  225.     unless (exists $subst{$_[1]}) {
  226.         # Because we can't compile regex we fake it with a cached sub
  227.         $subst{$_[1]} =
  228.           eval "sub {\$_[0] =~ s/([$_[1]])/\$char2entity{\$1}/g; }";
  229.         die $@ if $@;
  230.     }
  231.     &{$subst{$_[1]}}($$ref);
  232.     } else {
  233.     # Encode control chars, high bit chars and '<', '&', '>', '"'
  234.     $$ref =~ s/([^\n\t !\#\$%\'-;=?-~])/$char2entity{$1}/g;
  235.     }
  236.     $$ref;
  237. }
  238.  
  239. # Set up aliases
  240. *encode = \&encode_entities;
  241. *decode = \&decode_entities;
  242.  
  243. 1;
  244.