Posted to tcl by mjanssen at Fri Oct 30 13:43:39 GMT 2015view raw
- proc define {element sequence {documentation {}}} {
- if { [llength $sequence] == 1 &&
- [string range $sequence 0 3] eq "xsd:"
- } {
- emitElement $element $sequence $documentation
- return
- }
- set typename ${element}Type
- emitElement $element $typename
- emitTypeDef $typename $sequence $documentation
- }
- proc extension {element baseType attributes {documentation {}}} {
- emit [subst {<xsd:element name="$element" type="${element}Type"/>
- <xsd:complexType name="${element}Type">
- <xsd:annotation>
- <xsd:documentation>$documentation</xsd:documentation>
- </xsd:annotation>
- <xsd:simpleContent>
- <xsd:extension base="$baseType">
- }]
- foreach attribute $attributes {
- lassign $attribute name doc
- emit [ subst { <xsd:attribute name="$name" use="optional">
- <xsd:annotation>
- <xsd:documentation>$doc</xsd:documentation>
- </xsd:annotation>
- </xsd:attribute>}]
- }
- emit {
- </xsd:extension>
- </xsd:simpleContent>
- </xsd:complexType>}
- }
- proc text text {
- emit $text\n
- }
- proc include {filename} {
- set f [open $filename]
- fconfigure $f -encoding utf-8
- emit \n[read $f]\n
- close $f
- }
- proc emitElement {element type {documentation {}}} {
- if {$element eq {}} {
- set cardinality {}
- switch -- [string index $type end] {
- + {
- set type [string range $type 0 end-1 ]
- set cardinality {minOccurs="1" maxOccurs="unbounded"}
- }
- ? {
- set type [string range $type 0 end-1 ]
- set cardinality {minOccurs="0" maxOccurs="1"}
- }
- ! {
- set type [string range $type 0 end-1 ]
- set cardinality {minOccurs="1" maxOccurs="1"}
- }
- }
- emit "<xsd:element $cardinality ref=\"$type\">\n"
- } {
- emit "<xsd:element name=\"$element\" type=\"$type\">\n"
- }
- if {$documentation ne {}} {
- emit "<xsd:annotation>\n"
- emit "<xsd:documentation>$documentation</xsd:documentation>\n"
- emit "</xsd:annotation>\n"
- }
- emit "</xsd:element>\n"
- }
- proc emitSequence {sequence} {
- emit "<xsd:sequence>\n"
- foreach item $sequence {
- emitElement {} $item
- }
- emit "</xsd:sequence>\n"
- }
- proc emitTypeDef {type sequence documentation} {
- emit "<xsd:complexType name=\"$type\">\n"
- if {$documentation ne {}} {
- emit "<xsd:annotation>\n"
- emit "<xsd:documentation>$documentation</xsd:documentation>\n"
- emit "</xsd:annotation>\n"
- }
- emitSequence $sequence
- emit "</xsd:complexType>\n"
- }
- proc emit text {
- append ::result $text
- }
- if {$argc < 1 || $argc > 2} {
- puts stderr "Usage: tsd2xsd tsd-file ?xsd-file?"
- exit
- }
- set path [pwd]
- cd [file dirname [lindex $argv 1]]
- set result ""
- lassign $argv tsd xsd
- source -encoding utf-8 $tsd
- package require tdom
- if {$xsd ne {} } {
- set f [open $xsd w]
- fconfigure $f -encoding utf-8
- } else {
- set f stdout
- }
- puts $f {<?xml version="1.0" encoding="UTF-8"?>}
- if {[catch {puts $f [[dom parse $result] asXML]} error]} {
- puts stderr $error
- puts $f $result
- }
- close $f
- cd $path