home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _3a4285731636b90d00b588cf1d3137fb < prev    next >
Text File  |  2000-03-15  |  7KB  |  250 lines
  1. package HTML::Entities;
  2.  
  3. # $Id: Entities.pm,v 1.13 1998/03/26 21:19:05 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-1998 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. use strict;
  66. use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  67. use vars qw(%entity2char %char2entity);
  68.  
  69. require 5.004;
  70. require Exporter;
  71. @ISA = qw(Exporter);
  72.  
  73. @EXPORT = qw(encode_entities decode_entities);
  74. @EXPORT_OK = qw(%entity2char %char2entity);
  75.  
  76. $VERSION = sprintf("%d.%02d", q$Revision: 1.13 $ =~ /(\d+)\.(\d+)/);
  77. sub Version { $VERSION; }
  78.  
  79.  
  80. %entity2char = (
  81.  # Some normal chars that have special meaning in SGML context
  82.  amp    => '&',  # ampersand 
  83. 'gt'    => '>',  # greater than
  84. 'lt'    => '<',  # less than
  85.  quot   => '"',  # double quote
  86.  
  87.  # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
  88.  AElig    => '╞',  # capital AE diphthong (ligature)
  89.  Aacute    => '┴',  # capital A, acute accent
  90.  Acirc    => '┬',  # capital A, circumflex accent
  91.  Agrave    => '└',  # capital A, grave accent
  92.  Aring    => '┼',  # capital A, ring
  93.  Atilde    => '├',  # capital A, tilde
  94.  Auml    => '─',  # capital A, dieresis or umlaut mark
  95.  Ccedil    => '╟',  # capital C, cedilla
  96.  ETH    => '╨',  # capital Eth, Icelandic
  97.  Eacute    => '╔',  # capital E, acute accent
  98.  Ecirc    => '╩',  # capital E, circumflex accent
  99.  Egrave    => '╚',  # capital E, grave accent
  100.  Euml    => '╦',  # capital E, dieresis or umlaut mark
  101.  Iacute    => '═',  # capital I, acute accent
  102.  Icirc    => '╬',  # capital I, circumflex accent
  103.  Igrave    => '╠',  # capital I, grave accent
  104.  Iuml    => '╧',  # capital I, dieresis or umlaut mark
  105.  Ntilde    => '╤',  # capital N, tilde
  106.  Oacute    => '╙',  # capital O, acute accent
  107.  Ocirc    => '╘',  # capital O, circumflex accent
  108.  Ograve    => '╥',  # capital O, grave accent
  109.  Oslash    => '╪',  # capital O, slash
  110.  Otilde    => '╒',  # capital O, tilde
  111.  Ouml    => '╓',  # capital O, dieresis or umlaut mark
  112.  THORN    => '▐',  # capital THORN, Icelandic
  113.  Uacute    => '┌',  # capital U, acute accent
  114.  Ucirc    => '█',  # capital U, circumflex accent
  115.  Ugrave    => '┘',  # capital U, grave accent
  116.  Uuml    => '▄',  # capital U, dieresis or umlaut mark
  117.  Yacute    => '▌',  # capital Y, acute accent
  118.  aacute    => 'ß',  # small a, acute accent
  119.  acirc    => 'Γ',  # small a, circumflex accent
  120.  aelig    => 'µ',  # small ae diphthong (ligature)
  121.  agrave    => 'α',  # small a, grave accent
  122.  aring    => 'σ',  # small a, ring
  123.  atilde    => 'π',  # small a, tilde
  124.  auml    => 'Σ',  # small a, dieresis or umlaut mark
  125.  ccedil    => 'τ',  # small c, cedilla
  126.  eacute    => 'Θ',  # small e, acute accent
  127.  ecirc    => 'Ω',  # small e, circumflex accent
  128.  egrave    => 'Φ',  # small e, grave accent
  129.  eth    => '≡',  # small eth, Icelandic
  130.  euml    => 'δ',  # small e, dieresis or umlaut mark
  131.  iacute    => 'φ',  # small i, acute accent
  132.  icirc    => 'ε',  # small i, circumflex accent
  133.  igrave    => '∞',  # small i, grave accent
  134.  iuml    => '∩',  # small i, dieresis or umlaut mark
  135.  ntilde    => '±',  # small n, tilde
  136.  oacute    => '≤',  # small o, acute accent
  137.  ocirc    => '⌠',  # small o, circumflex accent
  138.  ograve    => '≥',  # small o, grave accent
  139.  oslash    => '°',  # small o, slash
  140.  otilde    => '⌡',  # small o, tilde
  141.  ouml    => '÷',  # small o, dieresis or umlaut mark
  142.  szlig    => '▀',  # small sharp s, German (sz ligature)
  143.  thorn    => '■',  # small thorn, Icelandic
  144.  uacute    => '·',  # small u, acute accent
  145.  ucirc    => '√',  # small u, circumflex accent
  146.  ugrave    => '∙',  # small u, grave accent
  147.  uuml    => 'ⁿ',  # small u, dieresis or umlaut mark
  148.  yacute    => '²',  # small y, acute accent
  149.  yuml    => ' ',  # small y, dieresis or umlaut mark
  150.  
  151.  # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
  152.  copy   => '⌐',  # copyright sign
  153.  reg    => '«',  # registered sign
  154.  nbsp   => "\240", # non breaking space
  155.  
  156.  # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
  157.  iexcl  => 'í',
  158.  cent   => 'ó',
  159.  pound  => 'ú',
  160.  curren => 'ñ',
  161.  yen    => 'Ñ',
  162.  brvbar => 'ª',
  163.  sect   => 'º',
  164.  uml    => '¿',
  165.  ordf   => '¬',
  166.  laquo  => '½',
  167. 'not'   => '¼',    # not is a keyword in perl
  168.  shy    => '¡',
  169.  macr   => '»',
  170.  deg    => '░',
  171.  plusmn => '▒',
  172.  sup1   => '╣',
  173.  sup2   => '▓',
  174.  sup3   => '│',
  175.  acute  => '┤',
  176.  micro  => '╡',
  177.  para   => '╢',
  178.  middot => '╖',
  179.  cedil  => '╕',
  180.  ordm   => '║',
  181.  raquo  => '╗',
  182.  frac14 => '╝',
  183.  frac12 => '╜',
  184.  frac34 => '╛',
  185.  iquest => '┐',
  186. 'times' => '╫',    # times is a keyword in perl
  187.  divide => '≈',
  188. );
  189.  
  190. # Make the oposite mapping
  191. while (my($entity, $char) = each(%entity2char)) {
  192.     $char2entity{$char} = "&$entity;";
  193. }
  194.  
  195. # Fill inn missing entities
  196. for (0 .. 255) {
  197.     next if exists $char2entity{chr($_)};
  198.     $char2entity{chr($_)} = "&#$_;";
  199. }
  200.  
  201. my %subst;  # compiled encoding regexps
  202.  
  203.  
  204. sub decode_entities
  205. {
  206.     my $array;
  207.     if (defined wantarray) {
  208.     $array = [@_]; # copy
  209.     } else {
  210.     $array = \@_;  # modify in-place
  211.     }
  212.     my $c;
  213.     for (@$array) {
  214.     s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
  215.     s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
  216.     s/(&(\w+);?)/$entity2char{$2} || $1/eg;
  217.     }
  218.     wantarray ? @$array : $array->[0];
  219. }
  220.  
  221. sub encode_entities
  222. {
  223.     my $ref;
  224.     if (defined wantarray) {
  225.     my $x = $_[0];
  226.     $ref = \$x;     # copy
  227.     } else {
  228.     $ref = \$_[0];  # modify in-place
  229.     }
  230.     if (defined $_[1]) {
  231.     unless (exists $subst{$_[1]}) {
  232.         # Because we can't compile regex we fake it with a cached sub
  233.         $subst{$_[1]} =
  234.           eval "sub {\$_[0] =~ s/([$_[1]])/\$char2entity{\$1}/g; }";
  235.         die $@ if $@;
  236.     }
  237.     &{$subst{$_[1]}}($$ref);
  238.     } else {
  239.     # Encode control chars, high bit chars and '<', '&', '>', '"'
  240.     $$ref =~ s/([^\n\t !\#\$%\'-;=?-~])/$char2entity{$1}/g;
  241.     }
  242.     $$ref;
  243. }
  244.  
  245. # Set up aliases
  246. *encode = \&encode_entities;
  247. *decode = \&decode_entities;
  248.  
  249. 1;
  250.