home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / ixval.tcl < prev    next >
Text File  |  1996-06-05  |  9KB  |  335 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. # Copyright (c) 1995 by Westmount Technology B.V., Delft, The Netherlands.
  4. #
  5. # This software is furnished under a license and may be used only in
  6. # accordance with the terms of such license and with the inclusion of
  7. # the above copyright notice. This software or any other copies thereof
  8. # may not be provided or otherwise made available to any other person.
  9. # No title to and ownership of the software is hereby transferred.
  10. #
  11. # The information in this software is subject to change without notice
  12. # and should not be construed as a commitment by Westmount Technology B.V.
  13. #
  14. #---------------------------------------------------------------------------
  15. #
  16. #    File        : @(#)ixval.tcl    1.4
  17. #    Original date    : 26-01-1995
  18. #    Description    : 
  19. #
  20. #---------------------------------------------------------------------------
  21. #
  22. # @(#)ixval.tcl    1.4\t18 Apr 1996 Copyright 1995 Westmount Technology B.V.
  23. #
  24. #---------------------------------------------------------------------------
  25.  
  26.  
  27. # Map NewEra types to the appropriate ixValue class
  28. # Note: the types in fgl2ixval are the types as used in etc-file "db_types"
  29. #
  30. global fgl2ixval
  31. set fgl2ixval(BYTE) ixByte
  32. set fgl2ixval(CHAR) ixString
  33. set fgl2ixval(DATE) ixDate
  34. set "fgl2ixval(DATETIME YEAR TO DAY)" ixDateTime
  35. set "fgl2ixval(DATETIME HOUR TO MINUTE)" ixDateTime
  36. set "fgl2ixval(DATETIME YEAR TO FRACTION)" ixDateTime
  37. set fgl2ixval(DEC) ixDecimal
  38. set fgl2ixval(DECIMAL) ixDecimal
  39. set "fgl2ixval(DOUBLE PRECISION)" ixFloat
  40. set fgl2ixval(FLOAT) ixFloat
  41. set fgl2ixval(INT) ixInteger
  42. set fgl2ixval(INTEGER) ixInteger
  43. set "fgl2ixval(INTERVAL YEAR TO MONTH)" ixIntervalYM
  44. set "fgl2ixval(INTERVAL HOUR TO MINUTE)" ixIntervalDF
  45. set fgl2ixval(MONEY) ixMoney
  46. set fgl2ixval(NUMERIC) ixDecimal
  47. set fgl2ixval(REAL) ixSmallFloat
  48. set fgl2ixval(SERIAL) ixInteger
  49. set fgl2ixval(SMALLFLOAT) ixSmallFloat
  50. set fgl2ixval(SMALLINT) ixSmallInt
  51. set fgl2ixval(BOOLEAN) ixSmallInt
  52. set fgl2ixval(TEXT) ixText
  53. set fgl2ixval(VARCHAR) ixString
  54.  
  55. proc map_fgl2ixval {type} {
  56.     global fgl2ixval
  57.  
  58.     regsub { *\(.*} $type "" type
  59.     if [info exists fgl2ixval($type)] {
  60.         return $fgl2ixval($type)
  61.     }
  62.     return ixValue
  63. }
  64.  
  65. # Map NewEra types to the appropriate ixTypeInfo constant
  66. #
  67. global fgl2sqltype
  68. set fgl2sqltype(BYTE) 11
  69. set fgl2sqltype(CHAR) 0
  70. set fgl2sqltype(DATE) 7
  71. set "fgl2sqltype(DATETIME YEAR TO DAY)" 10
  72. set "fgl2sqltype(DATETIME HOUR TO MINUTE)" 10
  73. set "fgl2sqltype(DATETIME YEAR TO FRACTION)" 10
  74. set fgl2sqltype(DEC) 5
  75. set fgl2sqltype(DECIMAL) 5
  76. set "fgl2sqltype(DOUBLE PRECISION)" 3
  77. set fgl2sqltype(FLOAT) 3
  78. set fgl2sqltype(INT) 2
  79. set fgl2sqltype(INTEGER) 2
  80. set "fgl2sqltype(INTERVAL YEAR TO MONTH)" 14
  81. set "fgl2sqltype(INTERVAL HOUR TO MINUTE)" 14
  82. set fgl2sqltype(MONEY) 8
  83. set fgl2sqltype(NUMERIC) 5
  84. set fgl2sqltype(REAL) 4
  85. set fgl2sqltype(SERIAL) 6
  86. set fgl2sqltype(SMALLFLOAT) 4
  87. set fgl2sqltype(SMALLINT) 1
  88. set fgl2sqltype(BOOLEAN) 1
  89. set fgl2sqltype(TEXT) 12
  90. set fgl2sqltype(VARCHAR) 13
  91.  
  92. proc map_fgl2sqltype {type} {
  93.     global fgl2sqltype
  94.  
  95.     regsub { *\(.*} $type "" type
  96.     if [info exists fgl2sqltype($type)] {
  97.         return $fgl2sqltype($type)
  98.     }
  99.     return -1
  100. }
  101.  
  102. # Get the maxdatachars value for the types
  103. #
  104. global fgl2maxdatachars
  105. set fgl2maxdatachars(BYTE) 32
  106. set fgl2maxdatachars(DATE) 10
  107. set "fgl2maxdatachars(DATETIME YEAR TO DAY)" 10
  108. set "fgl2maxdatachars(DATETIME HOUR TO MINUTE)" 5
  109. set "fgl2maxdatachars(DOUBLE PRECISION)" 22
  110. set fgl2maxdatachars(FLOAT) 22
  111. set fgl2maxdatachars(INT) 11
  112. set fgl2maxdatachars(INTEGER) 11
  113. set "fgl2maxdatachars(INTERVAL YEAR TO MONTH)" 8
  114. set "fgl2maxdatachars(INTERVAL HOUR TO MINUTE)" 6
  115. set fgl2maxdatachars(REAL) 13
  116. set fgl2maxdatachars(SERIAL) 11
  117. set fgl2maxdatachars(SMALLFLOAT) 13
  118. set fgl2maxdatachars(SMALLINT) 6
  119. set fgl2maxdatachars(BOOLEAN) 6
  120. set fgl2maxdatachars(TEXT) 128
  121.  
  122. proc map_fgl2maxdatachars {type} {
  123.     global fgl2maxdatachars
  124.  
  125.     regsub { *\(.*} $type "" mod_type
  126.     if [info exists fgl2maxdatachars($mod_type)] {
  127.         return $fgl2maxdatachars($mod_type)
  128.     }
  129.  
  130.     if {[regexp {(VAR)?CHAR(\([0-9]+\))} $type dummy1 dummy2 size]} {
  131.         if {$size == ""} {
  132.             return 1
  133.         } else {
  134.             return [string trim $size " ()"]
  135.         }
  136.     }
  137.  
  138.     if {[regexp {DATETIME YEAR TO FRACTION(\([0-9]\))?} $type dummy size]} {
  139.         set size [string trim $size " ()"]
  140.         switch $size {
  141.             1 {return 21}
  142.             2 {return 22}
  143.             4 {return 24}
  144.             5 {return 25}
  145.             default    {return 23}
  146.         }
  147.     }
  148.  
  149.     if {[regexp {MONEY(\([0-9]+\))?} $type dummy precision]} {
  150.         if {$precision != ""} {
  151.             set precision [string trim $precision " ()"]
  152.         } else {
  153.             set precision 16
  154.         }
  155.         return [expr $precision + 2]
  156.     }
  157.  
  158.     if {[regexp {(DEC|DECIMAL|NUMERIC)(\([0-9]+\))?} $type dummy1\
  159.             dummy2 precision]} {
  160.         if {$precision != ""} {
  161.             set precision [string trim $precision " ()"]
  162.         } else {
  163.             set precision 16
  164.         }
  165.         return [expr $precision + 2]
  166.     }
  167.  
  168.     return 0
  169. }
  170.  
  171. # Get the enclength value for the types
  172. #
  173. global fgl2enclength
  174. set fgl2enclength(DATE) 4
  175. set "fgl2enclength(DOUBLE PRECISION)" 8
  176. set fgl2enclength(FLOAT) 8
  177. set fgl2enclength(INT) 4
  178. set fgl2enclength(INTEGER) 4
  179. set fgl2enclength(REAL) 4
  180. set fgl2enclength(SERIAL) 4
  181. set fgl2enclength(SMALLFLOAT) 4
  182. set fgl2enclength(SMALLINT) 2
  183. set fgl2enclength(BOOLEAN) 2
  184.  
  185. proc map_fgl2enclength {type} {
  186.     global fgl2enclength
  187.  
  188.     regsub { *\(.*} $type "" mod_type
  189.     if [info exists fgl2enclength($mod_type)] {
  190.         return $fgl2enclength($mod_type)
  191.     }
  192.  
  193.     if {[regexp {(VAR)?CHAR(\([0-9]+\))?} $type dummy1 dummy2 size]} {
  194.         if {$size == ""} {
  195.             return 1
  196.         } else {
  197.             return [string trim $size " ()"]
  198.         }
  199.     }
  200.  
  201.     if {[regexp {DATETIME YEAR TO FRACTION(\([0-9]\))?} $type dummy size]} {
  202.         set size [string trim $size " ()"]
  203.         switch $size {
  204.             1 {set sq 11}
  205.             2 {set sq 12}
  206.             4 {set sq 14}
  207.             5 {set sq 15}
  208.             default    {set sq 13; set size 3}
  209.         }
  210.         return [expr ((14 + $size) *256) + $sq]
  211.     }
  212.  
  213.     switch $type {
  214.         "DATETIME YEAR TO DAY" {return 2052}
  215.         "DATETIME HOUR TO MINUTE" {return 1128}
  216.         "INTERVAL YEAR TO MONTH" {return 1538}
  217.             "INTERVAL HOUR TO MINUTE" {return 1128}
  218.     }
  219.  
  220.     if {[regexp {MONEY(\([0-9]+\))?} $type dummy precision]} {
  221.         if {$precision != ""} {
  222.             set precision [string trim $precision " ()"]
  223.         } else {
  224.             set precision 16
  225.         }
  226.         return [expr ($precision * 256) + 2]
  227.     }
  228.  
  229.     if {[regexp {(DEC|DECIMAL|NUMERIC)(\([0-9]+\))?} $type dummy1\
  230.             dummy2 precision]} {
  231.         if {$precision != ""} {
  232.             set precision [string trim $precision " ()"]
  233.         } else {
  234.             set precision 16
  235.         }
  236.         return [expr $precision * 256]
  237.     }
  238.  
  239. # BYTE ?
  240. # TEXT ?
  241.  
  242.     return 0
  243. }
  244.  
  245. # Get corresponding include file name for derived ixValue class
  246. #
  247. global ixval2inc
  248. set ixval2inc(ixByte) ixbyte
  249. set ixval2inc(ixText) ixtext
  250. set ixval2inc(ixDate) ixdate
  251. set ixval2inc(ixDateTime) ixdate
  252. set ixval2inc(ixInterValDF) ixdate
  253. set ixval2inc(ixInterValYM) ixdate
  254. set ixval2inc(ixDecimal) ixnum
  255. set ixval2inc(ixFloat) ixnum
  256. set ixval2inc(ixInteger) ixnum
  257. set ixval2inc(ixMoney) ixnum
  258. set ixval2inc(ixSmallFloat) ixnum
  259. set ixval2inc(ixSmallInt) ixnum
  260. set ixval2inc(ixString) ixstring
  261.  
  262. proc ixval2hdr {type} {
  263.     global ixval2inc
  264.     if [info exists ixval2inc($type)] {
  265.         return $ixval2inc($type)
  266.     }
  267.     return ixvalue
  268. }
  269.  
  270. # Get constructor call for derived ixValue class
  271. #
  272. global newixval
  273. set newixval(ixByte) ixByte(locInTempFile)
  274. set newixval(ixText) ixText(locInTempFile)
  275.  
  276. proc newixvalue {type {val ""}} {
  277.     global newixval
  278.     if [info exists newixval($type)] {
  279.         eval return $newixval($type)
  280.     } else {
  281.         eval return ${type}(\$val)
  282.     }
  283. }
  284.  
  285.  
  286. # Get simple data type value of derived ixValue class
  287. #
  288. global gixvalvalue
  289. set gixvalvalue(ixString) "\${ixvalvar}.getValueStr()"
  290.  
  291. proc getixvalvalue {type ixvalvar} {
  292.     global gixvalvalue
  293.     if [info exists gixvalvalue($type)] {
  294.         eval return $gixvalvalue($type)
  295.     } else {
  296.         eval return ${ixvalvar}.value
  297.     }
  298. }
  299.  
  300.  
  301. # Set simple data type value of derived ixValue class
  302. #
  303. global sixvalvalue
  304. set sixvalvalue(ixString) "CALL \${ixvalvar}.setValueStr(\$newval)"
  305. set sixvalvalue(ixByte) "-- Not implemented"
  306. set sixvalvalue(ixText) "-- Not implemented"
  307.  
  308. proc setixvalvalue {type ixvalvar newval} {
  309.     global sixvalvalue
  310.     if [info exists sixvalvalue($type)] {
  311.         eval return \"$sixvalvalue($type)\"
  312.     } else {
  313.         eval return \"LET ${ixvalvar}.value = $newval\"
  314.     }
  315. }
  316.  
  317.  
  318. # Generate a "ixval type declaration" for the type
  319. #
  320. proc generate_ixval {type decl} {
  321.     if {[$type get_obj_type] != "base_type"} {
  322.         return [generate $type $decl]
  323.     }
  324.     set name [$type getType3GL]
  325.     set ixvalname [map_fgl2ixval $name]
  326.     set ixvalincname [ixval2hdr $ixvalname]
  327.     if {$decl == "fwd"} {
  328.         add_forward_name $ixvalname
  329.         add_src_inc_name $ixvalincname
  330.     } else {
  331.         add_hdr_inc_name $ixvalincname
  332.     }
  333.     return $ixvalname
  334. }
  335.