X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=openisis%2Ftcl%2Fdexml;fp=openisis%2Ftcl%2Fdexml;h=884d0c188450f9d74e61f1350a967eb75ac75726;hb=8452b5012d7d1f313adff872608a959f159be261;hp=0000000000000000000000000000000000000000;hpb=25058d2b4ed0a3c65881b1fc26866da28e097e38;p=webpac

diff --git a/openisis/tcl/dexml b/openisis/tcl/dexml
new file mode 100755
index 0000000..884d0c1
--- /dev/null
+++ b/openisis/tcl/dexml
@@ -0,0 +1,129 @@
+#!/opt/isis/OpenIsis/tcl/bin/isish
+# let editor know it's Tcl vim:syntax=tcl
+
+package require openIsis;
+package require xml;
+
+
+# map element names to tags
+array set tag {}
+# highest ag used; set to 99 so we start from 100
+set ltag 99
+# map attribute names to subfields
+# map keys are "tag\tatt"
+array set subf {}
+
+openIsisRec rec
+
+proc cdata {data} { # text
+	# puts "0\t[string map {\n " "} $data]"
+	rec add 0 [string map {\n " "} $data]
+}
+
+proc comment {data} {
+	# puts "#\t[string map {\n " "} $data]"
+}
+
+proc doctype {data} {
+	puts "#\t$data"
+}
+
+proc estart {name attlist args} {
+	global tag ltag subf lsubf
+	set start +
+	foreach {arg val} $args {
+		switch -- $arg -empty { if $val { set start - } }
+	}
+	if [catch {set t $tag($name)}] {
+		set t [set tag($name) [incr ltag]]
+	}
+	set line $start
+	foreach {att val} $attlist {
+		set attkey "$t\t$att"
+		if [catch {set s $subf($attkey)}] {
+			# use $subf($t) as counter for last subfield
+			if [catch {set c [incr subf($t)]}] {
+				set c [set subf($t) 97]
+			}
+			set s [set subf($attkey) [format %c $c]]
+		}
+		append line "^$s$val"
+	}
+	# puts "$t\t$line"
+	rec add $t $line
+}
+
+proc eend {name args} {
+	global tag
+	foreach {arg val} $args {
+		switch -- $arg -empty { if $val { return } }
+	}
+	# puts $tag($name)
+	rec add $tag($name) ""
+}
+
+set xp [xml::parser \
+	-ignorewhitespace yes \
+	-reportempty yes \
+	-characterdatacommand cdata \
+	-commentcommand comment \
+	-doctypecommand doctype \
+	-elementstartcommand estart \
+	-elementendcommand eend \
+	-defaultcommand error
+]
+# doesn't like that:
+# -endcdatasectioncommand ecdata
+#	-startcdatasectioncommand scdata
+
+$xp parse [read stdin]
+
+
+# invert the FDT tag,subf to name,attr
+foreach {n v} [array get tag] { set name($v) $n}
+foreach {n v} [array get subf] {
+	if {2 == [scan $n "%u\t%s" t a]} { set attr($t\t$v) $a }
+}
+
+foreach t [lsort [array names name]] {
+	# puts stderr "$t\t$name($t)" ;# verbose entry
+	set line $name($t)
+	foreach s [lsort [array names attr "$t\t*"]] {
+		# puts stderr "$s\t$attr($s)" ;# verbose entry
+		scan $s "%u\t%s" - c
+		append line "^$c$attr($s)"
+	}
+	puts stderr "$t\t$line" ;# the one-line DTD ;)
+}
+
+# use the inverted FDT to create the XML text
+puts "<!--
+[rec serialize]
+-->"
+set depth 0
+rec do t v {
+	if !$t { # text
+		puts [string repeat \t $depth]$v
+		continue
+	}
+	if {"" == $v} { # close
+		incr depth -1
+		puts [string repeat \t $depth]</$name($t)>
+		continue
+	}
+	set line "<$name($t)"
+	set alist [split $v ^]
+	set hasChilds [expr {"+" == [lindex $alist 0]}]
+	foreach a [lrange $alist 1 end] {
+		append line " $attr($t\t[string index $a 0])=\"[string range $a 1 end]\""
+	}
+	if $hasChilds {
+		append line >
+	} else {
+		append line />
+	}
+	puts [string repeat \t $depth]$line
+	if $hasChilds {
+		incr depth
+	}
+}