selfforum-cgi/shared/Encode/Plain.pm

   1 # Encode/Plain.pm
   2
   3 # ====================================================
   4 # Autor: n.d.p. / 2001-01-07
   5 # lm   : n.d.p. / 2001-02-25
   6 # ====================================================
   7 # Funktion:
   8 #      Codierung von non-ASCII-Zeichen fuer
   9 #      HTML
  10 # ====================================================
  11
  12 use strict;
  13
  14 package Encode::Plain;
  15
  16 require 5.6.0;
  17
  18 use vars qw(@EXPORT %sonder %unimap $utf8);
  19
  20 # ====================================================
  21 # Funktionsexport
  22 # ====================================================
  23
  24 use base qw(Exporter);
  25 @EXPORT = qw(plain multiline toUTF8);
  26
  27 ################################
  28 # sub plain
  29 #
  30 # einfache Sonderzeichen ->
  31 # Entity-Codierung
  32 ################################
  33
  34 sub plain ($;$) {
  35   my ($old,$ref)=@_;
  36   my $exreg;
  37
  38   return \'' unless (defined $old);
  39
  40   my $new=(ref ($old))?$$old:$old;;
  41   $ref=($ref or {});
  42
  43   # Ausnahmen
  44   my $except=exists($ref->{-except});
  45   if ($except) {
  46
  47     # Referenz, also Liste uebergeben -> umwandeln in Regex
  48     if (ref ($ref -> {-except})) {
  49       $exreg = join ('|',map {quotemeta $_} @{$ref -> {-except}});}
  50
  51     # keine Referenz, also Regex angegeben
  52     else {
  53       $exreg = $ref -> {-except};
  54       $exreg =~ s/\//\\\//g;}}      # LTS :-)
  55
  56   if (lc($ref->{-amp}) eq 'soft') {
  57
  58     if ($except) {
  59       $new=~s/($exreg)|(?:\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);))/(length($1))?$1:'&amp;'/eg;}
  60
  61     else {
  62       $new=~s/\&(?!(?:#[Xx][\da-fA-F]+|#\d+|[a-zA-Z]+);)/&amp;/g;}}
  63
  64   elsif (lc($ref->{-amp}) ne 'no') {
  65
  66     if ($except) {
  67       $new=~s/($exreg)|\&/(length($1))?$1:'&amp;'/eg;}
  68
  69     else {
  70       $new=~s/\&/&amp;/g;}}
  71
  72     #  Weitere Zeichen
  73   if ($except) {
  74     $new =~ s/($exreg)|</(length($1))?$1:'&lt;'/eg;     # HTML ausschalten
  75     $new =~ s/($exreg)|>/(length($1))?$1:'&gt;'/eg;
  76     $new =~ s/($exreg)|\|/(length($1))?$1:'&#124;'/eg;  # nich wahr
  77     $new =~ s/($exreg)|"/(length($1))?$1:'&quot;'/eg;   # Diese Zeile wird den Bannerklickern
  78                                                         # zu schaffen machen, sowas aber auch...
  79
  80     # Der grosse Hash
  81     if ($utf8 or $ref -> {-utf8}) {
  82       my $x;
  83       $new =~ s/($exreg)|([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/
  84                 length($1)?$1:(exists($unimap{$x = unpack('U',$2)})?$unimap{$x}:"&#$x;")/eg;}
  85
  86     $new =~ s/($exreg)|([\177-\377])/(length($1))?$1:$sonder{$2}/eg;}
  87
  88   else {
  89     $new =~ s/</&lt;/g;
  90     $new =~ s/>/&gt;/g;
  91     $new =~ s/\|/&#124;/g;
  92     $new =~ s/"/&quot;/g;
  93
  94     # Der grosse Hash
  95     if ($utf8 or $ref -> {-utf8}) {
  96       my $x;
  97       $new =~ s/([\300-\337][\200-\277]|[\340-\357][\200-\277][\200-\277])/
  98                 exists($unimap{$x = unpack('U',$1)})?$unimap{$x}:"&#$x;"/eg;}
  99
 100     $new =~ s/([\177-\377])/$sonder{$1}/g;}
 101
 102   # Zeichen <= 31
 103   $new=~s/([\001-\010\013\014\016-\037])/'&#'.ord($1).';'/eg;
 104   $new=~s/\000/ /g;
 105
 106   # Rueckgabe
 107   ref($old)?\$new:$new;
 108 }
 109
 110 ################################
 111 # sub multiline
 112 #
 113 # Whitespacecodierung
 114 # fuer Leerzeilen
 115 ################################
 116
 117 sub multiline {
 118   my $old=shift;
 119   my $string=(ref ($old))?$$old:$old;
 120
 121   # Zeilenumbrueche normalisieren
 122   $string=~s/\015\012|\015|\012/\n/g;
 123
 124   # Zeilenumbrueche in <br> umwandeln
 125   $string=~s/\n/<br>/g;
 126
 127   # mehr als ein aufeinanderfolgendes
 128   # Leerzeichen in feste Leerzeichen umwandeln
 129   $string=~s/(\s\s+)/('&nbsp;' x (length($1)-1)) . ' '/eg;
 130
 131   # Leerzeichen nach einem <br> in feste
 132   # Spaces umwandeln
 133   $string=~s/(?:^|(<br>))\s/$1&nbsp;/g;
 134
 135   # Rueckgabe
 136   \$string;
 137 }
 138
 139 sub toUTF8 ($) {
 140   my $ref = shift;
 141   my $string = ref($ref)?$$ref:$ref;
 142   no warnings 'utf8';
 143
 144   $string =~ tr/\x80-\xff//CU;
 145
 146   ref($ref)?\$string:$string;
 147 }
 148
 149 # ====================================================
 150 # Modulinitialisierung
 151 # ====================================================
 152
 153 BEGIN {
 154   $utf8 = 0;
 155
 156   # Latin 1 + geraten
 157   %sonder=("\177" => '&#127;',    # Delete-Zeichen
 158            "\200" => '&#8364;',   # Euro-Zeichen
 159            "\201" => '&uuml;',    # ue - DOS-Zeichensatz
 160            "\202" => '&#8218;',   # einfaches Anfuehrungszeichen unten
 161            "\203" => '&#402;',    # forte
 162            "\204" => '&#8222;',   # doppelte Anfuehrungszeichen unten
 163            "\205" => '&#8230;',   # drei punkte
 164            "\206" => '&#8224;',   # dagger
 165            "\207" => '&#8225;',   # Dagger
 166            "\210" => '&#710;',    # circ
 167            "\211" => '&#8240;',   # Promille
 168            "\212" => '&#352;',    # so ein S mit Haken drueber :-)
 169            "\213" => '&#8249;',   # lsaquo
 170            "\214" => '&#338;',    # OE (so verhakelt - daenisch?) wer weiss das schon
 171            "\215" => '&igrave;',  # Codepage 850;
 172            "\216" => '&#381;',    # Z mit Haken drueber (Latin Extended B)
 173            "\217" => '&Aring;',   # Codepage 850 (Win)
 174            "\220" => '&uuml;',    # ue - Mac-Zeichensatz
 175            "\221" => "'",         # einfache Anfuehrungszeichen oben
 176            "\222" => "'",         # dito
 177            "\223" => '&#8220;',   # doppelte Anfuehrungszeichen oben
 178            "\224" => '&#8220;',   # dito
 179            "\225" => '&#8226;',   # Bullet
 180            "\226" => '-',         # Bindestrich
 181            "\227" => '-',         # dito
 182            "\230" => '&#732;',    # tilde...?
 183            "\231" => '&#8482;',   # Trade-Mark
 184            "\232" => '&#353;',    # kleines s mit Haken drueber
 185            "\233" => '&#8250;',   # rsaquo;
 186            "\234" => '&#339;',    # oe verhakelt
 187            "\235" => '&#216;',    # Codepage 850 (Win)
 188            "\236" => '&#215;',    # Codepage 850 (Win)
 189            "\237" => '&#376;',    # Y mit Punkten drueber
 190            "\240" => '&nbsp;',    # nbsp;
 191            "\241" => '&#161;',    # umgedrehtes !
 192            "\242" => '&#162;',    # cent-Zeichen
 193            "\243" => '&pound;',   # (engl.)Pfund-Zeichen
 194            "\244" => '&#164;',    # Waehrungszeichen
 195            "\245" => '&yen;',     # Yen halt :-)
 196            "\246" => '&#166;',    # eigentlich soll es wohl ein | sein .-)
 197            "\247" => '&sect;',    # Paragraph
 198            "\250" => '&#168;',    # zwei Punkte oben
 199            "\251" => '&copy;',    # (C)
 200            "\252" => '&#170;',    # hochgestelltes unterstrichenes a
 201            "\253" => '&laquo;',   # left-pointing double angle quotation mark (besser koennte ichs auch nicht beschreiben...)
 202            "\254" => '&#172;',    # Negationszeichen
 203            "\255" => '-',         # Bindestrich
 204            "\256" => '&reg;',     # (R)
 205            "\257" => '&szlig;',   # sz, was auch immer fuern Zeichensatz (DOS?)
 206            "\260" => '&#176;',    # Grad-Zeichen
 207            "\261" => '&#177;',    # Plusminus
 208            "\262" => '&#178;',    # hoch 2
 209            "\263" => '&#179;',    # hoch 3
 210            "\264" => '&acute;',   # Acute
 211            "\265" => '&#181;',    # my-Zeichen (griech)
 212            "\266" => '&#182;',    # Absatzzeichen
 213            "\267" => '&#183;',    # Mal-Zeichen
 214            "\270" => '&cedil;',
 215            "\271" => '&sup1;',    # hoch 1
 216            "\272" => '&#186;',    # masculine ordinal indicator (spanish)
 217            "\273" => '&raquo;',   # right-pointing double angle quotation mark
 218            "\274" => '&#188;',    # 1/4
 219            "\275" => '&#189;',    # 1/2
 220            "\276" => '&#190;',    # 3/4
 221            "\277" => '&#191;',    # umgedrehtes ?
 222            "\300" => '&Agrave;',
 223            "\301" => '&Aacute;',
 224            "\302" => '&Acirc;',
 225            "\303" => '&Atilde;',
 226            "\304" => '&Auml;',
 227            "\305" => '&Aring;',
 228            "\306" => '&AElig;',
 229            "\307" => '&Ccedil;',
 230            "\310" => '&Egrave;',
 231            "\311" => '&Eacute;',
 232            "\312" => '&Ecirc;',
 233            "\313" => '&Euml;',
 234            "\314" => '&Igrave;',
 235            "\315" => '&Iacute;',
 236            "\316" => '&Icirc;',
 237            "\317" => '&Iuml;',
 238            "\320" => '&ETH;',     # keine Ahnung, was das wohl sein soll, auf jeden Fall was islaendisches...
 239            "\321" => '&Ntilde;',
 240            "\322" => '&Ograve;',
 241            "\323" => '&Oacute;',
 242            "\324" => '&Ocirc;',
 243            "\325" => '&Otilde;',
 244            "\326" => '&Ouml;',
 245            "\327" => '&#215;',    # eigentlich &times; funzt afaik aber nicht aufm Mac (ob das hier funktioniert, weiss ich nicht)
 246            "\330" => '&Oslash;',
 247            "\331" => '&Ugrave;',
 248            "\332" => '&Uacute;',
 249            "\333" => '&Ucirc;',
 250            "\334" => '&Uuml;',
 251            "\335" => '&Yacute;',
 252            "\336" => '&THORN;',
 253            "\337" => '&szlig;',
 254            "\340" => '&agrave;',
 255            "\341" => '&aacute;',
 256            "\342" => '&acirc;',
 257            "\343" => '&atilde;',
 258            "\344" => '&auml;',
 259            "\345" => '&aring;',
 260            "\346" => '&aelig;',
 261            "\347" => '&ccedil;',
 262            "\350" => '&egrave;',
 263            "\351" => '&eacute;',
 264            "\352" => '&ecirc;',
 265            "\353" => '&euml;',
 266            "\354" => '&igrave;',
 267            "\355" => '&iacute;',
 268            "\356" => '&icirc;',
 269            "\357" => '&iuml;',
 270            "\360" => '&eth;',
 271            "\361" => '&ntilde;',
 272            "\362" => '&ograve;',
 273            "\363" => '&oacute;',
 274            "\364" => '&ocirc;',
 275            "\365" => '&otilde;',
 276            "\366" => '&ouml;',
 277            "\367" => '&divide;',
 278            "\370" => '&oslash;',
 279            "\371" => '&ugrave;',
 280            "\372" => '&uacute;',
 281            "\373" => '&ucirc;',
 282            "\374" => '&uuml;',
 283            "\375" => '&yacute;',
 284            "\376" => '&thorn;',
 285            "\377" => '&yuml;');
 286
 287   # Unicode-Mapping
 288   %unimap=(128 => '&#8364;',
 289            129 => '&uuml;',
 290            130 => '&#8218;',
 291            131 => '&#402;',
 292            132 => '&#8222;',
 293            133 => '&#8230;',
 294            134 => '&#8224;',
 295            135 => '&#8225;',
 296            136 => '&#710;',
 297            137 => '&#8240;',
 298            138 => '&#352;',
 299            139 => '&#8249;',
 300            140 => '&#338;',
 301            141 => '&igrave;',
 302            142 => '&#381;',
 303            143 => '&Aring;',
 304            144 => '&uuml;',
 305            145 => "'",
 306            146 => "'",
 307            147 => '&#8220;',
 308            148 => '&#8220;',
 309            149 => '&#8226;',
 310            150 => '-',
 311            151 => '-',
 312            152 => '&#732;',
 313            153 => '&#8482;',
 314            154 => '&#353;',
 315            155 => '&#8250;',
 316            156 => '&#339;',
 317            157 => '&#216;',
 318            158 => '&#215;',
 319            159 => '&#376;',
 320            160 => '&nbsp;',
 321            163 => '&pound;',
 322            165 => '&yen;',
 323            167 => '&sect;',
 324            169 => '&copy;',
 325            171 => '&laquo;',
 326            173 => '-',
 327            174 => '&reg;',
 328            175 => '&szlig;',
 329            180 => '&acute;',
 330            184 => '&cedil;',
 331            185 => '&sup1;',
 332            187 => '&raquo;',
 333            192 => '&Agrave;',
 334            193 => '&Aacute;',
 335            194 => '&Acirc;',
 336            195 => '&Atilde;',
 337            196 => '&Auml;',
 338            197 => '&Aring;',
 339            198 => '&AElig;',
 340            199 => '&Ccedil;',
 341            200 => '&Egrave;',
 342            201 => '&Eacute;',
 343            202 => '&Ecirc;',
 344            203 => '&Euml;',
 345            204 => '&Igrave;',
 346            205 => '&Iacute;',
 347            206 => '&Icirc;',
 348            207 => '&Iuml;',
 349            208 => '&ETH;',
 350            209 => '&Ntilde;',
 351            210 => '&Ograve;',
 352            211 => '&Oacute;',
 353            212 => '&Ocirc;',
 354            213 => '&Otilde;',
 355            214 => '&Ouml;',
 356            216 => '&Oslash;',
 357            217 => '&Ugrave;',
 358            218 => '&Uacute;',
 359            219 => '&Ucirc;',
 360            220 => '&Uuml;',
 361            221 => '&Yacute;',
 362            222 => '&THORN;',
 363            223 => '&szlig;',
 364            224 => '&agrave;',
 365            225 => '&aacute;',
 366            226 => '&acirc;',
 367            227 => '&atilde;',
 368            228 => '&auml;',
 369            229 => '&aring;',
 370            230 => '&aelig;',
 371            231 => '&ccedil;',
 372            232 => '&egrave;',
 373            233 => '&eacute;',
 374            234 => '&ecirc;',
 375            235 => '&euml;',
 376            236 => '&igrave;',
 377            237 => '&iacute;',
 378            238 => '&icirc;',
 379            239 => '&iuml;',
 380            240 => '&eth;',
 381            241 => '&ntilde;',
 382            242 => '&ograve;',
 383            243 => '&oacute;',
 384            244 => '&ocirc;',
 385            245 => '&otilde;',
 386            246 => '&ouml;',
 387            247 => '&divide;',
 388            248 => '&oslash;',
 389            249 => '&ugrave;',
 390            250 => '&uacute;',
 391            251 => '&ucirc;',
 392            252 => '&uuml;',
 393            253 => '&yacute;',
 394            254 => '&thorn;',
 395            255 => '&yuml;');
 396 }
 397
 398 # making require happy
 399 1;
 400
 401 # ====================================================
 402 # end of Encode::Plain
 403 # ====================================================