From 0a5741ade7acebf7f37f1a4fcef16341af65747f Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Thu, 13 Nov 2025 05:55:06 +1100 Subject: [PATCH] netbox output format fix --- src/bootsupport/modules/punk/args-0.2.1.tm | 3 +- src/bootsupport/modules/punk/ns-0.1.0.tm | 33 +++++++++++-------- src/modules/punk/netbox-999999.0a1.0.tm | 33 +++++++++++++++---- .../modules/punk/netbox-0.1.0.tm | 33 +++++++++++++++---- 4 files changed, 73 insertions(+), 29 deletions(-) diff --git a/src/bootsupport/modules/punk/args-0.2.1.tm b/src/bootsupport/modules/punk/args-0.2.1.tm index 0dd454e0..e2afc619 100644 --- a/src/bootsupport/modules/punk/args-0.2.1.tm +++ b/src/bootsupport/modules/punk/args-0.2.1.tm @@ -6481,7 +6481,7 @@ tcl::namespace::eval punk::args { } if {[dict exists $thisarg_checks -maxsize]} { set maxsize [dict get $thisarg_checks -maxsize] - if {$checkval ne "-1"} { + if {$maxsize ne "-1"} { if {[tcl::string::length $e_check] > $maxsize} { set msg "$argclass '$argname' for %caller% requires string with -maxsize $maxsize. Received len:[tcl::string::length $e_check] value:'$e_check'" #return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list sizeviolation $type] -badarg $argname -argspecs $argspecs]] $msg @@ -6679,6 +6679,7 @@ tcl::namespace::eval punk::args { upper - wordchar - xdigit { + #todo - combined types xdigit && lower ?? set-theoretic types? how? if {![tcl::string::is $type -strict $e_check]} { set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e'" lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg] diff --git a/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/bootsupport/modules/punk/ns-0.1.0.tm index 9a42ad0b..51350674 100644 --- a/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -2581,9 +2581,10 @@ y" {return quirkykeyscript} #eval_base has been set by previous source or proc #It can also be set by previous eval - *if* a non default offset was returned by _cmdtrace_get_eval_offset + set eval_base [dict get $linedict $target eval_base] set eval_offset [dict get $linedict $target eval_offset] - set line [expr {$prevline + ($eval_offset-1) + ($traceline-1)}] - #puts "stack-- $callinfo" + set line [expr {$eval_base + ($eval_offset-1) + ($traceline-1)}] + puts "stack-- $callinfo" puts " step type: eval traceline: $traceline -- " if {[dict exists $callinfo cmd]} { #set cmd [string trim [dict get $callinfo cmd]] @@ -2653,9 +2654,11 @@ y" {return quirkykeyscript} } #puts "-- $callinfo" } else { - puts ">>step type: $type (nontargeted proc)>> $callinfo" + ::tcl::dict::incr tinfo($target) subcmds + #puts ">>step type: $type (nontargeted proc)>> $callinfo" } } else { + ::tcl::dict::incr tinfo($target) subcmds #todo - handle type 'source' and type 'eval' with keys 'method' 'class' (oo) #puts ------------------------- #puts ">[dict get $callinfo cmd]" @@ -2708,7 +2711,6 @@ y" {return quirkykeyscript} variable tinfo array unset tinfo variable _cmdtrace_disabled - set _cmdtrace_disabled false set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdtrace] lassign [dict values $argd] leaders opts values received @@ -2718,6 +2720,8 @@ y" {return quirkykeyscript} set cinfo [uplevel 1 [list ::punk::ns::cmdinfo {*}$cmdargs]] set origin [dict get $cinfo origin] set arglist [dict get $cinfo args_remaining] + set origin_nscmd [nstail $origin] + set origin_ns [nsprefix $origin] if {[dict exists $received -target]} { set targets [dict get $opts -target] @@ -2740,15 +2744,16 @@ y" {return quirkykeyscript} } #don't raise the error when no -target supplied - as our launch command can contain extra arguments } - lappend resolved_targets $tgt_cmd + set nscmd [nstail $tgt_cmd] + set ns [nsprefix $tgt_cmd] + + lappend resolved_targets $tgt_cmd $ns $nscmd ::tcl::dict::set ::punk::ns::linedict $tgt_cmd [::tcl::dict::create eval_base 1 eval_offset 1 lines {} cmdtype $tgt_type successcalls 0 errorcalls 0] } #if the target command has a leading colon (e.g expr alternative :) we can't put a trace directly on a fully qualified name with a triple colon such as ::: #we will need to evaluate in the namespace - foreach tgt_cmd $resolved_targets { - set nscmd [nstail $tgt_cmd] - set ns [nsprefix $tgt_cmd] + foreach {tgt_cmd ns nscmd} $resolved_targets { puts "tracing target: $tgt_cmd whilst running: $origin $arglist" ::tcl::namespace::eval $ns [list ::trace add execution $nscmd enter [list ::punk::ns::_cmdtrace_enter ::punk::ns::linedict $tgt_cmd]] @@ -2758,17 +2763,17 @@ y" {return quirkykeyscript} try { - set origin_nscmd [nstail $origin] - set origin_ns [nsprefix $origin] #uplevel 1 [list $origin {*}$arglist] + set _cmdtrace_disabled false ::tcl::namespace::eval $origin_ns [list $origin_nscmd {*}$arglist] } trap {} {errMsg errOptions} { + set _cmdtrace_disabled true + #(even a puts can involve function calls - e.g in contexts where there are stacked channels) puts stderr "command error $errMsg" } finally { - foreach tgt_cmd $resolved_targets { - set nscmd [nstail $tgt_cmd] - set ns [nsprefix $tgt_cmd] + set _cmdtrace_disabled true + foreach {tgt_cmd ns nscmd} $resolved_targets { ::tcl::namespace::eval $ns [list ::trace remove execution $nscmd enterstep [list ::punk::ns::_cmdtrace_enterstep ::punk::ns::linedict $tgt_cmd]] ::tcl::namespace::eval $ns [list ::trace remove execution $nscmd enter [list ::punk::ns::_cmdtrace_enter ::punk::ns::linedict $tgt_cmd]] ::tcl::namespace::eval $ns [list ::trace remove execution $nscmd leave [list ::punk::ns::_cmdtrace_leave ::punk::ns::linedict $tgt_cmd]] @@ -2780,7 +2785,7 @@ y" {return quirkykeyscript} append final_display \n #todo - foreach tgt_cmd in resolved_targets? - foreach tgt_cmd $resolved_targets { + foreach {tgt_cmd _ _} $resolved_targets { set lines [dict get $linedict $tgt_cmd lines] if {[llength $lines]} { set procbody [punk::ns::corp -n $tgt_cmd] diff --git a/src/modules/punk/netbox-999999.0a1.0.tm b/src/modules/punk/netbox-999999.0a1.0.tm index 815e4216..69ae875c 100644 --- a/src/modules/punk/netbox-999999.0a1.0.tm +++ b/src/modules/punk/netbox-999999.0a1.0.tm @@ -279,6 +279,14 @@ tcl::namespace::eval punk::netbox::system { dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] if {$returntype in "json jsondump"} { #if we set result json - we get a dict instead of json :/ + #The 'result' key seems to tell ::rest what post-processor to use to translate it *from* that to a tcl dict (or in xml case a nested list) + #sort of.. + #xml - takes xml produces a list + #json - takes json produces a dict + #discard - 'return -code ok' + #auto - *basic* detect xml or json and do as above + #tdom - takes xml - produces a tdom documentElement + #raw - just returns the data dict set config result raw } if {$body in {required optional}} { @@ -352,7 +360,7 @@ tcl::namespace::eval punk::netbox::system { return $ret } default { - #plain result: (list or dict) or json - the counterintuitive 'result' field set to raw above sets the rest resulting format to json + #plain result: (list or dict) or json - the counterintuitive 'result' field set to raw above sets the rest resulting format to the original json return $result } } @@ -463,10 +471,17 @@ tcl::namespace::eval punk::netbox::system { #note our default: result json #this actually converts the json to a dict - set config [dict create\ - format json\ - result json\ - ] + set config [dict create format json result json] + + #The 'result' key seems to tell ::rest what post-processor to use to translate it *from* that to a tcl dict (or in xml case a nested list) + #sort of.. + #xml - takes xml produces a list + #json - takes json produces a dict + #discard - 'return -code ok' + #auto - *basic* detect xml or json and do as above + #tdom - takes xml - produces a tdom documentElement + #raw - just returns the data + dict set config result raw dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] set bodycontrol %bodycontrol% @@ -579,6 +594,7 @@ tcl::namespace::eval punk::netbox::system { set call_data($thisproc,$callid,httptoken) $httptok set call_data($thisproc,$callid,command) $thisproc set call_data($thisproc,$callid,returntype) $returntype + set call_data($thisproc,$callid,config) $config #todo - the actual async part - solo flag -ASYNC ? if {$async} { return $thisproc,$callid @@ -1069,6 +1085,8 @@ tcl::namespace::eval punk::netbox { set resultlist $call_data($asynctoken,result) set returntype $call_data($asynctoken,returntype) + set config $call_data($asynctoken,config) + #status is #OK|ERROR lassign $resultlist status resulttext #resulttext NETBOX ERROR ... @@ -1082,7 +1100,7 @@ tcl::namespace::eval punk::netbox { # set errorbody [lindex $resulttext 5] # if {$errorbody ne ""} { # if {[catch { - # set result [list {*}[lrange $resulttext 0 4] [::rest::format_auto $errorbody]] ;#crude detection of xml/json - REVIEW + # set result [list {*}[lrange $resulttext 0 4] [::rest::format_[dict get $config result] $errorbody]] ;#crude detection of xml/json - REVIEW # #if xml - we don't get a dict - but netbox shouldn't output that anyway. # #would be better just to output raw? # } errM]} { @@ -1112,7 +1130,8 @@ tcl::namespace::eval punk::netbox { if {$resulttext ne ""} { #review - could get nest structure from xml - but not relevant to netbox #parsing json could fail here too - set result [::rest::format_auto $resulttext] + #eg when config result is 'json' - parse json to a dict + set result [::rest::format_[dict get $config result] $resulttext] } else { set result "" } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm index 7c5212ac..5fc0c742 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm @@ -279,6 +279,14 @@ tcl::namespace::eval punk::netbox::system { dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] if {$returntype in "json jsondump"} { #if we set result json - we get a dict instead of json :/ + #The 'result' key seems to tell ::rest what post-processor to use to translate it *from* that to a tcl dict (or in xml case a nested list) + #sort of.. + #xml - takes xml produces a list + #json - takes json produces a dict + #discard - 'return -code ok' + #auto - *basic* detect xml or json and do as above + #tdom - takes xml - produces a tdom documentElement + #raw - just returns the data dict set config result raw } if {$body in {required optional}} { @@ -352,7 +360,7 @@ tcl::namespace::eval punk::netbox::system { return $ret } default { - #plain result: (list or dict) or json - the counterintuitive 'result' field set to raw above sets the rest resulting format to json + #plain result: (list or dict) or json - the counterintuitive 'result' field set to raw above sets the rest resulting format to the original json return $result } } @@ -463,10 +471,17 @@ tcl::namespace::eval punk::netbox::system { #note our default: result json #this actually converts the json to a dict - set config [dict create\ - format json\ - result json\ - ] + set config [dict create format json result json] + + #The 'result' key seems to tell ::rest what post-processor to use to translate it *from* that to a tcl dict (or in xml case a nested list) + #sort of.. + #xml - takes xml produces a list + #json - takes json produces a dict + #discard - 'return -code ok' + #auto - *basic* detect xml or json and do as above + #tdom - takes xml - produces a tdom documentElement + #raw - just returns the data + dict set config result raw dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] set bodycontrol %bodycontrol% @@ -579,6 +594,7 @@ tcl::namespace::eval punk::netbox::system { set call_data($thisproc,$callid,httptoken) $httptok set call_data($thisproc,$callid,command) $thisproc set call_data($thisproc,$callid,returntype) $returntype + set call_data($thisproc,$callid,config) $config #todo - the actual async part - solo flag -ASYNC ? if {$async} { return $thisproc,$callid @@ -1069,6 +1085,8 @@ tcl::namespace::eval punk::netbox { set resultlist $call_data($asynctoken,result) set returntype $call_data($asynctoken,returntype) + set config $call_data($asynctoken,config) + #status is #OK|ERROR lassign $resultlist status resulttext #resulttext NETBOX ERROR ... @@ -1082,7 +1100,7 @@ tcl::namespace::eval punk::netbox { # set errorbody [lindex $resulttext 5] # if {$errorbody ne ""} { # if {[catch { - # set result [list {*}[lrange $resulttext 0 4] [::rest::format_auto $errorbody]] ;#crude detection of xml/json - REVIEW + # set result [list {*}[lrange $resulttext 0 4] [::rest::format_[dict get $config result] $errorbody]] ;#crude detection of xml/json - REVIEW # #if xml - we don't get a dict - but netbox shouldn't output that anyway. # #would be better just to output raw? # } errM]} { @@ -1112,7 +1130,8 @@ tcl::namespace::eval punk::netbox { if {$resulttext ne ""} { #review - could get nest structure from xml - but not relevant to netbox #parsing json could fail here too - set result [::rest::format_auto $resulttext] + #eg when config result is 'json' - parse json to a dict + set result [::rest::format_[dict get $config result] $resulttext] } else { set result "" }