Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Reduce non logging log impact by only building log message when logging. Requires tcllib log package 1.4 or included emulation. Ticket [93ebedfa] |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
150950db68b9163ae319eb252ff6005a |
| User & Date: | oehhar 2018-02-20 14:20:43 |
References
| 2018-02-20 14:23 | • Closed ticket [93ebedfa4a]: Replace log package by logger package plus 2 other changes artifact: c7f94a1d2f user: oehhar | |
Context
| 2018-05-28 11:16 | Add support to translate distant namespace prefixes in attribute values or text values to local correspondances, required for abstract types. Ticket [584bfb77]: client.tcl 2.5.1, utilities.tcl 2.4.2 check-in: e406ab9e21 user: oehhar tags: trunk | |
| 2018-02-20 21:31 | First step to parse complex abstract type in wsdl. Bug [584bfb7727] check-in: 6975d0e818 user: oehhar tags: bug584bfb7727-abstract-type | |
| 2018-02-20 14:20 | Reduce non logging log impact by only building log message when logging. Requires tcllib log package 1.4 or included emulation. Ticket [93ebedfa] check-in: 150950db68 user: oehhar tags: trunk | |
| 2018-01-08 17:37 | Set package version to release version 2.5.0 check-in: 53f12a2aa1 user: oehhar tags: trunk, Release_2.5.0 | |
Changes
Changes to Utilities.tcl.
| ︙ | ︙ | |||
52 53 54 55 56 57 58 59 60 61 |
uplevel 1 [list set $var [lindex $inList $i]]
}
return [lrange $inList $numArgs end]
}
}
package require log
package require tdom 0.8
package require struct::set
| > > > > > > > > > > > > > > > > > > > > | | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
uplevel 1 [list set $var [lindex $inList $i]]
}
return [lrange $inList $numArgs end]
}
}
package require log
# Emulate the log::logsubst command introduced in log 1.4
if {![llength [info command ::log::logsubst]]} {
if {![llength [info command ::tailcall]]} {
proc ::log::logsubst {level text} {
if {[::log::lvIsSuppressed $level]} {
return
}
::log::log $level [uplevel 1 [list subst $text]]
}
} else {
proc ::log::logsubst {level text} {
if {[::log::lvIsSuppressed $level]} {
return
}
tailcall ::log::log $level [uplevel 1 [list subst $text]]
}
}
}
package require tdom 0.8
package require struct::set
package provide WS::Utils 2.4.1
namespace eval ::WS {}
namespace eval ::WS::Utils {
set ::WS::Utils::typeInfo {}
set ::WS::Utils::currentSchema {}
array set ::WS::Utils::importedXref {}
|
| ︙ | ︙ | |||
295 296 297 298 299 300 301 |
variable options
if {[llength $args] == 0} {
::log::log debug {Return all options}
return [array get options]
} elseif {[llength $args] == 1} {
set opt [lindex $args 0]
| | | | | | | 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 |
variable options
if {[llength $args] == 0} {
::log::log debug {Return all options}
return [array get options]
} elseif {[llength $args] == 1} {
set opt [lindex $args 0]
::log::logsubst debug {One Option {$opt}}
if {[info exists options($opt)]} {
return $options($opt)
} else {
::log::logsubst debug {Unkown option {$opt}}
return \
-code error \
-errorcode [list WS CLIENT UNKOPTION $opt] \
"Unknown option'$opt'"
}
} elseif {([llength $args] % 2) == 0} {
::log::log debug {Multiple option pairs}
foreach {opt value} $args {
if {[info exists options($opt)]} {
::log::logsubst debug {Setting Option {$opt} to {$value}}
set options($opt) $value
} else {
::log::logsubst debug {Unkown option {$opt}}
return \
-code error \
-errorcode [list WS CLIENT UNKOPTION $opt] \
"Unknown option'$opt'"
}
}
} else {
::log::logsubst debug {Bad number of arguments {$args}}
return \
-code error \
-errorcode [list WS CLIENT INVARGCNT $args] \
"Invalid argument count'$args'"
}
return;
}
|
| ︙ | ︙ | |||
376 377 378 379 380 381 382 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::ServiceTypeDef {mode service type definition {xns {}} {abstract {false}}} {
| | | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::ServiceTypeDef {mode service type definition {xns {}} {abstract {false}}} {
::log::logsubst debug {Entering [info level 0]}
variable typeInfo
if {![string length $xns]} {
set xns $service
}
if {[llength [split $type {:}]] == 1} {
set type $xns:$type
|
| ︙ | ︙ | |||
507 508 509 510 511 512 513 |
#
#
###########################################################################
proc ::WS::Utils::ServiceSimpleTypeDef {mode service type definition {xns {tns1}}} {
variable simpleTypes
variable typeInfo
| | | | | 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 |
#
#
###########################################################################
proc ::WS::Utils::ServiceSimpleTypeDef {mode service type definition {xns {tns1}}} {
variable simpleTypes
variable typeInfo
::log::logsubst debug {Entering [info level 0]}
if {![dict exists $definition xns]} {
set simpleTypes($mode,$service,$type) [concat $definition xns $xns]
} else {
set simpleTypes($mode,$service,$type) $definition
}
if {[dict exists $typeInfo $mode $service $type]} {
::log::logsubst debug {\t Unsetting typeInfo $mode $service $type}
::log::logsubst debug {\t Was [dict get $typeInfo $mode $service $type]}
dict unset typeInfo $mode $service $type
}
return;
}
###########################################################################
#
|
| ︙ | ︙ | |||
593 594 595 596 597 598 599 |
::log::log debug "@1"
set results [dict get $typeInfo $mode $service]
} else {
set typeInfoList [TypeInfo $mode $service $type]
if {[string equal -nocase -length 3 $type {xs:}]} {
set type [string range $type 3 end]
}
| | | 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 |
::log::log debug "@1"
set results [dict get $typeInfo $mode $service]
} else {
set typeInfoList [TypeInfo $mode $service $type]
if {[string equal -nocase -length 3 $type {xs:}]} {
set type [string range $type 3 end]
}
::log::logsubst debug {Type = {$type} typeInfoList = {$typeInfoList}}
if {[info exists simpleTypes($mode,$service,$type)]} {
::log::log debug "@2"
set results $simpleTypes($mode,$service,$type)
} elseif {[info exists simpleTypes($type)]} {
::log::log debug "@3"
set results [list type xs:$type xns xs]
} elseif {[dict exists $typeInfo $mode $service $service:$type]} {
|
| ︙ | ︙ | |||
743 744 745 746 747 748 749 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 08/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::ProcessImportXml {mode baseUrl xml serviceName serviceInfoVar tnsCountVar} {
| | | 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 08/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::ProcessImportXml {mode baseUrl xml serviceName serviceInfoVar tnsCountVar} {
::log::logsubst debug {Entering [info level 0]}
upvar 1 $serviceInfoVar serviceInfo
upvar 1 $tnsCountVar tnsCount
variable currentSchema
variable xsltSchemaDom
set first [string first {<} $xml]
if {$first > 0} {
|
| ︙ | ︙ | |||
829 830 831 832 833 834 835 |
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl {includePath {}}} {
variable xsltSchemaDom
variable nsList
variable options
variable includeArr
| | | | | | | | 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 |
###########################################################################
proc ::WS::Utils::ProcessIncludes {rootNode baseUrl {includePath {}}} {
variable xsltSchemaDom
variable nsList
variable options
variable includeArr
::log::logsubst debug {Entering [info level 0]}
set includeNodeList [concat \
[$rootNode selectNodes -namespaces $nsList descendant::xs:include] \
[$rootNode selectNodes -namespaces $nsList descendant::w:include] \
]
set inXml [$rootNode asXML]
set included 0
foreach includeNode $includeNodeList {
::log::logsubst debug {\t Processing Include [$includeNode asXML]}
if {[$includeNode hasAttribute schemaLocation]} {
set urlTail [$includeNode getAttribute schemaLocation]
set url [::uri::resolve $baseUrl $urlTail]
} elseif {[$includeNode hasAttribute location]} {
set url [$includeNode getAttribute location]
set urlTail [file tail [dict get [::uri::split $url] path]]
} else {
continue
}
if {[lsearch -exact $includePath $url] != -1} {
log::logsubst warning {Include loop detected: [join $includePath { -> }]}
continue
} elseif {[info exists includeArr($url)]} {
continue
} else {
set includeArr($url) 1
}
incr included
::log::logsubst info {\t Including {$url} from base {$baseUrl}}
switch -exact -- [dict get [::uri::split $url] scheme] {
file {
upvar #0 [::uri::geturl $url] token
set xml $token(data)
unset token
}
https -
http {
set ncode -1
catch {
::log::logsubst info {[list ::http::geturl $url]}
set token [::http::geturl $url]
::http::wait $token
set ncode [::http::ncode $token]
set xml [::http::data $token]
::log::logsubst info {Received Ncode = ($ncode), $xml}
::http::cleanup $token
}
if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
return \
-code error \
-errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
"HTTP get of import file failed '$url'"
|
| ︙ | ︙ | |||
1236 1237 1238 1239 1240 1241 1242 |
$parent appendChild [$doc createElement xs:schema schema]
}
$schema setAttribute \
elementFormDefault qualified \
targetNamespace $targetNamespace
foreach baseType [lsort -dictionary [array names typeArr]] {
| | | | | 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 |
$parent appendChild [$doc createElement xs:schema schema]
}
$schema setAttribute \
elementFormDefault qualified \
targetNamespace $targetNamespace
foreach baseType [lsort -dictionary [array names typeArr]] {
::log::logsubst debug {Outputing $baseType}
$schema appendChild [$doc createElement xs:element elem]
set name [lindex [split $baseType {:}] end]
$elem setAttribute name $name
$elem setAttribute type $baseType
$schema appendChild [$doc createElement xs:complexType comp]
$comp setAttribute name $name
$comp appendChild [$doc createElement xs:sequence seq]
set baseTypeInfo [dict get $localTypeInfo $baseType definition]
::log::logsubst debug {\t parts {$baseTypeInfo}}
foreach {field tmpTypeInfo} $baseTypeInfo {
$seq appendChild [$doc createElement xs:element tmp]
set tmpType [dict get $tmpTypeInfo type]
::log::logsubst debug {Field $field of $tmpType}
foreach {name value} [getTypeWSDLInfo $mode $serviceName $field $tmpType] {
$tmp setAttribute $name $value
}
}
}
}
|
| ︙ | ︙ | |||
1371 1372 1373 1374 1375 1376 1377 |
if {$options(valueAttrCompatiblityMode)} {
set valueAttr {}
} else {
set valueAttr {::value}
}
set xsiNsUrl {http://www.w3.org/2001/XMLSchema-instance}
| | | | | | | 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 |
if {$options(valueAttrCompatiblityMode)} {
set valueAttr {}
} else {
set valueAttr {::value}
}
set xsiNsUrl {http://www.w3.org/2001/XMLSchema-instance}
::log::logsubst debug {Entering [info level 0]}
if {[dict exists $typeInfo $mode $serviceName $type]} {
set typeName $type
} elseif {[dict exists $typeInfo $mode $serviceName $serviceName:$type]} {
set typeName $serviceName:$type
} else {
##
## Assume this is a simple type
##
set baseType [::WS::Utils::GetServiceTypeDef $mode $serviceName $type]
if {[string equal $baseType {XML}]} {
set results [$node asXML]
} else {
set results [$node asText]
}
return $results
}
set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
::log::logsubst debug {\t type def = {$typeDefInfo}}
set xns [dict get $typeDefInfo xns]
if {[$node hasAttribute href]} {
set node [GetReferenceNode $root [$node getAttribute href]]
}
::log::logsubst debug {\t XML of node is [$node asXML]}
if {[info exists mutableTypeInfo([list $mode $serviceName $typeName])]} {
set type [(*)[lindex mutableTypeInfo([list $mode $serviceName $type]) 0] $mode $serviceName $typeName $xns $node]
set typeDefInfo [dict get $typeInfo $mode $serviceName $typeName]
::log::logsubst debug {\t type def replaced with = {$typeDefInfo}}
}
set results {}
#if {$options(parseInAttr)} {
# foreach attr [$node attributes] {
# if {[llength $attr] == 1} {
# dict set results $attr [$node getAttribute $attr]
# }
# }
#}
set partsList [dict keys [dict get $typeDefInfo definition]]
::log::logsubst debug {\t partsList is {$partsList}}
set arrayOverride [expr {$isArray && ([llength $partsList] == 1)}]
foreach partName $partsList {
set partType [dict get $typeDefInfo definition $partName type]
set partType [string trimright $partType {?}]
if {[dict exists $typeDefInfo definition $partName allowAny] && [dict get $typeDefInfo definition $partName allowAny]} {
set allowAny 1
} else {
|
| ︙ | ︙ | |||
1436 1437 1438 1439 1440 1441 1442 |
set typeInfo $savedTypeInfo
continue
}
set partXns $xns
catch {set partXns [dict get $typeInfo $mode $serviceName $partType xns]}
set typeInfoList [TypeInfo $mode $serviceName $partType]
set tmpTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
| | | | | | | | | | | | | 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 |
set typeInfo $savedTypeInfo
continue
}
set partXns $xns
catch {set partXns [dict get $typeInfo $mode $serviceName $partType xns]}
set typeInfoList [TypeInfo $mode $serviceName $partType]
set tmpTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
::log::logsubst debug {\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList}
##
## Try for fully qualified name
##
::log::logsubst debug {Trying #1 [list $node selectNodes $partXns:$partName]}
if {[catch {llength [set item [$node selectNodes $partXns:$partName]]} len] || ($len == 0)} {
::log::logsubst debug {Trying #2 [list $node selectNodes $xns:$partName]}
if {[catch {llength [set item [$node selectNodes $xns:$partName]]} len] || ($len == 0)} {
##
## Try for unqualified name
##
::log::logsubst debug {Trying #3 [list $node selectNodes $partName]}
if {[catch {llength [set item [$node selectNodes $partName]]} len] || ($len == 0)} {
::log::log debug "Trying #4 -- search of children"
set item {}
set matchList [list $partXns:$partName $xns:$partName $partName]
foreach childNode [$node childNodes] {
set nodeType [$childNode nodeType]
::log::logsubst debug {\t\t Looking at {[$childNode localName],[$childNode nodeName]} ($allowAny,$isArray,$nodeType,$partName)}
# From SOAP1.1 Spec:
# Within an array value, element names are not significant
# for distinguishing accessors. Elements may have any name.
# Here we don't need check the element name, just simple check
# it's a element node
if {$allowAny || ($arrayOverride && [string equal $nodeType "ELEMENT_NODE"])} {
::log::logsubst debug {\t\t Found $partName [$childNode asXML]}
lappend item $childNode
}
}
if {![string length $item]} {
::log::log debug "\tSkipping"
continue
}
} else {
::log::logsubst debug {\t\t Found [llength $item] $partName}
}
} else {
::log::logsubst debug {\t\t Found [llength $item] $partName}
}
} else {
::log::logsubst debug {\t\t Found [llength $item] $partName}
}
set origItemList $item
set newItemList {}
foreach item $origItemList {
if {[$item hasAttribute href]} {
set oldXML [$item asXML]
::log::logsubst debug {\t\t Replacing: $oldXML}
set item [GetReferenceNode $root [$item getAttribute href]]
::log::logsubst debug {\t\t With: [$item asXML]}
}
lappend newItemList $item
}
set item $newItemList
set isAbstract false
if {[dict exists $typeInfo $mode $serviceName $partType abstract]} {
set isAbstract [dict get $typeInfo $mode $serviceName $partType abstract]
|
| ︙ | ︙ | |||
1649 1650 1651 1652 1653 1654 1655 |
default {
##
## Placed here to shut up tclchecker
##
}
}
}
| | | 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 |
default {
##
## Placed here to shut up tclchecker
##
}
}
}
::log::logsubst debug {Leaving ::WS::Utils::convertTypeToDict with $results}
return $results
}
###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
# that you update this header block. Thanks.
|
| ︙ | ︙ | |||
1741 1742 1743 1744 1745 1746 1747 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0} {enforceRequired 0}} {
| | | | | 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToType {mode service doc parent dict type {forceNs 0} {enforceRequired 0}} {
::log::logsubst debug {Entering [info level 0]}
# ::log::logsubst debug { Parent xml: [$parent asXML]}
variable typeInfo
variable simpleTypes
variable options
variable standardAttributes
variable currentNs
if {!$options(UseNS)} {
return [::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent $dict $type $enforceRequired]
}
if {$options(valueAttrCompatiblityMode)} {
set valueAttr {}
} else {
set valueAttr {::value}
}
set typeInfoList [TypeInfo $mode $service $type]
set type [string trimright $type {?}]
::log::logsubst debug {\t typeInfoList = {$typeInfoList}}
if {[dict exists $typeInfo $mode $service $service:$type]} {
set typeName $service:$type
} else {
set typeName $type
}
set itemList {}
if {[lindex $typeInfoList 0] && [dict exists $typeInfo $mode $service $typeName definition]} {
|
| ︙ | ︙ | |||
1797 1798 1799 1800 1801 1802 1803 |
set xns [dict get $simpleTypes($mode,$service,$currentNs:$typeName) xns]
} else {
error "Simple type cannot be found: $typeName"
}
set itemList [list $type {type string}]
}
}
| | | | | | 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 |
set xns [dict get $simpleTypes($mode,$service,$currentNs:$typeName) xns]
} else {
error "Simple type cannot be found: $typeName"
}
set itemList [list $type {type string}]
}
}
::log::logsubst debug {\titemList is {$itemList} in $xns}
set entryNs $currentNs
if {!$forceNs} {
set currentNs $xns
}
set fieldList {}
foreach {itemName itemDef} $itemList {
set baseName [lindex [split $itemName {:}] end]
lappend fieldList $itemName
set itemType [dict get $itemDef type]
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}}
set typeInfoList [TypeInfo $mode $service $itemType 1]
::log::logsubst debug {Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]}
if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
::log::logsubst debug {Neither {$itemName} nor {$baseName} are in dictionary {$dict}, skipping}
# If required parameters are being enforced and this field is not optional, throw an error
if {$enforceRequired && ![lindex $typeInfoList 2]} {
error "Required field $itemName is missing from response"
}
continue
} elseif {[dict exists $dict $baseName]} {
set useName $baseName
|
| ︙ | ︙ | |||
1837 1838 1839 1840 1841 1842 1843 |
}
if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} {
set itemXns {}
}
foreach key [dict keys $itemDef] {
if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
lappend attrList $key [dict get $itemDef $key]
| | | | | 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 |
}
if {$options(nsOnChangeOnly) && [string equal $itemXns $currentNs]} {
set itemXns {}
}
foreach key [dict keys $itemDef] {
if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
lappend attrList $key [dict get $itemDef $key]
::log::logsubst debug {key = {$key} standardAttributes = {$standardAttributes}}
}
}
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} itemXns = {$itemXns} tmpInfo = {$tmpInfo} attrList = {$attrList}}
set isAbstract false
set baseType [string trimright $itemType {()?}]
if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
}
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList} isAbstract = {$isAbstract}}
# Strip the optional flag off the typeInfoList
set typeInfoList [lrange $typeInfoList 0 1]
switch -exact -- $typeInfoList {
{0 0} {
##
## Simple non-array
##
|
| ︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 |
if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
$parent appendChild [$doc createElement $itemName retNode]
} else {
$parent appendChild [$doc createElement $itemXns:$itemName retNode]
}
if {$options(genOutAttr)} {
set dictList [dict keys $row]
| | | 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 |
if {[string equal $itemXns $options(suppressNS)] || [string equal $itemXns {}]} {
$parent appendChild [$doc createElement $itemName retNode]
} else {
$parent appendChild [$doc createElement $itemXns:$itemName retNode]
}
if {$options(genOutAttr)} {
set dictList [dict keys $row]
::log::logsubst debug {<$row> '$dictList'}
set resultValue {}
foreach attr [lindex [::struct::set intersect3 $standardAttributes $dictList] end] {
if {[string equal $attr $valueAttr]} {
set resultValue [dict get $row $attr]
} elseif {[string match {::*} $attr]} {
set baseAttr [string range $attr 2 end]
set attrValue [dict get $row $attr]
|
| ︙ | ︙ | |||
2034 2035 2036 2037 2038 2039 2040 |
# set dictList [dict keys $dict]
# foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
# $parent setAttribute $attr [dict get $dict $attr]
# }
#}
}
set currentNs $entryNs
| | | 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 |
# set dictList [dict keys $dict]
# foreach attr [lindex [::struct::set intersect3 $fieldList $dictList] end] {
# $parent setAttribute $attr [dict get $dict $attr]
# }
#}
}
set currentNs $entryNs
::log::logsubst debug {Leaving ::WS::Utils::convertDictToType with xml: [$parent asXML]}
return;
}
###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
# that you update this header block. Thanks.
|
| ︙ | ︙ | |||
2079 2080 2081 2082 2083 2084 2085 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 03/23/2011 J.Lawson Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToJson {mode service doc dict type {enforceRequired 0}} {
| | | 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 03/23/2011 J.Lawson Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToJson {mode service doc dict type {enforceRequired 0}} {
::log::logsubst debug {Entering [info level 0]}
variable typeInfo
variable simpleTypes
variable simpleTypesJson
variable options
variable standardAttributes
set typeInfoList [TypeInfo $mode $service $type]
|
| ︙ | ︙ | |||
2110 2111 2112 2113 2114 2115 2116 |
set typeInfoList [TypeInfo $mode $service $typeName]
if {[lindex $typeInfoList 0]} {
set itemList [dict get $typeInfo $mode $service $typeName definition]
} else {
set itemList [list $type {type string}]
}
}
| | | | | 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 |
set typeInfoList [TypeInfo $mode $service $typeName]
if {[lindex $typeInfoList 0]} {
set itemList [dict get $typeInfo $mode $service $typeName definition]
} else {
set itemList [list $type {type string}]
}
}
::log::logsubst debug {\titemList is {$itemList}}
set fieldList {}
foreach {itemName itemDef} $itemList {
lappend fieldList $itemName
set itemType [dict get $itemDef type]
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} itemType = {$itemType}}
set typeInfoList [TypeInfo $mode $service $itemType 1]
if {![dict exists $dict $itemName]} {
if {$enforceRequired && ![lindex $typeInfoList 2]} {
error "Required field $itemName is missing from response"
}
continue
}
if {[info exists simpleTypesJson([string trimright $itemType {()?}])]} {
set yajlType $simpleTypesJson([string trimright $itemType {()?}])
} else {
set yajlType "string"
}
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}}
set typeInfoList [lrange $typeInfoList 0 1]
switch $typeInfoList {
{0 0} {
##
## Simple non-array
##
set resultValue [dict get $dict $itemName]
|
| ︙ | ︙ | |||
2224 2225 2226 2227 2228 2229 2230 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
| | | 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type {enforceRequired 0}} {
::log::logsubst debug {Entering [info level 0]}
# ::log::log debug " Parent xml: [$parent asXML]"
variable typeInfo
variable simpleTypes
variable options
variable standardAttributes
if {$options(valueAttrCompatiblityMode)} {
|
| ︙ | ︙ | |||
2250 2251 2252 2253 2254 2255 2256 |
} elseif {[info exists simpleTypes($mode,$service,$currentNs:$type)]} {
set xns [dict get $simpleTypes($mode,$service,$currentNs:$type) xns]
} else {
error "Simple type cannot be found: $type"
}
set itemList [list $type {type string}]
}
| | | | | | 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 |
} elseif {[info exists simpleTypes($mode,$service,$currentNs:$type)]} {
set xns [dict get $simpleTypes($mode,$service,$currentNs:$type) xns]
} else {
error "Simple type cannot be found: $type"
}
set itemList [list $type {type string}]
}
::log::logsubst debug {\titemList is {$itemList}}
foreach {itemName itemDef} $itemList {
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef}}
set itemType [dict get $itemDef type]
set isAbstract false
set baseType [string trimright $itemType {()?}]
if {$options(genOutAttr) && [dict exists $typeInfo $mode $service $baseType abstract]} {
set isAbstract [dict get $typeInfo $mode $service $baseType abstract]
}
set typeInfoList [TypeInfo $mode $service $itemType 1]
if {![dict exists $dict $itemName]} {
if {$enforceRequired && ![lindex $typeInfoList 2]} {
error "Required field $itemName is missing from response"
}
continue
}
set attrList {}
foreach key [dict keys $itemDef] {
if {[lsearch -exact $standardAttributes $key] == -1 && $key ne "isList" && $key ne "xns"} {
lappend attrList $key [dict get $itemDef $key]
::log::logsubst debug {key = {$key} standardAttributes = {$standardAttributes}}
}
}
::log::logsubst debug {\t\titemName = {$itemName} itemDef = {$itemDef} typeInfoList = {$typeInfoList}}
set typeInfoList [lrange $typeInfoList 0 1]
switch -exact -- $typeInfoList {
{0 0} {
##
## Simple non-array
##
$parent appendChild [$doc createElement $itemName retNode]
|
| ︙ | ︙ | |||
2450 2451 2452 2453 2454 2455 2456 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToEncodedType {mode service doc parent dict type} {
| | | | 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToEncodedType {mode service doc parent dict type} {
::log::logsubst debug {Entering [info level 0]}
variable typeInfo
variable options
set typeInfoList [TypeInfo $mode $service $type]
::log::logsubst debug {\t typeInfoList = {$typeInfoList}}
set type [string trimright $type {?}]
if {[lindex $typeInfoList 0]} {
set itemList [dict get $typeInfo $mode $service $type definition]
set xns [dict get $typeInfo $mode $service $type xns]
} else {
if {[info exists simpleTypes($mode,$service,$type)]} {
set xns [dict get $simpleTypes($mode,$service,$type) xns]
|
| ︙ | ︙ | |||
2484 2485 2486 2487 2488 2489 2490 |
set xns [dict get $simpleTypes($mode,$service,$type) xns]
} else {
error "Simple type cannot be found: $type"
}
set itemList [list $type {type string}]
}
}
| | | | | 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 |
set xns [dict get $simpleTypes($mode,$service,$type) xns]
} else {
error "Simple type cannot be found: $type"
}
set itemList [list $type {type string}]
}
}
::log::logsubst debug {\titemList is {$itemList} in $xns}
foreach {itemName itemDef} $itemList {
set itemType [string trimright [dict get $itemList $itemName type] {?}]
set typeInfoList [TypeInfo $mode $service $itemType]
::log::logsubst debug {\t\t Looking for {$itemName} in {$dict}}
if {![dict exists $dict $itemName]} {
::log::log debug "\t\t Not found, skipping"
continue
}
::log::logsubst debug {\t\t Type info is {$typeInfoList}}
switch -exact -- $typeInfoList {
{0 0} {
##
## Simple non-array
##
if {[string equal $xns $options(suppressNS)]} {
$parent appendChild [$doc createElement $itemName retNode]
|
| ︙ | ︙ | |||
2630 2631 2632 2633 2634 2635 2636 |
#
#
###########################################################################
proc ::WS::Utils::parseDynamicType {mode serviceName node type} {
variable typeInfo
variable nsList
| | | | 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 |
#
#
###########################################################################
proc ::WS::Utils::parseDynamicType {mode serviceName node type} {
variable typeInfo
variable nsList
::log::logsubst debug {Entering [info level 0]}
foreach child [$node childNodes] {
::log::logsubst debug {\t Child $child is [$child nodeName]}
}
##
## Get type being defined
##
set schemeNode [$node selectNodes -namespaces $nsList xs:schema]
set newTypeNode [$node selectNodes -namespaces $nsList xs:schema/xs:element]
|
| ︙ | ︙ | |||
2717 2718 2719 2720 2721 2722 2723 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 08/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::parseScheme {mode baseUrl schemaNode serviceName serviceInfoVar tnsCountVar} {
| | | | | | | 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 08/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::parseScheme {mode baseUrl schemaNode serviceName serviceInfoVar tnsCountVar} {
::log::logsubst debug {Entering [info level 0]}
upvar 1 $tnsCountVar tnsCount
upvar 1 $serviceInfoVar serviceInfo
variable currentSchema
variable nsList
variable options
variable unkownRef
set currentSchema $schemaNode
set tmpTargetNs $::WS::Utils::targetNs
foreach attr [$schemaNode attributes] {
set value {?}
catch {set value [$schemaNode getAttribute $attr]}
::log::logsubst debug {Attribute $attr = $value}
}
if {[$schemaNode hasAttribute targetNamespace]} {
set xns [$schemaNode getAttribute targetNamespace]
::log::logsubst debug {In Parse Scheme, found targetNamespace attribute with {$xns}}
set ::WS::Utils::targetNs $xns
} else {
set xns $::WS::Utils::targetNs
}
::log::logsubst debug {@3a {$xns} {[dict get $serviceInfo tnsList url]}}
if {![dict exists $serviceInfo tnsList url $xns]} {
set tns [format {tns%d} [incr tnsCount]]
dict set serviceInfo targetNamespace $tns $xns
dict set serviceInfo tnsList url $xns $tns
dict set serviceInfo tnsList tns $tns $tns
} else {
set tns [dict get $serviceInfo tnsList url $xns]
}
::log::logsubst debug {@3 TNS count for $xns is $tnsCount {$tns}}
set prevTnsDict [dict get $serviceInfo tnsList tns]
dict set serviceInfo tns {}
foreach itemList [$schemaNode attributes xmlns:*] {
set ns [lindex $itemList 0]
set url [$schemaNode getAttribute xmlns:$ns]
if {[dict exists $serviceInfo tnsList url $url]} {
|
| ︙ | ︙ | |||
2788 2789 2790 2791 2792 2793 2794 |
##
## Process the scheme in multiple passes to handle forward references and extensions
##
set pass 1
set lastUnknownRefCount 0
array unset unkownRef
while {($pass == 1) || ($lastUnknownRefCount != [array size unkownRef])} {
| | | | | | | | | | | | | | | | | | | | 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 |
##
## Process the scheme in multiple passes to handle forward references and extensions
##
set pass 1
set lastUnknownRefCount 0
array unset unkownRef
while {($pass == 1) || ($lastUnknownRefCount != [array size unkownRef])} {
::log::logsubst debug {Pass $pass over schema}
incr pass
set lastUnknownRefCount [array size unkownRef]
array unset unkownRef
foreach element [$schemaNode selectNodes -namespaces $nsList xs:import] {
if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
::log::logsubst notice {Import failed due to: {$msg}. Trace: $::errorInfo}
}
}
foreach element [$schemaNode selectNodes -namespaces $nsList w:import] {
if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
::log::logsubst notice {Import failed due to: {$msg}. Trace: $::errorInfo}
}
}
::log::logsubst debug {Parsing Element types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:element] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
::log::logsubst notice {Unhandled error: {$msg}. Trace: $::errorInfo}
}
}
::log::logsubst debug {Parsing Attribute types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:attribute] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
::log::logsubst notice {Unhandled error: {$msg}. Trace: $::errorInfo}
}
}
::log::logsubst debug {Parsing Simple types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:simpleType] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseSimpleType $mode serviceInfo $serviceName $element $tns} msg]} {
::log::logsubst notice {Unhandled error: {$msg}. Trace: $::errorInfo}
}
}
::log::logsubst debug {Parsing Complex types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:complexType] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseComplexType $mode serviceInfo $serviceName $element $tns} msg]} {
::log::logsubst notice {Unhandled error: {$msg}. Trace: $::errorInfo}
}
}
}
set lastUnknownRefCount [array size unkownRef]
foreach {unkRef usedByTypeList} [array get unkownRef] {
foreach usedByType $usedByTypeList {
switch -exact -- $options(StrictMode) {
debug -
warning {
::log::logsubst $options(StrictMode) {Unknown type reference $unkRef in type $usedByType}
}
error -
default {
::log::logsubst error {Unknown type reference $unkRef in type $usedByType}
}
}
}
}
if {$lastUnknownRefCount} {
switch -exact -- $options(StrictMode) {
debug -
warning {
set ::WS::Utils::targetNs $tmpTargetNs
::log::logsubst $options(StrictMode) {Found $lastUnknownRefCount forward type references: [join [array names unkownRef] {,}]}
}
error -
default {
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode [list WS $mode UNKREFS [list $lastUnknownRefCount]] \
|
| ︙ | ︙ | |||
2886 2887 2888 2889 2890 2891 2892 |
[$schemaNode selectNodes -namespaces $nsList w:import] \
]
foreach element $importNodeList {
if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
switch -exact -- $options(StrictMode) {
debug -
warning {
| > > > > > > > | > > > > > > > > > > > > > > > > > > > | > > > > | | | > | | | | | | | | | | < | | > | | | | | | | | | | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | | | | | | | 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 |
[$schemaNode selectNodes -namespaces $nsList w:import] \
]
foreach element $importNodeList {
if {[catch {processImport $mode $baseUrl $element $serviceName serviceInfo tnsCount} msg]} {
switch -exact -- $options(StrictMode) {
debug -
warning {
::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
::log::logsubst $options(StrictMode) {\t error was: $msg}
}
error -
default {
set errorCode $::errorCode
set errorInfo $::errorInfo
::log::logsubst error {Could not parse:\n [$element asXML]}
::log::logsubst error {\t error was: $msg}
::log::logsubst error {\t error info: $errorInfo}
::log::logsubst error {\t error in: [lindex [info level 0] 0]}
::log::logsubst error {\t error code: $errorCode}
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
::log::logsubst debug {Parsing Element types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:element] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
switch -exact -- $options(StrictMode) {
debug -
warning {
::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
::log::logsubst $options(StrictMode) {\t error was: $msg}
}
error -
default {
set errorCode $::errorCode
set errorInfo $::errorInfo
::log::logsubst error {Could not parse:\n [$element asXML]}
::log::logsubst error {\t error was: $msg}
::log::logsubst error {\t error info: $errorInfo}
::log::logsubst error {\t last element: $::elementName}
::log::logsubst error {\t error in: [lindex [info level 0] 0]}
::log::logsubst error {\t error code: $errorCode}
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
::log::logsubst debug {Parsing Attribute types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:attribute] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseElementalType $mode serviceInfo $serviceName $element $tns} msg]} {
switch -exact -- $options(StrictMode) {
debug -
warning {
::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
::log::logsubst $options(StrictMode) {\t error was: $msg}
}
error -
default {
set errorCode $::errorCode
set errorInfo $::errorInfo
::log::logsubst error {Could not parse:\n [$element asXML]}
::log::logsubst error {\t error was: $msg}
::log::logsubst error {\t error info: $errorInfo}
::log::logsubst error {\t error in: [lindex [info level 0] 0]}
::log::logsubst error {\t error code: $errorCode}
::log::logsubst error {\t last element: $::elementName}
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
::log::logsubst debug {Parsing Simple types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:simpleType] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseSimpleType $mode serviceInfo $serviceName $element $tns} msg]} {
switch -exact -- $options(StrictMode) {
debug -
warning {
::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
::log::logsubst $options(StrictMode) {\t error was: $msg}
}
error -
default {
set errorCode $::errorCode
set errorInfo $::errorInfo
::log::logsubst error {Could not parse:\n [$element asXML]}
::log::logsubst error {\t error was: $msg}
::log::logsubst error {\t error info: $errorInfo}
::log::logsubst error {\t error in: [lindex [info level 0] 0]}
::log::logsubst error {\t error code: $errorCode}
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
::log::logsubst debug {Parsing Complex types for $xns as $tns}
foreach element [$schemaNode selectNodes -namespaces $nsList child::xs:complexType] {
::log::logsubst debug {\tprocessing $element}
if {[catch {parseComplexType $mode serviceInfo $serviceName $element $tns} msg]} {
switch -exact -- $options(StrictMode) {
debug -
warning {
::log::logsubst $options(StrictMode) {Could not parse:\n [$element asXML]}
::log::logsubst $options(StrictMode) {\t error was: $msg}
}
error -
default {
set errorCode $::errorCode
set errorInfo $::errorInfo
::log::logsubst error {Could not parse:\n [$element asXML]}
::log::logsubst error {\t error was: $msg}
::log::logsubst error {\t error info: $errorInfo}
::log::logsubst error {\t error in: [lindex [info level 0] 0]}
::log::logsubst error {\t error code: $errorCode}
set ::WS::Utils::targetNs $tmpTargetNs
return \
-code error \
-errorcode $errorCode \
-errorinfo $errorInfo \
$msg
}
}
}
}
set ::WS::Utils::targetNs $tmpTargetNs
::log::logsubst debug {Leaving :WS::Utils::parseScheme $mode $baseUrl $schemaNode $serviceName $serviceInfoVar $tnsCountVar}
::log::logsubst debug {Target NS is now: $::WS::Utils::targetNs}
dict set serviceInfo tnsList tns $prevTnsDict
}
###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
# that you update this header block. Thanks.
|
| ︙ | ︙ | |||
3087 3088 3089 3090 3091 3092 3093 |
proc ::WS::Utils::processImport {mode baseUrl importNode serviceName serviceInfoVar tnsCountVar} {
upvar 1 $serviceInfoVar serviceInfo
upvar 1 $tnsCountVar tnsCount
variable currentSchema
variable importedXref
variable options
| | | | | | 3107 3108 3109 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 |
proc ::WS::Utils::processImport {mode baseUrl importNode serviceName serviceInfoVar tnsCountVar} {
upvar 1 $serviceInfoVar serviceInfo
upvar 1 $tnsCountVar tnsCount
variable currentSchema
variable importedXref
variable options
::log::logsubst debug {Entering [info level 0]}
##
## Get the xml
##
set attrName schemaLocation
if {![$importNode hasAttribute $attrName]} {
set attrName namespace
if {![$importNode hasAttribute $attrName]} {
::log::log debug "\t No schema location, existing"
return \
-code error \
-errorcode [list WS CLIENT MISSCHLOC $baseUrl] \
"Missing Schema Location in '$baseUrl'"
}
}
set urlTail [$importNode getAttribute $attrName]
set url [::uri::resolve $baseUrl $urlTail]
::log::logsubst debug {Including $url}
set lastPos [string last / $url]
set testUrl [string range $url 0 [expr {$lastPos - 1}]]
if { [info exists ::WS::Utils::redirectArray($testUrl)] } {
set newUrl $::WS::Utils::redirectArray($testUrl)
append newUrl [string range $url $lastPos end]
::log::logsubst debug {newUrl = $newUrl}
set url $newUrl
}
::log::logsubst debug {\t Importing {$url}}
##
## Skip "known" namespace
##
switch -exact -- $url {
http://schemas.xmlsoap.org/wsdl/ -
http://schemas.xmlsoap.org/wsdl/soap/ -
|
| ︙ | ︙ | |||
3137 3138 3139 3140 3141 3142 3143 |
}
}
##
## Short-circuit infinite loop on inports
##
if { [info exists importedXref($mode,$serviceName,$url)] } {
| | | | | 3157 3158 3159 3160 3161 3162 3163 3164 3165 3166 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 |
}
}
##
## Short-circuit infinite loop on inports
##
if { [info exists importedXref($mode,$serviceName,$url)] } {
::log::logsubst debug {$mode,$serviceName,$url was already imported: $importedXref($mode,$serviceName,$url)}
return
}
dict lappend serviceInfo imports $url
set importedXref($mode,$serviceName,$url) [list $mode $serviceName $tnsCount]
set urlScheme [dict get [::uri::split $url] scheme]
::log::logsubst debug {URL Scheme of {$url} is {$urlScheme}}
switch -exact -- $urlScheme {
file {
::log::logsubst debug {In file processor -- {$urlTail}}
set fn [file join $options(includeDirectory) [string range $urlTail 8 end]]
set ifd [open $fn r]
set xml [read $ifd]
close $ifd
ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar
}
https -
|
| ︙ | ︙ | |||
3171 3172 3173 3174 3175 3176 3177 |
if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
return \
-code error \
-errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
"HTTP get of import file failed '$url'"
} elseif {($ncode == 200) && ![string equal $options(includeDirectory) {}]} {
set fn [file join $options(includeDirectory) [file tail $urlTail]]
| | | | 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 |
if {($ncode != 200) && [string equal $options(includeDirectory) {}]} {
return \
-code error \
-errorcode [list WS CLIENT HTTPFAIL $url $ncode] \
"HTTP get of import file failed '$url'"
} elseif {($ncode == 200) && ![string equal $options(includeDirectory) {}]} {
set fn [file join $options(includeDirectory) [file tail $urlTail]]
::log::logsubst info {Could not access $url -- using $fn}
set ifd [open $fn r]
set xml [read $ifd]
close $ifd
}
if {[catch {ProcessImportXml $mode $baseUrl $xml $serviceName $serviceInfoVar $tnsCountVar} err]} {
::log::logsubst info {Error during processing of XML: $err}
#puts stderr "error Info: $::errorInfo"
} else {
#puts stderr "import successful"
}
}
default {
return \
|
| ︙ | ︙ | |||
3240 3241 3242 3243 3244 3245 3246 |
proc ::WS::Utils::parseComplexType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable currentSchema
variable nsList
variable unkownRef
variable defaultType
| | | | | | | 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 |
proc ::WS::Utils::parseComplexType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable currentSchema
variable nsList
variable unkownRef
variable defaultType
::log::logsubst debug {Entering [info level 0]}
set isAbstractType false
set defaultType string
set typeName $tns:[$node getAttribute name]
::log::logsubst debug {Complex Type is $typeName}
if {[$node hasAttribute abstract]} {
set isAbstractType [$node getAttribute abstract]
::log::logsubst debug {\t Abstract type = $isAbstractType}
}
#if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $typeName]]} {
# ::log::log debug "\t Type $typeName is already defined -- leaving"
# return
#}
set partList {}
set nodeFound 0
array set attrArr {}
set comment {}
set middleNodeList [$node childNodes]
foreach middleNode $middleNodeList {
set commentNodeList [$middleNode selectNodes -namespaces $nsList xs:annotation]
if {[llength $commentNodeList]} {
set commentNode [lindex $commentNodeList 0]
set comment [string trim [$commentNode asText]]
}
set middle [$middleNode localName]
::log::logsubst debug {Complex Type is $typeName, middle is $middle}
#if {$isAbstractType && [string equal $middle attribute]} {
# ##
# ## Abstract type, so treat like an element
# ##
# set middle element
#}
switch -exact -- $middle {
attribute -
annotation {
##
## Do nothing
##
continue
}
element {
set nodeFound 1
if {[$middleNode hasAttribute ref]} {
set partType [$middleNode getAttribute ref]
::log::logsubst debug {\t\t has a ref of {$partType}}
if {[catch {
set refTypeInfo [split $partType {:}]
set partName [lindex $refTypeInfo end]
set refNS [lindex $refTypeInfo 0]
if {[string equal $refNS {}]} {
set partType $tns:$partType
}
|
| ︙ | ︙ | |||
3347 3348 3349 3350 3351 3352 3353 |
choice -
sequence -
all {
# set elementList [$middleNode selectNodes -namespaces $nsList xs:element]
set partMax [$middleNode getAttribute maxOccurs 1]
set tmp [partList $mode $middleNode $serviceName results $tns $partMax]
if {[llength $tmp]} {
| | | 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 |
choice -
sequence -
all {
# set elementList [$middleNode selectNodes -namespaces $nsList xs:element]
set partMax [$middleNode getAttribute maxOccurs 1]
set tmp [partList $mode $middleNode $serviceName results $tns $partMax]
if {[llength $tmp]} {
::log::logsubst debug {\tadding {$tmp} to partslist}
set nodeFound 1
set partList [concat $partList $tmp]
} elseif {!$nodeFound} {
::WS::Utils::ServiceSimpleTypeDef $mode $serviceName $typeName [list base string comment $comment] $tns
return
}
# simpleType {
|
| ︙ | ︙ | |||
3369 3370 3371 3372 3373 3374 3375 |
parseComplexType $mode results $serviceName $middleNode $tns
}
simpleContent -
complexContent {
foreach child [$middleNode childNodes] {
set parent [$child parent]
set contentType [$child localName]
| | | 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 |
parseComplexType $mode results $serviceName $middleNode $tns
}
simpleContent -
complexContent {
foreach child [$middleNode childNodes] {
set parent [$child parent]
set contentType [$child localName]
::log::logsubst debug {Content Type is {$contentType}}
switch -exact -- $contentType {
restriction {
set nodeFound 1
set restriction $child
set element [$child selectNodes -namespaces $nsList xs:attribute]
set typeInfoList [list baseType [$restriction getAttribute base]]
array unset attrArr
|
| ︙ | ︙ | |||
3394 3395 3396 3397 3398 3399 3400 |
set partName item
set partType [getQualifiedType $results $attrArr(arrayType) $tns]
set partType [string map {{[]} {()}} $partType]
lappend partList $partName [list type [string trimright ${partType} {()?}]() comment $comment allowAny 1]
set nodeFound 1
}
extension {
| | | | | 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 |
set partName item
set partType [getQualifiedType $results $attrArr(arrayType) $tns]
set partType [string map {{[]} {()}} $partType]
lappend partList $partName [list type [string trimright ${partType} {()?}]() comment $comment allowAny 1]
set nodeFound 1
}
extension {
::log::logsubst debug {Calling partList for $contentType of $typeName}
if {[catch {set tmp [partList $mode $child $serviceName results $tns]} msg]} {
::log::logsubst debug {Error in partList {$msg}, errorInfo: $errorInfo}
}
::log::logsubst debug {partList for $contentType of $typeName is {$tmp}}
if {[llength $tmp] && ![string equal [lindex $tmp 0] {}]} {
set nodeFound 1
set partList [concat $partList $tmp]
} elseif {[llength $tmp]} {
##
## Found extension, but it is an empty type
##
|
| ︙ | ︙ | |||
3433 3434 3435 3436 3437 3438 3439 |
if {!$nodeFound} {
parseElementalType $mode results $serviceName $node $tns
return
}
}
}
}
| | | 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 |
if {!$nodeFound} {
parseElementalType $mode results $serviceName $node $tns
return
}
}
}
}
::log::logsubst debug {at end of foreach {$typeName} with {$partList}}
if {[llength $partList] || $isAbstractType} {
#dict set results types $tns:$typeName $partList
dict set results types $typeName $partList
::log:::log debug "Defining $typeName"
if {[llength $partList] && ![string equal [lindex $partList 0] {}]} {
::WS::Utils::ServiceTypeDef $mode $serviceName $typeName $partList $tns $isAbstractType
} else {
|
| ︙ | ︙ | |||
3508 3509 3510 3511 3512 3513 3514 |
variable defaultType
variable options
variable simpleTypes
upvar 1 $dictVar results
set partList {}
set middle [$node localName]
| | | 3528 3529 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 |
variable defaultType
variable options
variable simpleTypes
upvar 1 $dictVar results
set partList {}
set middle [$node localName]
::log::logsubst debug {Entering [info level 0] -- for $middle}
switch -exact -- $middle {
anyAttribute -
attribute {
##
## Do Nothing
##
}
|
| ︙ | ︙ | |||
3531 3532 3533 3534 3535 3536 3537 |
set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
}
}
}
extension {
set baseName [getQualifiedType $results [$node getAttribute base string] $tns]
set baseTypeInfo [TypeInfo Client $serviceName $baseName]
| | | 3551 3552 3553 3554 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 |
set partList [list $partName [list type [string trimright ${partType} {()}]() comment {}]]
}
}
}
extension {
set baseName [getQualifiedType $results [$node getAttribute base string] $tns]
set baseTypeInfo [TypeInfo Client $serviceName $baseName]
::log::logsubst debug {\t base name of extension is {$baseName} with typeinfo {$baseTypeInfo}}
if {[lindex $baseTypeInfo 0]} {
if {[catch {::WS::Utils::GetServiceTypeDef Client $serviceName $baseName}]} {
set baseQuery [format {child::*[attribute::name='%s']} $baseName]
set baseNode [$currentSchema selectNodes $baseQuery]
#puts "$baseQuery gave {$baseNode}"
set baseNodeType [$baseNode localName]
switch -exact -- $baseNodeType {
|
| ︙ | ︙ | |||
3556 3557 3558 3559 3560 3561 3562 |
##
## Placed here to shut up tclchecker
##
}
}
}
set baseInfo [GetServiceTypeDef $mode $serviceName $baseName]
| | | | | | | | | 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 |
##
## Placed here to shut up tclchecker
##
}
}
}
set baseInfo [GetServiceTypeDef $mode $serviceName $baseName]
::log::logsubst debug {\t baseInfo is {$baseInfo}}
if {[llength $baseInfo] == 0} {
::log::logsubst debug {\t Unknown reference '$baseName'}
set unkownRef($baseName) 1
return;
}
catch {set partList [concat $partList [dict get $baseInfo definition]]}
} else {
::log::logsubst debug {\t Simple type}
}
foreach elementNode [$node childNodes] {
set tmp [partList $mode $elementNode $serviceName results $tns]
if {[llength $tmp]} {
set partList [concat $partList $tmp]
}
}
}
choice -
sequence -
all {
set elementList [$node selectNodes -namespaces $nsList xs:element]
set elementsFound 0
::log::logsubst debug {\telement list is {$elementList}}
foreach element $elementList {
::log::logsubst debug {\t\tprocessing $element ([$element nodeName])}
set comment {}
set additional_defininition_elements {}
if {[catch {
set elementsFound 1
set attrName name
set isRef 0
if {![$element hasAttribute name]} {
set attrName ref
set isRef 1
}
set partName [$element getAttribute $attrName]
if {$isRef} {
set partType {}
set partTypeInfo {}
set partType [string trimright [getQualifiedType $results $partName $tns] {?}]
set partTypeInfo [::WS::Utils::GetServiceTypeDef $mode $serviceName $partType]
set partName [lindex [split $partName {:}] end]
::log::logsubst debug {\t\t\t part name is {$partName} type is {$partTypeInfo}}
if {[dict exists $partTypeInfo definition $partName]} {
set partType [dict get $partTypeInfo definition $partName type]
}
::log::logsubst debug {\t\t\t part name is {$partName} type is {$partType}}
} else {
##
## See if really a complex definition
##
if {[$element hasChildNodes]} {
set isComplex 0; set isSimple 0
foreach child [$element childNodes] {
|
| ︙ | ︙ | |||
3647 3648 3649 3650 3651 3652 3653 |
}
if {$partMax <= 1} {
lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements]
} else {
lappend partList $partName [concat [list type [string trimright ${partType} {()?}]() comment $comment] $additional_defininition_elements]
}
} msg]} {
| | | | 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 |
}
if {$partMax <= 1} {
lappend partList $partName [concat [list type $partType comment $comment] $additional_defininition_elements]
} else {
lappend partList $partName [concat [list type [string trimright ${partType} {()?}]() comment $comment] $additional_defininition_elements]
}
} msg]} {
::log::logsubst error {\tError processing {$msg} for [$element asXML]}
if {$isRef} {
::log::log error "\t\t Was a reference. Additionally information is:"
::log::logsubst error {\t\t\t part name is {$partName} type is {$partType} with {$partTypeInfo}}
}
}
}
if {!$elementsFound} {
set defaultType $options(anyType)
return
}
|
| ︙ | ︙ | |||
3763 3764 3765 3766 3767 3768 3769 |
proc ::WS::Utils::parseElementalType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable importedXref
variable nsList
variable unkownRef
| | | | | | | | | | 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 3828 3829 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 |
proc ::WS::Utils::parseElementalType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable importedXref
variable nsList
variable unkownRef
::log::logsubst debug {Entering [info level 0]}
set attributeName name
if {![$node hasAttribute $attributeName]} {
set attributeName ref
}
set typeName [$node getAttribute $attributeName]
if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
::log::logsubst debug {\t Type $tns:$typeName is already defined -- leaving}
return
}
set typeType ""
if {[$node hasAttribute type]} {
set typeType [getQualifiedType $results [$node getAttribute type string] $tns]
}
::log::logsubst debug {Elemental Type is $typeName}
set partList {}
set partType {}
set isAbstractType false
if {[$node hasAttribute abstract]} {
set isAbstractType [$node getAttribute abstract]
::log::logsubst debug {\t Abstract type = $isAbstractType}
}
set elements [$node selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
::log::logsubst debug {\t element list is {$elements} partList {$partList}}
foreach element $elements {
set ::elementName [$element asXML]
::log::logsubst debug {\t\t Processing element {[$element nodeName]}}
set elementsFound 1
set typeAttribute ""
if {[$element hasAttribute ref]} {
set partType [$element getAttribute ref]
::log::logsubst debug {\t\t has a ref of {$partType}}
if {[catch {
set refTypeInfo [split $partType {:}]
set partName [lindex $refTypeInfo end]
set refNS [lindex $refTypeInfo 0]
if {[string equal $refNS {}]} {
set partType $tns:$partType
}
##
## Convert the reference to the local tns space
##
set partType [getQualifiedType $results $partType $tns]
set refTypeInfo [GetServiceTypeDef $mode $serviceName $partType]
log::logsubst debug {looking up ref {$partType} got {$refTypeInfo}}
if {![llength $refTypeInfo]} {
error "lookup failed"
}
if {[dict exists $refTypeInfo definition]} {
set refTypeInfo [dict get $refTypeInfo definition]
}
set tmpList [dict keys $refTypeInfo]
|
| ︙ | ︙ | |||
3837 3838 3839 3840 3841 3842 3843 |
## Not a simple element, so point type to type of same name as element
##
set partType [getQualifiedType $results $partName $tns]
}
}
} msg]} {
lappend unkownRef($partType) $typeName
| | | | | | 3857 3858 3859 3860 3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 3875 3876 3877 3878 3879 3880 3881 3882 3883 3884 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 |
## Not a simple element, so point type to type of same name as element
##
set partType [getQualifiedType $results $partName $tns]
}
}
} msg]} {
lappend unkownRef($partType) $typeName
log::logsubst debug {Unknown ref {$partType,$typeName} error: {$msg} trace: $::errorInfo}
return \
-code error \
-errorcode [list WS $mode UNKREF [list $typeName $partType]] \
"Unknown forward type reference {$partType} in {$typeName}"
}
} else {
::log::logsubst debug {\t\t\t has no ref has {[$element attributes]}}
set childList [$element selectNodes -namespaces $nsList xs:complexType/xs:sequence/xs:element]
::log::logsubst debug {\t\t\ has no ref has [llength $childList]}
if {[llength $childList]} {
##
## Element defines another element layer
##
set partName [$element getAttribute name]
set partType [getQualifiedType $results $partName $tns]
parseElementalType $mode results $serviceName $element $tns
} else {
set partName [$element getAttribute name]
if {[$element hasAttribute type]} {
set partType [getQualifiedType $results [$element getAttribute type] $tns]
} else {
set partType xs:string
}
}
}
set partMax [$element getAttribute maxOccurs -1]
::log::logsubst debug {\t\t\t part is {$partName} {$partType} {$partMax}}
if {[string equal $partMax -1]} {
set partMax [[$element parent] getAttribute maxOccurs -1]
}
if {$partMax <= 1} {
lappend partList $partName [list type $partType comment {}]
} else {
|
| ︙ | ︙ | |||
3987 3988 3989 3990 3991 3992 3993 |
#
#
###########################################################################
proc ::WS::Utils::parseSimpleType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable nsList
| | | | | 4007 4008 4009 4010 4011 4012 4013 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 |
#
#
###########################################################################
proc ::WS::Utils::parseSimpleType {mode dictVar serviceName node tns} {
upvar 1 $dictVar results
variable nsList
::log::logsubst debug {Entering [info level 0]}
set typeName [$node getAttribute name]
if {$typeName in {SAP_VALID_FROM}} {
set foo 1
}
set isList no
::log::logsubst debug {Simple Type is $typeName}
if {[string length [::WS::Utils::GetServiceTypeDef $mode $serviceName $tns:$typeName]]} {
::log::logsubst debug {\t Type $tns:$typeName is already defined -- leaving}
return
}
#puts "Simple Type is $typeName"
set restrictionNode [$node selectNodes -namespaces $nsList xs:restriction]
if {[string equal $restrictionNode {}]} {
set restrictionNode [$node selectNodes -namespaces $nsList xs:simpleType/xs:restriction]
}
|
| ︙ | ︙ | |||
4045 4046 4047 4048 4049 4050 4051 |
if {[llength $enumList]} {
lappend partList enumeration $enumList
}
if {![dict exists $results types $tns:$typeName]} {
ServiceSimpleTypeDef $mode $serviceName $tns:$typeName $partList $tns
dict set results simpletypes $tns:$typeName $partList
} else {
| | | 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 |
if {[llength $enumList]} {
lappend partList enumeration $enumList
}
if {![dict exists $results types $tns:$typeName]} {
ServiceSimpleTypeDef $mode $serviceName $tns:$typeName $partList $tns
dict set results simpletypes $tns:$typeName $partList
} else {
::log::logsubst debug {\t type already exists as $tns:$typeName}
}
}
###########################################################################
#
|
| ︙ | ︙ | |||
4443 4444 4445 4446 4447 4448 4449 |
lassign $typePartsList tmpTns tmpType
if {[dict exists $serviceInfo tnsList tns $tmpTns]} {
set result [dict get $serviceInfo tnsList tns $tmpTns]:$tmpType
} elseif {[dict exists $serviceInfo types $type]} {
set result $type
} else {
::log::log error $serviceInfo
| | | 4463 4464 4465 4466 4467 4468 4469 4470 4471 4472 4473 4474 4475 4476 4477 |
lassign $typePartsList tmpTns tmpType
if {[dict exists $serviceInfo tnsList tns $tmpTns]} {
set result [dict get $serviceInfo tnsList tns $tmpTns]:$tmpType
} elseif {[dict exists $serviceInfo types $type]} {
set result $type
} else {
::log::log error $serviceInfo
::log::logsubst error {Could not find tns '$tmpTns' in '[dict get $serviceInfo tnsList tns]' for type {$type}}
set result $tns:$type
return -code error
}
}
return $result
}
|
| ︙ | ︙ | |||
4496 4497 4498 4499 4500 4501 4502 |
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::GenerateTemplateDict {mode serviceName type {arraySize 2}} {
variable generatedTypes
| | | | 4516 4517 4518 4519 4520 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 4536 |
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::GenerateTemplateDict {mode serviceName type {arraySize 2}} {
variable generatedTypes
::log::logsubst debug {Entering [info level 0]}
unset -nocomplain -- generatedTypes
set result [_generateTemplateDict $mode $serviceName $type $arraySize]
unset -nocomplain -- generatedTypes
::log::logsubst debug {Leaving [info level 0] with {$result}}
return $result
}
###########################################################################
#
# Private Procedure Header - as this procedure is modified, please be sure
|
| ︙ | ︙ | |||
4554 4555 4556 4557 4558 4559 4560 |
###########################################################################
proc ::WS::Utils::_generateTemplateDict {mode serviceName type arraySize {xns {}}} {
variable typeInfo
variable mutableTypeInfo
variable options
variable generatedTypes
| | | | | | | | 4574 4575 4576 4577 4578 4579 4580 4581 4582 4583 4584 4585 4586 4587 4588 4589 4590 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 4623 4624 4625 4626 4627 4628 4629 4630 4631 4632 4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 |
###########################################################################
proc ::WS::Utils::_generateTemplateDict {mode serviceName type arraySize {xns {}}} {
variable typeInfo
variable mutableTypeInfo
variable options
variable generatedTypes
::log::logsubst debug {Entering [info level 0]}
set results {}
##
## Check for circular reference
##
if {[info exists generatedTypes([list $mode $serviceName $type])]} {
set results {<** Circular Reference **>}
::log::logsubst debug {Leaving [info level 0] with {$results}}
return $results
} else {
set generatedTypes([list $mode $serviceName $type]) 1
}
set type [string trimright $type {?}]
# set typeDefInfo [dict get $typeInfo $mode $serviceName $type]
set typeDefInfo [GetServiceTypeDef $mode $serviceName $type]
if {![llength $typeDefInfo]} {
## We failed to locate the type. try with the last known xns...
set typeDefInfo [GetServiceTypeDef $mode $serviceName ${xns}:$type]
}
::log::logsubst debug {\t type def = {$typeDefInfo}}
set xns [dict get $typeDefInfo xns]
##
## Check for mutable type
##
if {[info exists mutableTypeInfo([list $mode $serviceName $type])]} {
set results {<** Mutable Type **>}
::log::logsubst debug {Leaving [info level 0] with {$results}}
return $results
}
if {![dict exists $typeDefInfo definition]} {
## This is a simple type, simulate a type definition...
if {![dict exists $typeDefInfo type]} {
if {[dict exists $typeDefInfo baseType]} {
dict set typeDefInfo type [dict get $typeDefInfo baseType]
} else {
dict set typeDefInfo type xs:string
}
}
set typeDefInfo [dict create definition [dict create $type $typeDefInfo]]
}
set partsList [dict keys [dict get $typeDefInfo definition]]
::log::logsubst debug {\t partsList is {$partsList}}
foreach partName $partsList {
set partType [string trimright [dict get $typeDefInfo definition $partName type] {?}]
set partXns $xns
catch {set partXns [dict get $typeInfo $mode $serviceName $partType xns]}
set typeInfoList [TypeInfo $mode $serviceName $partType]
set isArray [lindex $typeInfoList end]
::log::logsubst debug {\tpartName $partName partType $partType xns $xns typeInfoList $typeInfoList}
switch -exact -- $typeInfoList {
{0 0} {
##
## Simple non-array
##
set msg {Simple non-array}
## Is there an enumenration?
|
| ︙ | ︙ | |||
4665 4666 4667 4668 4669 4670 4671 |
default {
##
## Placed here to shut up tclchecker
##
}
}
}
| | | 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 |
default {
##
## Placed here to shut up tclchecker
##
}
}
}
::log::logsubst debug {Leaving [info level 0] with {$results}}
return $results
}
###########################################################################
|
| ︙ | ︙ | |||
4766 4767 4768 4769 4770 4771 4772 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 02/24/2011 G. Lester Initial version
# 2.3.10 11/09/2015 H. Oehlmann Allow only 5 redirects (loop protection)
#
###########################################################################
proc ::WS::Utils::geturl_followRedirects {url args} {
| | | | | | | | 4786 4787 4788 4789 4790 4791 4792 4793 4794 4795 4796 4797 4798 4799 4800 4801 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 |
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 02/24/2011 G. Lester Initial version
# 2.3.10 11/09/2015 H. Oehlmann Allow only 5 redirects (loop protection)
#
###########################################################################
proc ::WS::Utils::geturl_followRedirects {url args} {
::log::logsubst debug {[info level 0]}
set initialUrl $url
set finalUrl $url
array set URI [::uri::split $url] ;# Need host info from here
for {set loop 1} {$loop <=5} {incr loop} {
if {[llength $args]} {
::log::logsubst info {[concat [list ::http::geturl $url] $args]}
set token [eval [list http::geturl $url] $args]
} else {
::log::logsubst info {::http::geturl $url}
set token [::http::geturl $url]
}
set ncode [::http::ncode $token]
::log::logsubst info {ncode = $ncode}
if {![string match {30[12378]} $ncode]} {
::log::logsubst debug {initialUrl = $initialUrl, finalUrl = $finalUrl}
if {![string equal $finalUrl {}]} {
::log::log debug "Getting initial URL directory"
set lastPos [string last / $initialUrl]
set initialUrlDir [string range $initialUrl 0 [expr {$lastPos - 1}]]
set lastPos [string last / $finalUrl]
set finalUrlDir [string range $finalUrl 0 [expr {$lastPos - 1}]]
::log::logsubst debug {initialUrlDir = $initialUrlDir, finalUrlDir = $finalUrlDir}
set ::WS::Utils::redirectArray($initialUrlDir) $finalUrlDir
}
return $token
} elseif {![string match {20[1237]} $ncode]} {
return $token
}
# http code announces redirect (3xx)
|
| ︙ | ︙ | |||
4810 4811 4812 4813 4814 4815 4816 |
array unset meta
::http::cleanup $token
if {[string equal $uri(host) {}]} {
set uri(host) $URI(host)
}
# problem w/ relative versus absolute paths
set url [eval ::uri::join [array get uri]]
| | | 4830 4831 4832 4833 4834 4835 4836 4837 4838 4839 4840 4841 4842 4843 4844 |
array unset meta
::http::cleanup $token
if {[string equal $uri(host) {}]} {
set uri(host) $URI(host)
}
# problem w/ relative versus absolute paths
set url [eval ::uri::join [array get uri]]
::log::logsubst debug {url = $url}
set finalUrl $url
}
# > 5 redirects reached -> exit with error
return -errorcode [list WS CLIENT REDIRECTLIMIT $url]\
-code error "http redirect limit exceeded for $url"
}
###########################################################################
|
| ︙ | ︙ | |||
4862 4863 4864 4865 4866 4867 4868 |
# 1 11/08/2015 H.Oehlmann Initial version
#
###########################################################################
proc ::WS::Utils::geturl_fetchbody {args} {
set codeOkList {200}
set codeVar ""
set bodyAlwaysOk 0
| | | 4882 4883 4884 4885 4886 4887 4888 4889 4890 4891 4892 4893 4894 4895 4896 |
# 1 11/08/2015 H.Oehlmann Initial version
#
###########################################################################
proc ::WS::Utils::geturl_fetchbody {args} {
set codeOkList {200}
set codeVar ""
set bodyAlwaysOk 0
::log::logsubst info {Entering [info level 0]}
if {[lindex $args 0] eq "-codeok"} {
set codeOkList [lindex $args 1]
set args [lrange $args 2 end]
}
if {[lindex $args 0] eq "-codevar"} {
set codeVar [lindex $args 1]
set args [lrange $args 2 end]
|
| ︙ | ︙ | |||
4895 4896 4897 4898 4899 4900 4901 |
set ncode [::http::ncode $token]
set body [::http::data $token]
::http::cleanup $token
if {$bodyAlwaysOk && ![string equal $body ""]
|| -1 != [lsearch $codeOkList $ncode]
} {
# >> Fetch ok
| | | | | 4915 4916 4917 4918 4919 4920 4921 4922 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 |
set ncode [::http::ncode $token]
set body [::http::data $token]
::http::cleanup $token
if {$bodyAlwaysOk && ![string equal $body ""]
|| -1 != [lsearch $codeOkList $ncode]
} {
# >> Fetch ok
::log::logsubst debug {\tReceived: $body}
return $body
}
::log::logsubst debug {\tHTTP error: Wrong code $ncode or no data}
return -code error -errorcode [list WS CLIENT HTTPERROR $ncode]\
"HTTP failure code $ncode"
}
::log::logsubst debug {\tHTTP error [array get $token]}
set error [::http::error $token]
::http::cleanup $token
return -errorcode [list WS CLIENT HTTPERROR $error]\
-code error "HTTP error: $error"
}
|
Changes to pkgIndex.tcl.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 | # full path name of this file's directory. package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]] package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]] package ifneeded WS::Client 2.5.0 [list source [file join $dir ClientSide.tcl]] package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]] package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]] | | | 9 10 11 12 13 14 15 16 17 18 | # full path name of this file's directory. package ifneeded WS::AOLserver 2.4.0 [list source [file join $dir AOLserver.tcl]] package ifneeded WS::Channel 2.4.0 [list source [file join $dir ChannelServer.tcl]] package ifneeded WS::Client 2.5.0 [list source [file join $dir ClientSide.tcl]] package ifneeded WS::Embeded 2.4.0 [list source [file join $dir Embedded.tcl]] package ifneeded WS::Server 2.4.0 [list source [file join $dir ServerSide.tcl]] package ifneeded WS::Utils 2.4.1 [list source [file join $dir Utilities.tcl]] package ifneeded WS::Wub 2.4.0 [list source [file join $dir WubServer.tcl]] package ifneeded Wsdl 2.4.0 [list source [file join $dir WubServer.tcl]] |