jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

netbox output format fix

master
Julian Noble 2 months ago
parent
e6bfb30ded
commit
0a5741ade7
4 changed files with 73 additions and 29 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 3
      src/bootsupport/modules/punk/args-0.2.1.tm
  2. 33
      src/bootsupport/modules/punk/ns-0.1.0.tm
  3. 33
      src/modules/punk/netbox-999999.0a1.0.tm
  4. 33
      src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm

3
src/bootsupport/modules/punk/args-0.2.1.tm
Unescape View File

@ -6481,7 +6481,7 @@ tcl::namespace::eval punk::args {
} }
if {[dict exists $thisarg_checks -maxsize]} { if {[dict exists $thisarg_checks -maxsize]} {
set maxsize [dict get $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} { 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'" 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 #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 - upper -
wordchar - wordchar -
xdigit { xdigit {
#todo - combined types xdigit && lower ?? set-theoretic types? how?
if {![tcl::string::is $type -strict $e_check]} { if {![tcl::string::is $type -strict $e_check]} {
set msg "$argclass $argname for %caller% requires type '$type'. Received: '$e'" 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] lset clause_results $c_idx $a_idx [list err [list typemismatch $type] msg $msg]

33
src/bootsupport/modules/punk/ns-0.1.0.tm
Unescape View File

@ -2581,9 +2581,10 @@ y" {return quirkykeyscript}
#eval_base has been set by previous source or proc #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 #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 eval_offset [dict get $linedict $target eval_offset]
set line [expr {$prevline + ($eval_offset-1) + ($traceline-1)}] set line [expr {$eval_base + ($eval_offset-1) + ($traceline-1)}]
#puts "stack-- $callinfo" puts "stack-- $callinfo"
puts " step type: eval traceline: $traceline -- " puts " step type: eval traceline: $traceline -- "
if {[dict exists $callinfo cmd]} { if {[dict exists $callinfo cmd]} {
#set cmd [string trim [dict get $callinfo cmd]] #set cmd [string trim [dict get $callinfo cmd]]
@ -2653,9 +2654,11 @@ y" {return quirkykeyscript}
} }
#puts "-- $callinfo" #puts "-- $callinfo"
} else { } else {
puts ">>step type: $type (nontargeted proc)>> $callinfo" ::tcl::dict::incr tinfo($target) subcmds
#puts ">>step type: $type (nontargeted proc)>> $callinfo"
} }
} else { } else {
::tcl::dict::incr tinfo($target) subcmds
#todo - handle type 'source' and type 'eval' with keys 'method' 'class' (oo) #todo - handle type 'source' and type 'eval' with keys 'method' 'class' (oo)
#puts ------------------------- #puts -------------------------
#puts ">[dict get $callinfo cmd]" #puts ">[dict get $callinfo cmd]"
@ -2708,7 +2711,6 @@ y" {return quirkykeyscript}
variable tinfo variable tinfo
array unset tinfo array unset tinfo
variable _cmdtrace_disabled variable _cmdtrace_disabled
set _cmdtrace_disabled false
set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdtrace] set argd [punk::args::parse $args -cache 1 withid ::punk::ns::cmdtrace]
lassign [dict values $argd] leaders opts values received 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 cinfo [uplevel 1 [list ::punk::ns::cmdinfo {*}$cmdargs]]
set origin [dict get $cinfo origin] set origin [dict get $cinfo origin]
set arglist [dict get $cinfo args_remaining] set arglist [dict get $cinfo args_remaining]
set origin_nscmd [nstail $origin]
set origin_ns [nsprefix $origin]
if {[dict exists $received -target]} { if {[dict exists $received -target]} {
set targets [dict get $opts -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 #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] ::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 ::: #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 #we will need to evaluate in the namespace
foreach tgt_cmd $resolved_targets { foreach {tgt_cmd ns nscmd} $resolved_targets {
set nscmd [nstail $tgt_cmd]
set ns [nsprefix $tgt_cmd]
puts "tracing target: $tgt_cmd whilst running: $origin $arglist" 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]] ::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 { try {
set origin_nscmd [nstail $origin]
set origin_ns [nsprefix $origin]
#uplevel 1 [list $origin {*}$arglist] #uplevel 1 [list $origin {*}$arglist]
set _cmdtrace_disabled false
::tcl::namespace::eval $origin_ns [list $origin_nscmd {*}$arglist] ::tcl::namespace::eval $origin_ns [list $origin_nscmd {*}$arglist]
} trap {} {errMsg errOptions} { } 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" puts stderr "command error $errMsg"
} finally { } finally {
foreach tgt_cmd $resolved_targets { set _cmdtrace_disabled true
set nscmd [nstail $tgt_cmd] foreach {tgt_cmd ns nscmd} $resolved_targets {
set ns [nsprefix $tgt_cmd]
::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 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 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]] ::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 append final_display \n
#todo - foreach tgt_cmd in resolved_targets? #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] set lines [dict get $linedict $tgt_cmd lines]
if {[llength $lines]} { if {[llength $lines]} {
set procbody [punk::ns::corp -n $tgt_cmd] set procbody [punk::ns::corp -n $tgt_cmd]

33
src/modules/punk/netbox-999999.0a1.0.tm
Unescape View File

@ -279,6 +279,14 @@ tcl::namespace::eval punk::netbox::system {
dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]]
if {$returntype in "json jsondump"} { if {$returntype in "json jsondump"} {
#if we set result json - we get a dict instead of json :/ #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 dict set config result raw
} }
if {$body in {required optional}} { if {$body in {required optional}} {
@ -352,7 +360,7 @@ tcl::namespace::eval punk::netbox::system {
return $ret return $ret
} }
default { 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 return $result
} }
} }
@ -463,10 +471,17 @@ tcl::namespace::eval punk::netbox::system {
#note our default: result json #note our default: result json
#this actually converts the json to a dict #this actually converts the json to a dict
set config [dict create\ set config [dict create format json result json]
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]]] dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]]
set bodycontrol %bodycontrol% 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,httptoken) $httptok
set call_data($thisproc,$callid,command) $thisproc set call_data($thisproc,$callid,command) $thisproc
set call_data($thisproc,$callid,returntype) $returntype set call_data($thisproc,$callid,returntype) $returntype
set call_data($thisproc,$callid,config) $config
#todo - the actual async part - solo flag -ASYNC ? #todo - the actual async part - solo flag -ASYNC ?
if {$async} { if {$async} {
return $thisproc,$callid return $thisproc,$callid
@ -1069,6 +1085,8 @@ tcl::namespace::eval punk::netbox {
set resultlist $call_data($asynctoken,result) set resultlist $call_data($asynctoken,result)
set returntype $call_data($asynctoken,returntype) set returntype $call_data($asynctoken,returntype)
set config $call_data($asynctoken,config)
#status is #OK|ERROR #status is #OK|ERROR
lassign $resultlist status resulttext lassign $resultlist status resulttext
#resulttext NETBOX ERROR <etype> <ewhat> <errortext|errorbody> <errorstring> ... #resulttext NETBOX ERROR <etype> <ewhat> <errortext|errorbody> <errorstring> ...
@ -1082,7 +1100,7 @@ tcl::namespace::eval punk::netbox {
# set errorbody [lindex $resulttext 5] # set errorbody [lindex $resulttext 5]
# if {$errorbody ne ""} { # if {$errorbody ne ""} {
# if {[catch { # 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. # #if xml - we don't get a dict - but netbox shouldn't output that anyway.
# #would be better just to output raw? # #would be better just to output raw?
# } errM]} { # } errM]} {
@ -1112,7 +1130,8 @@ tcl::namespace::eval punk::netbox {
if {$resulttext ne ""} { if {$resulttext ne ""} {
#review - could get nest structure from xml - but not relevant to netbox #review - could get nest structure from xml - but not relevant to netbox
#parsing json could fail here too #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 { } else {
set result "" set result ""
} }

33
src/vfs/_vfscommon.vfs/modules/punk/netbox-0.1.0.tm
Unescape View File

@ -279,6 +279,14 @@ tcl::namespace::eval punk::netbox::system {
dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]] dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]]
if {$returntype in "json jsondump"} { if {$returntype in "json jsondump"} {
#if we set result json - we get a dict instead of json :/ #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 dict set config result raw
} }
if {$body in {required optional}} { if {$body in {required optional}} {
@ -352,7 +360,7 @@ tcl::namespace::eval punk::netbox::system {
return $ret return $ret
} }
default { 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 return $result
} }
} }
@ -463,10 +471,17 @@ tcl::namespace::eval punk::netbox::system {
#note our default: result json #note our default: result json
#this actually converts the json to a dict #this actually converts the json to a dict
set config [dict create\ set config [dict create format json result json]
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]]] dict set config headers [list Authorization [list Token [dict get $contexts $apicontextid token value]]]
set bodycontrol %bodycontrol% 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,httptoken) $httptok
set call_data($thisproc,$callid,command) $thisproc set call_data($thisproc,$callid,command) $thisproc
set call_data($thisproc,$callid,returntype) $returntype set call_data($thisproc,$callid,returntype) $returntype
set call_data($thisproc,$callid,config) $config
#todo - the actual async part - solo flag -ASYNC ? #todo - the actual async part - solo flag -ASYNC ?
if {$async} { if {$async} {
return $thisproc,$callid return $thisproc,$callid
@ -1069,6 +1085,8 @@ tcl::namespace::eval punk::netbox {
set resultlist $call_data($asynctoken,result) set resultlist $call_data($asynctoken,result)
set returntype $call_data($asynctoken,returntype) set returntype $call_data($asynctoken,returntype)
set config $call_data($asynctoken,config)
#status is #OK|ERROR #status is #OK|ERROR
lassign $resultlist status resulttext lassign $resultlist status resulttext
#resulttext NETBOX ERROR <etype> <ewhat> <errortext|errorbody> <errorstring> ... #resulttext NETBOX ERROR <etype> <ewhat> <errortext|errorbody> <errorstring> ...
@ -1082,7 +1100,7 @@ tcl::namespace::eval punk::netbox {
# set errorbody [lindex $resulttext 5] # set errorbody [lindex $resulttext 5]
# if {$errorbody ne ""} { # if {$errorbody ne ""} {
# if {[catch { # 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. # #if xml - we don't get a dict - but netbox shouldn't output that anyway.
# #would be better just to output raw? # #would be better just to output raw?
# } errM]} { # } errM]} {
@ -1112,7 +1130,8 @@ tcl::namespace::eval punk::netbox {
if {$resulttext ne ""} { if {$resulttext ne ""} {
#review - could get nest structure from xml - but not relevant to netbox #review - could get nest structure from xml - but not relevant to netbox
#parsing json could fail here too #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 { } else {
set result "" set result ""
} }

Write Preview
Loading…
Cancel
Save