htmlentities_decode en tcl

[CrazyCat]

Très souvent, on a besoin de décoder des entités HTML avec un script.
Voici une petite procédure qui décode les entités les plus fréquentes, avec des regsub.

Il est possible de faire une version map, mais celle-ci est déjà bien utile.

Code :

proc htmlentities_decode { text } {
    regsub -all "&lt;" $text "<" text
    regsub -all "&gt;" $text ">" text
    regsub -all "&amp;" $text "et" text
    regsub -all "&quot;" $text "" text
    regsub -all "&Aacute;" $text "Á" text
    regsub -all "&Acirc;" $text "Â" text
    regsub -all "&Agrave;" $text "À" text
    regsub -all "&Aring;" $text "Å" text
    regsub -all "&Atilde;" $text "Ã" text
    regsub -all "&Auml;" $text "Ä" text
    regsub -all "&Ccedil;" $text "Ç" text
    regsub -all "&Eacute;" $text "É" text
    regsub -all "&Ecirc;" $text "Ê" text
    regsub -all "&Egrave;" $text "È" text
    regsub -all "&Iacute;" $text "Í" text
    regsub -all "&Icirc;" $text "Î" text
    regsub -all "&Igrave;" $text "í" text
    regsub -all "&Iuml;" $text "Ï" text
    regsub -all "&Ntilde;" $text "Ñ" text
    regsub -all "&Oacute;" $text "Ó" text
    regsub -all "&Ocirc;" $text "Ô" text
    regsub -all "&Ograve;" $text "Ò" text
    regsub -all "&Oslash;" $text "Ø" text
    regsub -all "&Otilde;" $text "Õ" text
    regsub -all "&Ouml;" $text "Ö" text
    regsub -all "&Uacute;" $text "Ê" text
    regsub -all "&Ucirc;" $text "Û" text
    regsub -all "&Ugrave;" $text "Ù" text
    regsub -all "&Uuml;" $text "í" text
    regsub -all "&Yacute;" $text "Ý" text
    regsub -all "&aacute;" $text "á" text
    regsub -all "&aelig;" $text "ae" text
    regsub -all "&oelig;" $text "oe" text
    regsub -all "&agrave;" $text "à" text
    regsub -all -nocase "&#xe0;" $text "à" text
    regsub -all "&aring;" $text "å" text
    regsub -all "&atilde;" $text "ã" text
    regsub -all "&auml;" $text "ä" text
    regsub -all "&ccedil;" $text "ç" text
    regsub -all -nocase "&#xe7;" $text "ç" text
    regsub -all "&eacute;" $text "é" text
    regsub -all -nocase "&#xe9;" $text "é" text
    regsub -all "&euml;" $text "ë" text
    regsub -all "&iacute;" $text "í" text
    regsub -all "&egrave;" $text "è" text
    regsub -all -nocase "&#xe8;" $text "è" text
    regsub -all "&igrave;" $text "ì" text
    regsub -all "&iuml;" $text "ï" text
    regsub -all "&ntilde;" $text "ñ" text
    regsub -all "&oacute;" $text "ó" text
    regsub -all "&ocirc;" $text "ô" text
    regsub -all -nocase "&#xf4;" $text "ô" text
    regsub -all "&acirc;" $text "â" text
    regsub -all -nocase "&#xe2;" $text "â" text
    regsub -all "&ecirc;" $text "ê" text
    regsub -all -nocase "&#xea;" $text "ê" text
    regsub -all "&ograve;" $text "ò" text
    regsub -all "&icirc;" $text "î" text
    regsub -all "&otilde;" $text "õ" text
    regsub -all "&ouml;" $text "ö" text
    regsub -all "&uacute;" $text "ú" text
    regsub -all "&ucirc;" $text "û" text
    regsub -all -nocase "&#xfb;" $text "û" text
    regsub -all "&ugrave;" $text "ù" text
    regsub -all -nocase "&#xf9;" $text "ù" text
    regsub -all "&uuml;" $text "ü" text
    regsub -all "&yuml;" $text "ÿ" text
    regsub -all "&AElig;" $text "AE" text
    regsub -all "&OElig;" $text "OE" text
    regsub -all "&reg;" $text "®" text
    regsub -all -nocase "&#xae;" $text "®" text
    regsub -all "&copy;" $text "©" text
    regsub -all -nocase "&#xa9;" $text "©" text
    regsub -all "&trade;" $text "â„¢" text
    regsub -all "&plusmn;" $text "±" text
    regsub -all "&deg;" $text "°" text
    regsub -all "&sup1;" $text "¹" text
    regsub -all "&sup2;" $text "²" text
    regsub -all "&sup3;" $text "³" text
    regsub -all "&times;" $text "×" text
    regsub -all "&divide;" $text "÷" text
    regsub -all "&euro;" $text "euro" text
    regsub -all -nocase "&laquo;" $text "\"" text
    regsub -all -nocase "&raquo;" $text "\"" text
    return $text
}