1 |
dpavlin |
237 |
#!/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 |
|
|
} |