Posted to tcl by de at Wed Apr 26 19:07:32 GMT 2017view raw

  1.  
  2. # This doesn't run. It's just an illustrating example
  3.  
  4. package require tdom
  5.  
  6. # Define the elements of your XML vocabulary as nodeCmds
  7. foreach element {
  8. CLASSIFICATION_SYSTEM
  9. CLASSIFICATION_SYSTEM_NAME
  10. CLASSIFICATION_SYSTEM_FULLNAME
  11. CLASSIFICATION_SYSTEM_VERSION
  12. CLASSIFICATION_SYSTEM_DESCR
  13. CLASSIFICATION_SYSTEM_LEVELS
  14. ...
  15. } {
  16. dom createNodeCmd elementNode $element
  17. }
  18. # A nodeCmd to generate text nodes
  19. dom createNodeCmd textNode t
  20.  
  21.  
  22. # Here an example to build an XML tree from (nested) sqlite db
  23. # queries:
  24.  
  25. set synonymQuery {
  26. SELECT pcSchlagworte.Schlagwortbezeichnung
  27. FROM pcKlassenSchlagworte_rel, pcSchlagworte
  28. WHERE Klasse_ID = $Klassen_ID
  29. AND pcSchlagworte.Schlagwort_ID
  30. = pcKlassenSchlagworte_rel.Schlagwort_ID
  31. }
  32. set featureQuery {
  33. SELECT pcMerkmale.Merkmal_ID, pcMerkmale.Datentyp, Einheit_ID,
  34. Sortiert_Nr, Mussmerkmal, KlasseMerkmal_Nr
  35. FROM pcKlassenMerkmale_rel, pcMerkmale
  36. WHERE Klasse_ID = $Klassen_ID
  37. AND pcMerkmale.Merkmal_ID = pcKlassenMerkmale_rel.Merkmal_ID
  38. }
  39. set valueQuery {
  40. SELECT Wert_ID FROM pcKlassenMerkmaleWerte_rel
  41. WHERE KlasseMerkmal_Nr = $KlasseMerkmal_Nr
  42. }
  43.  
  44. db eval {SELECT * FROM pcKlassen} {} {
  45. $classification_groups appendFromScript {
  46. CLASSIFICATION_GROUP level $Hierarchieebene {
  47. CLASSIFICATION_GROUP_ID {t $Klassen_ID}
  48. CLASSIFICATION_GROUP_NAME {t $Klassenbezeichnung}
  49. set synonyms [db eval $synonymQuery]
  50. if {[llength $synonyms] > 0} {
  51. CLASSIFICATION_GROUP_SYNONYMS {
  52. foreach synonym $synonyms {
  53. SYNONYM {t $synonym}
  54. }
  55. }
  56. }
  57. set features [db eval $featureQuery]
  58. if {[llength $features] > 0} {
  59. CLASSIFICATION_GROUP_FEATURE_TEMPLATES {
  60. foreach {Merkmal_ID Datentyp Einheit_ID Sortier_NR Mussmerkmal KlasseMerkmal_Nr} $features {
  61. CLASSIFICATION_GROUP_FEATURE_TEMPLATE {
  62. FT_IDREF {t $Merkmal_ID}
  63. switch $Mussmerkmal {
  64. "TRUE" {
  65. FT_MANDATORY {t "true"}
  66. }
  67. "FALSE" {
  68. FT_MANDATORY {t "false"}
  69. }
  70. default {
  71. puts stderr "FEATURE mit unbekanntem Mussmerkmal \
  72. '$Mussmerkmal'"
  73. FT_MANDATORY {}
  74. }
  75. }
  76. set valueIDs [db eval $valueQuery]
  77. FT_DATATYPE {
  78. switch $Datentyp {
  79. "numerisch" {
  80. t "N"
  81. }
  82. "alphanumerisch" {
  83. if {[llength $valueIDs] > 0} {
  84. t "A"
  85. } else {
  86. t "X"
  87. }
  88. }
  89. "logisch" {
  90. t "L"
  91. }
  92. default {
  93. puts stderr "Unbekannter FT_DATATYPE '$Datentyp'"
  94. t $Datentyp
  95. }
  96. }
  97. }
  98. if {$Einheit_ID ne ""} {
  99. FT_UNIT {
  100. t $Einheit_ID
  101. }
  102. }
  103. FT_ORDER {t $Sortier_NR}
  104. if {[llength $valueIDs] > 0} {
  105. FT_ALLOWED_VALUES {
  106. foreach valueID $valueIDs {
  107. ALLOWED_VALUE_IDREF {t $valueID}
  108. }
  109. }
  110. }
  111. }
  112. }
  113. }
  114. }
  115. if {$Hierarchieebene > 1} {
  116. CLASSIFICATION_GROUP_PARENT_ID {t $Parent_ID}
  117. }
  118. }
  119. }
  120. }
  121.