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