Check-in [394de07dfb]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:forgot to save changes to Utilities.tcl!
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 394de07dfbd76064f498bbeb77b384a54085f0de
User & Date: gerald 2013-04-09 15:54:05
Context
2013-04-09 20:24
Generalization of attributes defined in "http://www.w3.org/2001/XMLSchema-instance", aka "type" and "nil" in particular. Also added support for ::value instead of {} for value of tag. check-in: cfdc32b392 user: gerald tags: trunk
2013-04-09 15:54
forgot to save changes to Utilities.tcl! check-in: 394de07dfb user: gerald tags: trunk
2013-04-09 15:50
Fixes for incorrect error signalling and to add automatic type casting of abstract to real types. check-in: cecf30f810 user: gerald tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to Utilities.tcl.

1304
1305
1306
1307
1308
1309
1310





1311
1312
1313
1314
1315
1316
1317
....
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
....
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
....
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
....
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
....
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
....
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
....
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
....
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
....
1881
1882
1883
1884
1885
1886
1887





1888
1889
1890
1891
1892
1893
1894
....
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
....
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
....
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
....
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
#
###########################################################################
proc ::WS::Utils::convertTypeToDict {mode serviceName node type root {isArray 0}} {
    variable typeInfo
    variable mutableTypeInfo
    variable options






    ::log::log debug [list ::WS::Utils::convertTypeToDict $mode $serviceName $node $type $root $isArray]
    if {[dict exists $typeInfo $mode $serviceName $type]} {
        set typeName $type
    } else {
        set typeName $serviceName:$type
    }
    set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
................................................................................
                ##
                if {$options(parseInAttr)} {
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName $options(valueAttr) [$item asText]
                } else {
                    dict set results $partName [$item asText]
                }
            }
            {0 1} {
                ##
                ## Simple array
................................................................................
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList $options(valueAttr) [$row asText]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [$row asText]
                    }
                }
                dict set results $partName $tmp
            }
................................................................................
                        $item removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                    }
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName $options(valueAttr) [convertTypeToDict $mode $serviceName $item $partType $root]
                } else {
                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root]
                }
            }
            {1 1} {
                ##
                ## Non-simple array
................................................................................
                            $row removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                        }
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList $options(valueAttr) [convertTypeToDict $mode $serviceName $row $partType $root 1]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1]
                    }
                }
                dict set results $partName $tmp
            }
................................................................................
                    $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                }
                if {$options(genOutAttr)} {
                    set resultValue {}
                    set dictList [dict keys [dict get $dict $useName]]
                    #::log::log debug "$useName <$dict> '$dictList'"
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {![string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        ::log::log debug "<$row> '$dictList'"
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {![string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
                    #::log::log debug "$useName <$dict> '$dictList'"
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                            set itemType $itemXns:$itemType
                        } elseif {![string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                        set resultValue {}
                        #::log::log debug "<$row> '$dictList'"
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
                                set tmpType $itemXns:$tmpType
                            } elseif {![string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable options






    set typeInfoList [TypeInfo $mode $service $type]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        set xns $simpleTypes($mode,$service,$type)
        set itemList [list $type {type string}]
................................................................................
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {[string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                set dataList [dict get $dict $itemName]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retNode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {[string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                        } elseif {[string equal $attr $options(valueAttr)]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
                            } elseif {[string equal $attr $options(valueAttr)]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row






>
>
>
>
>







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







>
>
>
>
>







 







|







 







|







 







|







 







|







1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
....
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
....
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
....
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
....
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
....
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
....
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
....
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
....
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
....
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
....
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
....
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
....
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
....
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
#
###########################################################################
proc ::WS::Utils::convertTypeToDict {mode serviceName node type root {isArray 0}} {
    variable typeInfo
    variable mutableTypeInfo
    variable options

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    ::log::log debug [list ::WS::Utils::convertTypeToDict $mode $serviceName $node $type $root $isArray]
    if {[dict exists $typeInfo $mode $serviceName $type]} {
        set typeName $type
    } else {
        set typeName $serviceName:$type
    }
    set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
................................................................................
                ##
                if {$options(parseInAttr)} {
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName $valueAttr [$item asText]
                } else {
                    dict set results $partName [$item asText]
                }
            }
            {0 1} {
                ##
                ## Simple array
................................................................................
                    if {$options(parseInAttr)} {
                        set rowList {}
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList $valueAttr [$row asText]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [$row asText]
                    }
                }
                dict set results $partName $tmp
            }
................................................................................
                        $item removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                    }
                    foreach attr [$item attributes] {
                        if {[llength $attr] == 1} {
                            dict set results $partName $attr [$item getAttribute $attr]
                        }
                    }
                    dict set results $partName $valueAttr [convertTypeToDict $mode $serviceName $item $partType $root]
                } else {
                    dict set results $partName [convertTypeToDict $mode $serviceName $item $partType $root]
                }
            }
            {1 1} {
                ##
                ## Non-simple array
................................................................................
                            $row removeAttributeNS {http://www.w3.org/2001/XMLSchema-instance} type
                        }
                        foreach attr [$row attributes] {
                            if {[llength $attr] == 1} {
                                lappend rowList $attr [$row getAttribute $attr]
                            }
                        }
                        lappend rowList $valueAttr [convertTypeToDict $mode $serviceName $row $partType $root 1]
                        lappend tmp $rowList
                    } else {
                        lappend tmp [convertTypeToDict $mode $serviceName $row $partType $root 1]
                    }
                }
                dict set results $partName $tmp
            }
................................................................................
                    $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                }
                if {$options(genOutAttr)} {
                    set resultValue {}
                    set dictList [dict keys [dict get $dict $useName]]
                    #::log::log debug "$useName <$dict> '$dictList'"
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {![string equal $attr $valueAttr]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                        $parent appendChild [$doc createElement $itemXns:$itemName retNode]
                    }
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        ::log::log debug "<$row> '$dictList'"
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {![string equal $attr $valueAttr]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
                    #::log::log debug "$useName <$dict> '$dictList'"
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                            set itemType $itemXns:$itemType
                        } elseif {![string equal $attr $valueAttr]} {
                            lappend attrList $attr [dict get $dict $useName $attr]
                        } else {
                            set resultValue [dict get $dict $useName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $useName]
................................................................................
                        set resultValue {}
                        #::log::log debug "<$row> '$dictList'"
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
                                set tmpType $itemXns:$tmpType
                            } elseif {![string equal $attr $valueAttr]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} {
    ::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
    variable typeInfo
    variable simpleTypes
    variable options

    if {$options(valueAttrCompatiblityMode)} {
        set valueAttr {}
    } else {
        set valueAttr {::value}
    }
    set typeInfoList [TypeInfo $mode $service $type]
    if {[lindex $typeInfoList 0]} {
        set itemList [dict get $typeInfo $mode $service $type definition]
        set xns [dict get $typeInfo $mode $service $type xns]
    } else {
        set xns $simpleTypes($mode,$service,$type)
        set itemList [list $type {type string}]
................................................................................
                ## Simple non-array
                ##
                $parent appendChild [$doc createElement $itemName retNode]
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {[string equal $attr $valueAttr]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                set dataList [dict get $dict $itemName]
                foreach row $dataList {
                    $parent appendChild [$doc createElement $itemName retNode]
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {[string equal $attr $valueAttr]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row
................................................................................
                if {$options(genOutAttr)} {
                    set dictList [dict keys [dict get $dict $itemName]]
                    set resultValue {}
                    foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                        if {$isAbstract && [string equal $attr {::type}]} {
                            set itemType [dict get $dict $useName $attr]
                            $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $itemType
                        } elseif {[string equal $attr $valueAttr]} {
                            lappend attrList $attr [dict get $dict $itemName $attr]
                        } else {
                            set resultValue [dict get $dict $itemName $attr]
                        }
                    }
                } else {
                    set resultValue [dict get $dict $itemName]
................................................................................
                    if {$options(genOutAttr)} {
                        set dictList [dict keys $row]
                        set resultValue {}
                        foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
                            if {$isAbstract && [string equal $attr {::type}]} {
                                set tmpType [dict get $row $attr]
                                $retNode setAttributeNS "http://www.w3.org/2001/XMLSchema-instance" xsi:type $tmpType
                            } elseif {[string equal $attr $valueAttr]} {
                                lappend attrList $attr [dict get $row $attr]
                            } else {
                                set resultValue [dict get $row $attr]
                            }
                        }
                    } else {
                        set resultValue $row