Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Fix bug with barewords in ClientSide & enforceRequired |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | rfe-9c6ff35e39 | fwr-jsonrest-changes |
| Files: | files | file ages | folders |
| SHA1: |
9fba0d2efcdfda9d6341e8fab819d63e |
| User & Date: | jeff.lawson 2017-04-06 21:51:31 |
Context
| 2017-04-11 16:21 | Merge JSON REST changes into trunk. Ticket [9c6ff35e39] check-in: 2b869c069e user: gerald tags: trunk, Release_2.4.0 | |
| 2017-04-06 21:51 | Fix bug with barewords in ClientSide & enforceRequired Closed-Leaf check-in: 9fba0d2efc user: jeff.lawson tags: rfe-9c6ff35e39, fwr-jsonrest-changes | |
| 2017-04-05 22:50 | remove unintentional proprietary code inclusion check-in: 36a8a04e9e user: jeff.lawson tags: fwr-jsonrest-changes | |
Changes
Changes to ClientSide.tcl.
929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 .... 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 .... 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 .... 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 .... 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 .... 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 .... 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 .... 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 .... 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 .... 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 |
https {
if {[llength $headers]} {
set token [::WS::Utils::geturl_followRedirects $url -headers $headers]
} else {
set token [::WS::Utils::geturl_followRedirects $url]
}
::http::wait $token
if {[::http::status $token] ne ok ||
[::http::ncode $token] != 200} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo [FormatHTTPError $token]
::http::cleanup $token
return \
-code error \
-errorcode $errorCode \
................................................................................
::http::wait $token
##
## Check for errors
##
set body [::http::data $token]
::log::log info "\nReceived: $body"
if {[::http::status $token] ne ok ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set results [FormatHTTPError $token]
set hadError 1
} else {
set hadError 0
................................................................................
}
::http::wait $token
##
## Check for errors
##
set httpStatus [::http::status $token]
if {$httpStatus eq ok && [::http::ncode $token] == 500} {
set body [::http::data $token]
::log::log debug "\tReceived: $body"
set outTransform [dict get $serviceInfo outTransform]
if {$outTransform ne {}} {
SaveAndSetOptions $serviceName
catch {set body [$outTransform $serviceName $operationName REPLY $body]}
RestoreSavedOptions $serviceName
................................................................................
set hadError 1
} else {
::log::log debug "Reply was $body"
set errorCode $::errorCode
set errorInfo $::errorInfo
}
}
} elseif {$httpStatus ne ok || [::http::ncode $token] != 200} {
::log::log debug "\tHTTP error [array get $token]"
set results [FormatHTTPError $token]
set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set hadError 1
} else {
set body [::http::data $token]
................................................................................
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 06/02/2015 H.Oehlmann Initial version
#
#
###########################################################################
proc ::WS::Client::FormatHTTPError {token} {
if {[::http::status $token] eq ok} {
if {[::http::size $token] == 0} {
return "HTTP failure socket closed"
}
return "HTTP failure code [::http::ncode $token]"
} else {
return "HTTP error: [::http::error $token]"
}
................................................................................
##
## Check for errors
##
set body [::http::data $token]
::log::log info "\nReceived: $body"
set results {}
if {[::http::status $token] ne ok ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set hadError 1
set errorInfo [FormatHTTPError $token]
} else {
SaveAndSetOptions $serviceName
if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
................................................................................
}
set style [$styleNode getAttribute style]
#puts "Using style for first operation {$style}"
} else {
set style $tmpStyle
#puts "Using style for first binding {$style}"
}
if {!($style eq document || $style eq rpc)} {
::log:::log debug "Leaving [lindex [info level 0] 0] with error @1"
return \
-code error \
-errorcode [list WS CLIENT UNSSTY $style] \
"Unsupported calling style: '$style'"
}
if {![info exists use]} {
set use [[$binding selectNodes {w:operation[1]/w:input/d:body}] getAttribute use]
if {!($style eq document && $use eq literal) &&
!($style eq rpc && $use eq encoded)} {
::log:::log debug "Leaving [lindex [info level 0] 0] with error @2"
return \
-code error \
-errorcode [list WS CLIENT UNSMODE $use] \
"Unsupported mode: $style/$use"
}
}
................................................................................
}
::http::wait $token
##
## Check for errors
##
set body [::http::data $token]
if {[::http::status $token] ne ok ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set results [FormatHTTPError $token]
set hadError 1
} else {
set hadError 0
................................................................................
## Check for errors
##
set body [::http::data $token]
::log::log info "\tReceived: $body"
set httpStatus [::http::status $token]
set hadError 0
set results {}
if {$httpStatus ne ok ||
( [::http::ncode $token] != 200 && $body eq {} )} {
::log::log debug "\tHTTP error [array get $token]"
set results [FormatHTTPError $token]
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set hadError 1
} else {
................................................................................
::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $objectName $operationName $succesCmd $errorCmd $token}"
##
## Check for errors
##
set body [::http::data $token]
::log::log info "\nReceived: $body"
if {[::http::status $token] ne ok ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set hadError 1
set errorInfo [FormatHTTPError $token]
} else {
SaveAndSetOptions $serviceName
if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
|
| | | | | | | | | | | | |
929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 .... 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 .... 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 .... 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 .... 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 .... 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 .... 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 .... 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 .... 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 .... 3761 3762 3763 3764 3765 3766 3767 3768 3769 3770 3771 3772 3773 3774 3775 |
https {
if {[llength $headers]} {
set token [::WS::Utils::geturl_followRedirects $url -headers $headers]
} else {
set token [::WS::Utils::geturl_followRedirects $url]
}
::http::wait $token
if {[::http::status $token] ne {ok} ||
[::http::ncode $token] != 200} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo [FormatHTTPError $token]
::http::cleanup $token
return \
-code error \
-errorcode $errorCode \
................................................................................
::http::wait $token
##
## Check for errors
##
set body [::http::data $token]
::log::log info "\nReceived: $body"
if {[::http::status $token] ne {ok} ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set results [FormatHTTPError $token]
set hadError 1
} else {
set hadError 0
................................................................................
}
::http::wait $token
##
## Check for errors
##
set httpStatus [::http::status $token]
if {$httpStatus eq {ok} && [::http::ncode $token] == 500} {
set body [::http::data $token]
::log::log debug "\tReceived: $body"
set outTransform [dict get $serviceInfo outTransform]
if {$outTransform ne {}} {
SaveAndSetOptions $serviceName
catch {set body [$outTransform $serviceName $operationName REPLY $body]}
RestoreSavedOptions $serviceName
................................................................................
set hadError 1
} else {
::log::log debug "Reply was $body"
set errorCode $::errorCode
set errorInfo $::errorInfo
}
}
} elseif {$httpStatus ne {ok} || [::http::ncode $token] != 200} {
::log::log debug "\tHTTP error [array get $token]"
set results [FormatHTTPError $token]
set errorCode [list WSCLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set hadError 1
} else {
set body [::http::data $token]
................................................................................
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 06/02/2015 H.Oehlmann Initial version
#
#
###########################################################################
proc ::WS::Client::FormatHTTPError {token} {
if {[::http::status $token] eq {ok}} {
if {[::http::size $token] == 0} {
return "HTTP failure socket closed"
}
return "HTTP failure code [::http::ncode $token]"
} else {
return "HTTP error: [::http::error $token]"
}
................................................................................
##
## Check for errors
##
set body [::http::data $token]
::log::log info "\nReceived: $body"
set results {}
if {[::http::status $token] ne {ok} ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set hadError 1
set errorInfo [FormatHTTPError $token]
} else {
SaveAndSetOptions $serviceName
if {[catch {set hadError [catch {parseResults $serviceName $operationName $body} results]} err]} {
................................................................................
}
set style [$styleNode getAttribute style]
#puts "Using style for first operation {$style}"
} else {
set style $tmpStyle
#puts "Using style for first binding {$style}"
}
if {!($style eq {document} || $style eq {rpc} )} {
::log:::log debug "Leaving [lindex [info level 0] 0] with error @1"
return \
-code error \
-errorcode [list WS CLIENT UNSSTY $style] \
"Unsupported calling style: '$style'"
}
if {![info exists use]} {
set use [[$binding selectNodes {w:operation[1]/w:input/d:body}] getAttribute use]
if {!($style eq {document} && $use eq {literal} ) &&
!($style eq {rpc} && $use eq {encoded} )} {
::log:::log debug "Leaving [lindex [info level 0] 0] with error @2"
return \
-code error \
-errorcode [list WS CLIENT UNSMODE $use] \
"Unsupported mode: $style/$use"
}
}
................................................................................
}
::http::wait $token
##
## Check for errors
##
set body [::http::data $token]
if {[::http::status $token] ne {ok} ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set results [FormatHTTPError $token]
set hadError 1
} else {
set hadError 0
................................................................................
## Check for errors
##
set body [::http::data $token]
::log::log info "\tReceived: $body"
set httpStatus [::http::status $token]
set hadError 0
set results {}
if {$httpStatus ne {ok} ||
( [::http::ncode $token] != 200 && $body eq {} )} {
::log::log debug "\tHTTP error [array get $token]"
set results [FormatHTTPError $token]
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set errorInfo {}
set hadError 1
} else {
................................................................................
::log::log debug "Entering ::WS::Client::asyncCallDone {$serviceName $objectName $operationName $succesCmd $errorCmd $token}"
##
## Check for errors
##
set body [::http::data $token]
::log::log info "\nReceived: $body"
if {[::http::status $token] ne {ok} ||
( [::http::ncode $token] != 200 && $body eq {} )} {
set errorCode [list WS CLIENT HTTPERROR [::http::code $token]]
set hadError 1
set errorInfo [FormatHTTPError $token]
} else {
SaveAndSetOptions $serviceName
if {[catch {set hadError [catch {parseRestResults $serviceName $objectName $operationName $body} results]} err]} {
|
Changes to ServerSide.tcl.
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
....
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
|
switch -exact -- $flavor {
rest {
set doc [yajl create #auto -beautify $serviceData(-beautifyJson)]
$doc map_open
::WS::Utils::convertDictToJson Server $serviceName $doc $results ${serviceName}:${operation}Results
$doc map_close
set output [$doc get]
$doc delete
}
soap {
if {[info exists ::Config(docRoot)] && [file exists [file join $::Config(docRoot) $serviceName $operation.css]]} {
................................................................................
"xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \
xmlns:$serviceName "http://$serviceData(-host)$serviceData(-prefix)"
if {[llength $serviceData(-outheaders)]} {
$env appendChild [$doc createElement "SOAP-ENV:Header" header]
foreach headerType $serviceData(-outheaders) {
#$header appendChild [$doc createElement ${serviceName}:${headerType} part]
#::WS::Utils::convertDictToType Server $serviceName $doc $part $results $headerType
::WS::Utils::convertDictToType Server $serviceName $doc $header $results $headerType
}
}
$env appendChild [$doc createElement "SOAP-ENV:Body" body]
$body appendChild [$doc createElement ${serviceName}:${operation}Results reply]
::WS::Utils::convertDictToType Server $serviceName $doc $reply $results ${serviceName}:${operation}Results
append output \
{<?xml version="1.0" encoding="utf-8"?>} \
"\n" \
[$doc asXML -indent none -doctypeDeclaration 0]
#regsub "<!DOCTYPE\[^>\]*>\n" [::dom::DOMImplementation serialize $doc] $replaceText xml
$doc delete
|
|
|
|
|
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
....
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
|
switch -exact -- $flavor {
rest {
set doc [yajl create #auto -beautify $serviceData(-beautifyJson)]
$doc map_open
::WS::Utils::convertDictToJson Server $serviceName $doc $results ${serviceName}:${operation}Results $serviceData(-enforceRequired)
$doc map_close
set output [$doc get]
$doc delete
}
soap {
if {[info exists ::Config(docRoot)] && [file exists [file join $::Config(docRoot) $serviceName $operation.css]]} {
................................................................................
"xmlns:SOAP-ENC" "http://schemas.xmlsoap.org/soap/encoding/" \
xmlns:$serviceName "http://$serviceData(-host)$serviceData(-prefix)"
if {[llength $serviceData(-outheaders)]} {
$env appendChild [$doc createElement "SOAP-ENV:Header" header]
foreach headerType $serviceData(-outheaders) {
#$header appendChild [$doc createElement ${serviceName}:${headerType} part]
#::WS::Utils::convertDictToType Server $serviceName $doc $part $results $headerType
::WS::Utils::convertDictToType Server $serviceName $doc $header $results $headerType 0 $serviceData(-enforceRequired)
}
}
$env appendChild [$doc createElement "SOAP-ENV:Body" body]
$body appendChild [$doc createElement ${serviceName}:${operation}Results reply]
::WS::Utils::convertDictToType Server $serviceName $doc $reply $results ${serviceName}:${operation}Results 0 $serviceData(-enforceRequired)
append output \
{<?xml version="1.0" encoding="utf-8"?>} \
"\n" \
[$doc asXML -indent none -doctypeDeclaration 0]
#regsub "<!DOCTYPE\[^>\]*>\n" [::dom::DOMImplementation serialize $doc] $replaceText xml
$doc delete
|
Changes to Utilities.tcl.
1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 .... 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 .... 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 .... 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 .... 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 .... 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 .... 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 .... 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 .... 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 .... 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 .... 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 .... 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 |
#
# 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}} {
::log::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type"
# ::log::log debug " Parent xml: [$parent asXML]"
variable typeInfo
variable simpleTypes
variable options
variable standardAttributes
variable currentNs
array set serviceData $::WS::Server::serviceArr($service)
if {!$options(UseNS)} {
return [::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent $dict $type]
}
if {$options(valueAttrCompatiblityMode)} {
set valueAttr {}
} else {
set valueAttr {::value}
}
................................................................................
set itemType [dict get $itemDef type]
::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
set typeInfoList [TypeInfo $mode $service $itemType 1]
::log::log debug "Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]"
if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
::log::log 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 {$serviceData(-enforceRequired) && ![lindex $typeInfoList 2]} {
error "Required field $itemName is missing from response"
}
continue
} elseif {[dict exists $dict $baseName]} {
set useName $baseName
} else {
set useName $itemName
................................................................................
}
} else {
set resultValue [dict get $dict $useName]
}
if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
set tmpNs $currentNs
set currentNs $itemXns
convertDictToType $mode $service $doc $retNode $resultValue $itemType
} else {
convertDictToType $mode $service $doc $retNode $resultValue $itemType
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
}
{1 1} {
##
................................................................................
set tmpType "[string trimright $itemType {()?}]?"
} else {
set tmpType [string trimright $itemType {()}]
}
if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
set tmpNs $currentNs
set currentNs $itemXns
convertDictToType $mode $service $doc $retNode $resultValue $tmpType
} else {
convertDictToType $mode $service $doc $retNode $resultValue $tmpType
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
}
}
default {
................................................................................
#
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 03/23/2011 J.Lawson Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToJson {mode service doc dict type} {
::log::log debug "Entering ::WS::Utils::convertDictToJson $mode $service $doc {$dict} $type"
variable typeInfo
variable simpleTypes
variable simpleTypesJson
variable options
variable standardAttributes
array set serviceData $::WS::Server::serviceArr($service)
set typeInfoList [TypeInfo $mode $service $type]
set type [string trimright $type {?}]
if {[dict exists $typeInfo $mode $service $service:$type]} {
set typeName $service:$type
} else {
set typeName $type
}
................................................................................
set fieldList {}
foreach {itemName itemDef} $itemList {
lappend fieldList $itemName
set itemType [dict get $itemDef type]
::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType = {$itemType}"
set typeInfoList [TypeInfo $mode $service $itemType 1]
if {![dict exists $dict $itemName]} {
if {$serviceData(-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 {()?}])
................................................................................
}
{1 0} {
##
## Non-simple non-array
##
$doc string $itemName map_open
set resultValue [dict get $dict $itemName]
convertDictToJson $mode $service $doc $resultValue $itemType
$doc map_close
}
{1 1} {
##
## Non-simple array
##
set dataList [dict get $dict $itemName]
................................................................................
if {[string index $itemType end] eq {?}} {
set tmpType "[string trimright $itemType {()?}]?"
} else {
set tmpType [string trimright $itemType {()}]
}
foreach row $dataList {
$doc map_open
convertDictToJson $mode $service $doc $row $tmpType
$doc map_close
}
$doc array_close
}
}
}
return;
................................................................................
#
# Version Date Programmer Comments / Changes / Reasons
# ------- ---------- ---------- -------------------------------------------
# 1 07/06/2006 G.Lester Initial version
#
#
###########################################################################
proc ::WS::Utils::convertDictToTypeNoNs {mode service doc parent dict type} {
::log::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
# ::log::log debug " Parent xml: [$parent asXML]"
variable typeInfo
variable simpleTypes
variable options
variable standardAttributes
array set serviceData $::WS::Server::serviceArr($service)
if {$options(valueAttrCompatiblityMode)} {
set valueAttr {}
} else {
set valueAttr {::value}
}
set typeInfoList [TypeInfo $mode $service $type]
if {[lindex $typeInfoList 0]} {
................................................................................
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 {$serviceData(-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"} {
................................................................................
}
} else {
set resultValue [dict get $dict $itemName]
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $itemType
}
{1 1} {
##
## Non-simple array
##
set dataList [dict get $dict $itemName]
set tmpType [string trimright $itemType {()}]
................................................................................
}
} else {
set resultValue $row
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $tmpType
}
}
default {
##
## Placed here to shut up tclchecker
##
}
|
| < | | | | | | | < | | | | < | | | |
1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 .... 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 .... 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 .... 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 .... 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 .... 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 .... 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 .... 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 .... 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 .... 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 .... 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 .... 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 |
#
# 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::log debug "Entering ::WS::Utils::convertDictToType $mode $service $doc $parent {$dict} $type"
# ::log::log 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 itemType [dict get $itemDef type]
::log::log debug "\t\titemName = {$itemName} itemDef = {$itemDef} itemType ={$itemType}"
set typeInfoList [TypeInfo $mode $service $itemType 1]
::log::log debug "Expr [list ![dict exists $dict $itemName] && ![dict exists $dict $baseName]]"
if {![dict exists $dict $itemName] && ![dict exists $dict $baseName]} {
::log::log 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
} else {
set useName $itemName
................................................................................
}
} else {
set resultValue [dict get $dict $useName]
}
if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
set tmpNs $currentNs
set currentNs $itemXns
convertDictToType $mode $service $doc $retNode $resultValue $itemType $forceNs $enforceRequired
} else {
convertDictToType $mode $service $doc $retNode $resultValue $itemType $forceNs $enforceRequired
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
}
{1 1} {
##
................................................................................
set tmpType "[string trimright $itemType {()?}]?"
} else {
set tmpType [string trimright $itemType {()}]
}
if {![string equal $currentNs $itemXns] && ![string equal $itemXns {}]} {
set tmpNs $currentNs
set currentNs $itemXns
convertDictToType $mode $service $doc $retNode $resultValue $tmpType $forceNs $enforceRequired
} else {
convertDictToType $mode $service $doc $retNode $resultValue $tmpType $forceNs $enforceRequired
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
}
}
default {
................................................................................
#
# 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::log debug "Entering ::WS::Utils::convertDictToJson $mode $service $doc {$dict} $type"
variable typeInfo
variable simpleTypes
variable simpleTypesJson
variable options
variable standardAttributes
set typeInfoList [TypeInfo $mode $service $type]
set type [string trimright $type {?}]
if {[dict exists $typeInfo $mode $service $service:$type]} {
set typeName $service:$type
} else {
set typeName $type
}
................................................................................
set fieldList {}
foreach {itemName itemDef} $itemList {
lappend fieldList $itemName
set itemType [dict get $itemDef type]
::log::log 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 {()?}])
................................................................................
}
{1 0} {
##
## Non-simple non-array
##
$doc string $itemName map_open
set resultValue [dict get $dict $itemName]
convertDictToJson $mode $service $doc $resultValue $itemType $enforceRequired
$doc map_close
}
{1 1} {
##
## Non-simple array
##
set dataList [dict get $dict $itemName]
................................................................................
if {[string index $itemType end] eq {?}} {
set tmpType "[string trimright $itemType {()?}]?"
} else {
set tmpType [string trimright $itemType {()}]
}
foreach row $dataList {
$doc map_open
convertDictToJson $mode $service $doc $row $tmpType $enforceRequired
$doc map_close
}
$doc array_close
}
}
}
return;
................................................................................
#
# 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::log debug "Entering ::WS::Utils::convertDictToTypeNoNs $mode $service $doc $parent {$dict} $type"
# ::log::log debug " Parent xml: [$parent asXML]"
variable typeInfo
variable simpleTypes
variable options
variable standardAttributes
if {$options(valueAttrCompatiblityMode)} {
set valueAttr {}
} else {
set valueAttr {::value}
}
set typeInfoList [TypeInfo $mode $service $type]
if {[lindex $typeInfoList 0]} {
................................................................................
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"} {
................................................................................
}
} else {
set resultValue [dict get $dict $itemName]
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $itemType $enforceRequired
}
{1 1} {
##
## Non-simple array
##
set dataList [dict get $dict $itemName]
set tmpType [string trimright $itemType {()}]
................................................................................
}
} else {
set resultValue $row
}
if {[llength $attrList]} {
::WS::Utils::setAttr $retNode $attrList
}
convertDictToTypeNoNs $mode $service $doc $retnode $resultValue $tmpType $enforceRequired
}
}
default {
##
## Placed here to shut up tclchecker
##
}
|