git.rot13.org Git - webpac/blob - openisis/tcl/dexml

   1 #!/opt/isis/OpenIsis/tcl/bin/isish
   2 # let editor know it's Tcl vim:syntax=tcl
   3
   4 package require openIsis;
   5 package require xml;
   6
   7
   8 # map element names to tags
   9 array set tag {}
  10 # highest ag used; set to 99 so we start from 100
  11 set ltag 99
  12 # map attribute names to subfields
  13 # map keys are "tag\tatt"
  14 array set subf {}
  15
  16 openIsisRec rec
  17
  18 proc cdata {data} { # text
  19         # puts "0\t[string map {\n " "} $data]"
  20         rec add 0 [string map {\n " "} $data]
  21 }
  22
  23 proc comment {data} {
  24         # puts "#\t[string map {\n " "} $data]"
  25 }
  26
  27 proc doctype {data} {
  28         puts "#\t$data"
  29 }
  30
  31 proc estart {name attlist args} {
  32         global tag ltag subf lsubf
  33         set start +
  34         foreach {arg val} $args {
  35                 switch -- $arg -empty { if $val { set start - } }
  36         }
  37         if [catch {set t $tag($name)}] {
  38                 set t [set tag($name) [incr ltag]]
  39         }
  40         set line $start
  41         foreach {att val} $attlist {
  42                 set attkey "$t\t$att"
  43                 if [catch {set s $subf($attkey)}] {
  44                         # use $subf($t) as counter for last subfield
  45                         if [catch {set c [incr subf($t)]}] {
  46                                 set c [set subf($t) 97]
  47                         }
  48                         set s [set subf($attkey) [format %c $c]]
  49                 }
  50                 append line "^$s$val"
  51         }
  52         # puts "$t\t$line"
  53         rec add $t $line
  54 }
  55
  56 proc eend {name args} {
  57         global tag
  58         foreach {arg val} $args {
  59                 switch -- $arg -empty { if $val { return } }
  60         }
  61         # puts $tag($name)
  62         rec add $tag($name) ""
  63 }
  64
  65 set xp [xml::parser \
  66         -ignorewhitespace yes \
  67         -reportempty yes \
  68         -characterdatacommand cdata \
  69         -commentcommand comment \
  70         -doctypecommand doctype \
  71         -elementstartcommand estart \
  72         -elementendcommand eend \
  73         -defaultcommand error
  74 ]
  75 # doesn't like that:
  76 # -endcdatasectioncommand ecdata
  77 #       -startcdatasectioncommand scdata
  78
  79 $xp parse [read stdin]
  80
  81
  82 # invert the FDT tag,subf to name,attr
  83 foreach {n v} [array get tag] { set name($v) $n}
  84 foreach {n v} [array get subf] {
  85         if {2 == [scan $n "%u\t%s" t a]} { set attr($t\t$v) $a }
  86 }
  87
  88 foreach t [lsort [array names name]] {
  89         # puts stderr "$t\t$name($t)" ;# verbose entry
  90         set line $name($t)
  91         foreach s [lsort [array names attr "$t\t*"]] {
  92                 # puts stderr "$s\t$attr($s)" ;# verbose entry
  93                 scan $s "%u\t%s" - c
  94                 append line "^$c$attr($s)"
  95         }
  96         puts stderr "$t\t$line" ;# the one-line DTD ;)
  97 }
  98
  99 # use the inverted FDT to create the XML text
 100 puts "<!--
 101 [rec serialize]
 102 -->"
 103 set depth 0
 104 rec do t v {
 105         if !$t { # text
 106                 puts [string repeat \t $depth]$v
 107                 continue
 108         }
 109         if {"" == $v} { # close
 110                 incr depth -1
 111                 puts [string repeat \t $depth]</$name($t)>
 112                 continue
 113         }
 114         set line "<$name($t)"
 115         set alist [split $v ^]
 116         set hasChilds [expr {"+" == [lindex $alist 0]}]
 117         foreach a [lrange $alist 1 end] {
 118                 append line " $attr($t\t[string index $a 0])=\"[string range $a 1 end]\""
 119         }
 120         if $hasChilds {
 121                 append line >
 122         } else {
 123                 append line />
 124         }
 125         puts [string repeat \t $depth]$line
 126         if $hasChilds {
 127                 incr depth
 128         }
 129 }