/[webpac]/openisis/current/tcl/dexml
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /openisis/current/tcl/dexml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (hide annotations)
Mon Mar 8 17:43:12 2004 UTC (18 years, 2 months ago) by dpavlin
File size: 2742 byte(s)
initial import of openisis 0.9.0 vendor drop

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     }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26