Posted to tcl by mjanssen at Fri Oct 30 13:43:39 GMT 2015view raw

  1. proc define {element sequence {documentation {}}} {
  2. if { [llength $sequence] == 1 &&
  3. [string range $sequence 0 3] eq "xsd:"
  4. } {
  5. emitElement $element $sequence $documentation
  6. return
  7. }
  8. set typename ${element}Type
  9. emitElement $element $typename
  10. emitTypeDef $typename $sequence $documentation
  11. }
  12.  
  13. proc extension {element baseType attributes {documentation {}}} {
  14. emit [subst {<xsd:element name="$element" type="${element}Type"/>
  15. <xsd:complexType name="${element}Type">
  16. <xsd:annotation>
  17. <xsd:documentation>$documentation</xsd:documentation>
  18. </xsd:annotation>
  19. <xsd:simpleContent>
  20. <xsd:extension base="$baseType">
  21. }]
  22. foreach attribute $attributes {
  23. lassign $attribute name doc
  24. emit [ subst { <xsd:attribute name="$name" use="optional">
  25. <xsd:annotation>
  26. <xsd:documentation>$doc</xsd:documentation>
  27. </xsd:annotation>
  28. </xsd:attribute>}]
  29.  
  30. }
  31. emit {
  32. </xsd:extension>
  33. </xsd:simpleContent>
  34. </xsd:complexType>}
  35.  
  36. }
  37.  
  38. proc text text {
  39. emit $text\n
  40. }
  41.  
  42. proc include {filename} {
  43. set f [open $filename]
  44. fconfigure $f -encoding utf-8
  45. emit \n[read $f]\n
  46. close $f
  47. }
  48.  
  49. proc emitElement {element type {documentation {}}} {
  50. if {$element eq {}} {
  51. set cardinality {}
  52. switch -- [string index $type end] {
  53. + {
  54. set type [string range $type 0 end-1 ]
  55. set cardinality {minOccurs="1" maxOccurs="unbounded"}
  56. }
  57. ? {
  58. set type [string range $type 0 end-1 ]
  59. set cardinality {minOccurs="0" maxOccurs="1"}
  60. }
  61. ! {
  62. set type [string range $type 0 end-1 ]
  63. set cardinality {minOccurs="1" maxOccurs="1"}
  64. }
  65. }
  66. emit "<xsd:element $cardinality ref=\"$type\">\n"
  67. } {
  68. emit "<xsd:element name=\"$element\" type=\"$type\">\n"
  69. }
  70. if {$documentation ne {}} {
  71. emit "<xsd:annotation>\n"
  72. emit "<xsd:documentation>$documentation</xsd:documentation>\n"
  73. emit "</xsd:annotation>\n"
  74. }
  75. emit "</xsd:element>\n"
  76. }
  77.  
  78. proc emitSequence {sequence} {
  79. emit "<xsd:sequence>\n"
  80. foreach item $sequence {
  81. emitElement {} $item
  82. }
  83. emit "</xsd:sequence>\n"
  84. }
  85.  
  86. proc emitTypeDef {type sequence documentation} {
  87. emit "<xsd:complexType name=\"$type\">\n"
  88. if {$documentation ne {}} {
  89. emit "<xsd:annotation>\n"
  90. emit "<xsd:documentation>$documentation</xsd:documentation>\n"
  91. emit "</xsd:annotation>\n"
  92. }
  93. emitSequence $sequence
  94. emit "</xsd:complexType>\n"
  95. }
  96.  
  97. proc emit text {
  98. append ::result $text
  99. }
  100.  
  101. if {$argc < 1 || $argc > 2} {
  102. puts stderr "Usage: tsd2xsd tsd-file ?xsd-file?"
  103. exit
  104. }
  105.  
  106.  
  107. set path [pwd]
  108. cd [file dirname [lindex $argv 1]]
  109.  
  110. set result ""
  111. lassign $argv tsd xsd
  112. source -encoding utf-8 $tsd
  113. package require tdom
  114. if {$xsd ne {} } {
  115. set f [open $xsd w]
  116. fconfigure $f -encoding utf-8
  117. } else {
  118. set f stdout
  119. }
  120. puts $f {<?xml version="1.0" encoding="UTF-8"?>}
  121. if {[catch {puts $f [[dom parse $result] asXML]} error]} {
  122. puts stderr $error
  123. puts $f $result
  124. }
  125. close $f
  126.  
  127. cd $path
  128.