1#!/bin/sh 2# -*- tcl -*- \ 3exec tclsh8.3 "$0" "$@" 4 5# flatten.tcl -- 6# 7# Parse a DTD, resolve all external entities, parameter 8# entities and conditional sections and save the result. 9# 10# Copyright (c) 2000 Zveno Pty Ltd 11# http://www.zveno.com/ 12# 13# Zveno makes this software and all associated data and documentation 14# ('Software') available free of charge for any purpose. 15# Copies may be made of this Software but all of this notice must be included 16# on any copy. 17# 18# The Software was developed for research purposes and Zveno does not warrant 19# that it is error free or fit for any purpose. Zveno disclaims any 20# liability for all claims, expenses, losses, damages and costs any user may 21# incur as a result of using, copying or modifying the Software. 22# 23# CVS: $Id: flatten.tcl,v 1.2 2000/05/19 23:56:20 steve Exp $ 24 25# Allow the script to work from the source directory 26set auto_path [linsert $auto_path 0 [file dirname [file dirname [file join [pwd] [info script]]]]] 27 28# We need TclXML 29package require xml 2.0 30 31# Process -- 32# 33# Parse a XML document or DTD and emit result 34# 35# Arguments: 36# data XML text 37# type "xml" or "dtd" 38# out output channel 39# args configration options 40# 41# Results: 42# Data is parsed and flattened DTD written to output channel 43 44proc Process {data type out args} { 45 global elementDeclCount PEDeclCount AttListDeclCount CommentCount 46 global config 47 set elementDeclCount [set PEDeclCount [set AttListDeclCount [set CommentCount 0]]] 48 49 # Create the parser object. 50 # We want to use the Tcl-only parser for this application, 51 # because it can resolve entities without doing full 52 # validation. 53 54 set parser [eval ::xml::parser \ 55 -elementstartcommand ElementStart \ 56 -validate 1 \ 57 $args \ 58 ] 59 60 if {$config(wantElementDecls)} { 61 $parser configure -elementdeclcommand [list ElementDeclaration $out] 62 } 63 if {$config(wantPEDecls)} { 64 $parser configure -parameterentitydeclcommand [list PEDecl $out] 65 } 66 if {$config(wantAttListDecls)} { 67 $parser configure -attlistdeclcommand [list AttListDecl $out] 68 } 69 if {$config(wantComments)} { 70 $parser configure -commentcommand [list Comment $out] 71 } 72 73 switch $type { 74 xml { 75 # Proceed with normal parsing method 76 $parser parse $data 77 } 78 79 dtd { 80 # Use the DTD parsing method instead 81 $parser parse $data -dtdsubset external 82 } 83 } 84 85 # Clean up parser object 86 #$parser free 87 #rename $parser {} 88 89 return {} 90} 91 92# ElementStart -- 93# 94# Callback for the start of an element. 95# 96# Arguments: 97# name tag name 98# attlist attribute list 99# args other information 100# 101# Results: 102# Returns break error code, since we don't 103# care about the document instance, only the DTD 104 105proc ElementStart {name attlist args} { 106 return -code break 107} 108 109# ElementDeclaration -- 110# 111# Callback for an element declaration. 112# 113# Arguments: 114# out output channel 115# name tag name 116# cmodel content model specification 117# 118# Results: 119# Writes element declaration to output channel 120 121proc ElementDeclaration {out name cmodel} { 122 global elementDeclCount 123 incr elementDeclCount 124 125 regsub -all "\[ \t\n\r\]+" $cmodel { } cmodel 126 puts $out "<!ELEMENT $name $cmodel>" 127 128 return {} 129} 130 131# PEDecl -- 132# 133# Callback for a parameter entity declaration. 134# 135# Arguments: 136# out output channel 137# name PE name 138# repl replacement text 139# 140# Results: 141# Writes info to stderr 142 143proc PEDecl {out name repl args} { 144 global PEDeclCount 145 incr PEDeclCount 146 147 if {[llength $args]} { 148 puts $out "<!ENTITY % $name PUBLIC \"[lindex $args 0]\" \"$repl\">" 149 } else { 150 puts $out "<!ENTITY % $name \"[string trim $repl]\">" 151 } 152 153 return {} 154} 155 156# AttListDecl -- 157# 158# Callback for an attribute list declaration. 159# 160# Arguments: 161# out output channel 162# name element name 163# attname attribute name 164# type attribute definition type 165# dflt default type 166# dfltval default value 167# 168# Results: 169# Writes info to stderr 170 171proc AttListDecl {out name attname type dflt dfltval} { 172 global AttListDeclCount 173 incr AttListDeclCount 174 175 puts $out "<!ATTLIST $name $attname $type $dflt $dfltval>" 176 177 return {} 178} 179 180# Comment -- 181# 182# Callback for a comment. 183# 184# Arguments: 185# out output channel 186# data comment data 187# 188# Results: 189# Writes info to stderr 190 191proc Comment {out data} { 192 global CommentCount 193 incr CommentCount 194 195 puts $out "<!--${data}-->" 196 197 return {} 198} 199 200# Open -- 201# 202# Manage opening document in GUI environment 203# 204# Arguments: 205# None 206# 207# Results: 208# XML or DTD document opened and parsed 209 210proc Open {} { 211 global currentDir status 212 213 set filename [tk_getOpenFile -parent . -title "Open Document" -initialdir $currentDir -defaultextension ".xml" -filetypes { 214 {{XML Documents} {.xml} } 215 {{DTD Files} {.dtd} } 216 {{All File} * } 217 }] 218 if {![string length $filename]} { 219 return {} 220 } 221 222 set currentDir [file dirname $filename] 223 set savename [file join [file rootname $filename].dtd] 224 set savename [tk_getSaveFile -parent . -title "Save DTD" -initialdir $currentDir -initialfile $savename -defaultextension ".dtd" -filetypes { 225 {{XML Documents} {.xml} } 226 {{DTD Files} {.dtd} } 227 {{All File} * } 228 }] 229 if {![string length $savename]} { 230 return {} 231 } 232 233 set status Processing 234 set oldcursor [. cget -cursor] 235 . configure -cursor watch 236 grab .elementDecls 237 update 238 239 set ch [open $filename] 240 set out [open $savename w] 241 if {[catch {Process [read $ch] [expr {[file extension $filename] == ".dtd" ? "dtd" : "xml"}] $out -baseurl file://[file join [pwd] $filename]} err]} { 242 243 tk_messageBox -message [format [mc {Unable to process document "%s" due to "%s"}] $filename $err] -icon error -default ok -parent . -type ok 244 } else { 245 tk_messageBox -message [mc "DTD Saved OK"] -icon info -default ok -parent . -type ok 246 } 247 248 close $ch 249 close $out 250 set status {} 251 grab release .elementDecls 252 . configure -cursor $oldcursor 253 return {} 254} 255 256### Main script 257 258# Initialize message catalog, in case it is used 259package require msgcat 260namespace import msgcat::mc 261catch {::msgcat::mcload [file join [file dirname [info script]] msgs]} 262 263# Usage: flatten.tcl file1 file2 ... 264# "-" reads input from stdin 265# No arguments - Tk means read from stdin 266# Files read from stdin assumed to be XML documents 267# When given files to read, all output goes to stdout 268# No arguments + Tk means use GUI 269 270switch [llength $argv] { 271 0 { 272 if {![catch {package require Tk}]} { 273 # Create a nice little GUI 274 array set config {wantElementDecls 1 wantPEDecls 0 wantAttlistDecls 1 wantComments 0} 275 checkbutton .wantElementDecls -variable config(wantElementDecls) 276 label .elementDeclLabel -text [mc "Element declarations:"] 277 label .elementDecls -textvariable elementDeclCount 278 checkbutton .wantPEDecls -variable config(wantPEDecls) 279 label .peDeclLabel -text [mc "PE declarations:"] 280 label .peDecls -textvariable PEDeclCount 281 checkbutton .wantAttListDecls -variable config(wantAttListDecls) 282 label .attListDeclLabel -text [mc "Atttribute List declarations:"] 283 label .attListDecls -textvariable AttListDeclCount 284 checkbutton .wantComments -variable config(wantComments) 285 label .commentLabel -text [mc "Comments:"] 286 label .comments -textvariable CommentCount 287 label .status -textvariable status -foreground red 288 grid .wantElementDecls .elementDeclLabel .elementDecls 289 grid .wantPEDecls .peDeclLabel .peDecls 290 grid .wantAttListDecls .attListDeclLabel .attListDecls 291 grid .wantComments .commentLabel .comments 292 grid .status - - 293 . configure -menu .menu 294 menu .menu -tearoff 0 295 .menu add cascade -label [mc File] -menu .menu.file 296 menu .menu.file 297 .menu.file add command -label [mc Open] -command Open 298 .menu.file add separator 299 .menu.file add command -label [mc Quit] -command exit 300 set currentDir [pwd] 301 } else { 302 Process [read stdin] xml stdout 303 } 304 } 305 default { 306 foreach filename $argv { 307 if {$filename == "-"} { 308 Process [read stdin] xml stdout 309 } else { 310 set ch [open $filename] 311 Process [read $ch] [expr {[file extension $filename] == ".dtd" ? "dtd" : "xml"}] stdout -baseurl file://[file join [pwd] $filename] 312 close $ch 313 } 314 } 315 } 316} 317