#!/usr/local/bin/tclsh # # Copyright (c): Uwe Schmidt, FH Wedel # # You may study, modify and distribute this source code # FOR NON-COMMERCIAL PURPOSES ONLY. # This copyright message has to remain unchanged. # # Note that this document is provided 'as is', # WITHOUT WARRANTY of any kind either expressed or implied. #!/bin/sh # the next line restarts using tclsh (anywhere in search path) \ exec tclsh "$0" "$@" #-------------------------------------------------------------------------------- # $Id: htmlparse.cgi,v 1.8 2006-12-30 15:49:55 uwe Exp $ # parseHTML macht aus einem HTML text ein Tcl-Skript proc parseHTML text { puts stderr "\nparseHTML: Original Text\n$text" # Tcl Sonderzeichen {, }, [, ], und \ mit # \ vor Interpretation schuetzen regsub -all {[][{}\\]} $text {\\&} text # Aufbau der Grammatik (regulaeren Ausdruecke fuer HTML tags) set whiteSpace "\[ \n\t\r\]" set whiteSpaces "${whiteSpace}*" set whiteSpaces1 "${whiteSpace}+" set name {[a-zA-Z][-_:a-zA-Z0-9]*} set tagName "/?$name" set attrName $name set value1 '\[^'\]*' set value2 \"\[^\"\]*\" set value3 "\[^ \n\r\t>\]*" set value "($value1|$value2|$value3)" set attrValue "${whiteSpaces1}${attrName}=${value}" set attrList "($attrValue)*" set htmlTag "<($tagName)($attrList)${whiteSpaces}>" puts stderr "\nparseHTML: der regulaere Ausdruck fuer tags\n$htmlTag" set subst "\}\ntransHTMLtag {\\1} {\\2} \{" puts stderr "\nparseHTML: der Ersetzungstext fuer die tags\n$subst" regsub -all $htmlTag $text $subst text puts stderr "\nparseHTML: der editierte text\n$text" set text "transHTMLtag {} {} \{$text\}" puts stderr "\nparseHTML: das Resultat\n$text" return $text } #-------------------------------------------------------------------------------- # die Verteilerfunktion proc transHTMLtag {tag attr text} { global result # Gross- und Kleinbuchstaben nicht signifikant set tag [string tolower $tag] # zusaetzlich eingefuegte \ aus text und attr loeschen set attr [subst -novariables -nocommands $attr] set text [subst -novariables -nocommands $text] set prcname transTag_$tag if {"[info procs $prcname]" == "$prcname"} { # es gibt eine Uebersetzungsfunktion fuer den tag append result [$prcname $attr] } else { # keine eigene Funktion, also nur kopieren append result "<${tag}${attr}>" } # den auf den tag folgenden Text kopieren append result $text } #-------------------------------------------------------------------------------- # die Hauptfunktion proc transHTMLtext text { global result set result "" eval [parseHTML $text] return $result } #-------------------------------------------------------------------------------- proc transTag_body attr { # immer schwarzer Hintergrund return {
} } #-------------------------------------------------------------------------------- # ein eigener tag fuer rote Schrift proc transTag_red attr { return {