@ -66,38 +66,6 @@ package require rest
#*** !doctools #*** !doctools
#[section API] #[section API]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#tcl::namespace::eval punk::netbox::man::class {
#*** !doctools
#[subsection {Namespace punk::netbox::man::class}]
#[para] class definitions
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} {
#*** !doctools
#[list_begin enumerated]
# oo::class create interface_sample1 {
# #*** !doctools
# #[enum] CLASS [class interface_sample1]
# #[list_begin definitions]
# method test {arg1} {
# #*** !doctools
# #[call class::interface_sample1 [method test] [arg arg1]]
# #[para] test method
# puts "test: $arg1"
# }
# #*** !doctools
# #[list_end] [comment {-- end definitions interface_sample1}]
# }
#*** !doctools
#[list_end] [comment {--- end class enumeration ---}]
#}
#}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::netbox::man { tcl::namespace::eval punk::netbox::man {
variable PUNKARGS variable PUNKARGS
@ -926,6 +894,277 @@ tcl::namespace::eval punk::netbox::man::virtualization {
} }
tcl::namespace::eval punk::netbox::man::extras {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
tcl::namespace::eval tags {
namespace export {[a-z]*}
namespace ensemble create -parameters {apicontextid}
variable PUNKARGS
namespace eval argdoc {
variable PUNKARGS
set DYN_CONTEXTNAMES {${[punk::netbox::api_context_names]}}
}
namespace eval argdoc {
lappend PUNKARGS [list\
{@dynamic}\
{
@id -id ::punk::netbox::man::extras::tags::create
@cmd -name punk::netbox::man::extras::tags::create -help\
"extras_tags_create
POST request for endpoint /extras/tags/"
@leaders -min 1 -max 1
apicontextid -help\
"The name of the stored api context to use.
A contextid can be created in-memory using
api_context_create, or loaded from a .toml
file using api_context_load."\
-choices {${$DYN_CONTEXTNAMES}}
@opts
-name -type string -minsize 1 -maxsize 100 -optional 0
-slug -type string -minsize 1 -maxsize 100 -optional 1
#todo - combined xdigit and lower??
-color -type xdigit -maxsize 6 -optional 1 -help\
"Default will be assigned by netbox.
e.g 9e9e9e"
-description -type string -maxsize 200 -default ""
}\
{-RETURN -default table -choices {table tableobject list linelist}}\
{
@values -min 0 -max 0
}
]
}
#example body
# color must be a lower-cased hex string (6 digits)
# e.g a red tag
# {
# "name": "my_tag",
# "slug": "my_tag",
# "color": "ff0000",
# "description": "testing tag creation"
# }
#example 201 response
#{
# "id": 14,
# "url": "https://www.netbox1.intx.com.au/api/extras/tags/14/",
# "display": "jjj",
# "name": "jjj",
# "slug": "jjj",
# "color": "ff0000",
# "description": "j testing",
# "created": "2025-11-11T16:33:17.461484Z",
# "last_updated": "2025-11-11T16:33:17.461500Z"
#}
#example 400 response
#{
# "name": [
# "tag with this name already exists."
# ],
# "slug": [
# "tag with this slug already exists."
# ]
#}
proc create {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::extras::tags::create"]
lassign [dict values $argd] leaders opts values received
set token [dict get $argd leaders apicontextid]
set map [::list \" "\\\"" \\ \\\\ \r \\r \n \\n \t \\t \b \\b \f \\f] ;#review - unicode? tcllib?
set name [dict get $argd opts -name]
if {[dict exists $received -slug]} {
set slug [dict get $opts -slug]
} else {
set slug $name
}
set description [dict get $argd opts -description]
#Escape for JSON
set name [string map $map $name]
set slug [string map $map $slug]
set description [string map $map $description]
set body "\{\n"
append body " \"name\": \"$name\"," \n
append body " \"slug\": \"$slug\"," \n
if {[dict exists $received -color]} {
append body " \"color\": \"[dict get $opts -color]\"," \n
}
append body " \"description\": \"$description\"" \n
append body "\}" \n
puts "Post body JSON:"
puts $body
#todo RETURN
set resultd [punk::netbox::extras::tags_create $token -RETURN dict $body]
}
namespace eval argdoc {
lappend PUNKARGS [list\
{@dynamic}\
{
@id -id ::punk::netbox::man::extras::tags::delete
@cmd -name punk::netbox::man::extras::tags::delete\
-summary\
"Delete one tag by id."\
-help\
"extras_tags_delete
DELETE request for endpoint /extras/tags/{id}
Delete a single tag by id."
@leaders -min 1 -max 1
apicontextid -help\
"The name of the stored api context to use.
A contextid can be created in-memory using
api_context_create, or loaded from a .toml
file using api_context_load."\
-choices {${$DYN_CONTEXTNAMES}}
@opts
@values -min 1 -max 1
id -type integer -range {0 ""}
}
]
}
proc delete {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::extras::tags::delete"]
lassign [dict values $argd] leaders opts values received
set token [dict get $argd leaders apicontextid]
set id [dict get $argd values id]
punk::netbox::extras::tags_delete $token -RETURN dict $id
return done
}
namespace eval argdoc {
lappend PUNKARGS [::list\
{@dynamic}\
[punk::args::resolved_def\
-antiglobs {@leaders @values -RETURN}\
-override {
@id {-id "::punk::netbox::man::extras::tags::list" }
apicontextid {-choices {${$DYN_CONTEXTNAMES}} }
}\
::punk::netbox::extras::tags_list\
]\
{-RETURN -default table -choices {table tableobject list linelist}}\
{-MAXRESULTS -type integer -default -1}\
{@values -min 0 -max 0}\
]
}
proc list {args} {
set argd [punk::args::parse $args withid "::punk::netbox::man::extras::tags::list"]
set urlnext ""
set requests_allowed 1000 ;#Sanity check - consider making an option - review
set resultlist [::list]
set token [dict get $argd leaders apicontextid]
set opts [dict get $argd opts]
set vals [dict get $argd values]
set multis [dict get $argd multis]
set outer_return [dict get $opts -RETURN]
set opts [dict remove $opts -RETURN] ;#opts from punk::args::parse is a dict (no dup keys) - can use 'dict remove' safely
set maxresults [dict get $opts -MAXRESULTS]
set opts [dict remove $opts -MAXRESULTS]
set initial_pagelimit [dict get $opts -limit]
#we can't just pass through 'multi' opts even if only one was supplied - list level is wrong
set nextopts [::list]
dict for {opt val} $opts {
if {$opt ni $multis} {
lappend nextopts $opt $val
} else {
foreach v $val {
lappend nextopts $opt $v
}
}
}
#Now opts is a list with possible repeated options! (for flags that have -multiple true)
if {$maxresults == -1} {
set maxresults $initial_pagelimit
}
if {$maxresults < $initial_pagelimit} {
punk::netbox::man::system::dupkeylist_setfirst nextopts -limit $maxresults
}
set to_go [expr {$maxresults - [llength $resultlist]}]
while {$urlnext ne "null"} {
if {$urlnext ne ""} {
set urlnext_params [punk::netbox::man::system::uri_get_querystring_as_keyval_list $urlnext]
if {[punk::netbox::man::system::dupkeylist_getfirst $nextopts -limit] > $to_go} {
punk::netbox::man::system::dupkeylist_setfirst urlnext_params limit $to_go
}
punk::netbox::man::system::optionlistvar_sync_from_urlparams nextopts $urlnext_params
}
puts "-->next:$urlnext nextopts:$nextopts vals:$vals"
set resultd [punk::netbox::extras::tags_list $token {*}$nextopts -RETURN dict {*}$vals]
set urlnext [dict get $resultd next]
set batch [dict get $resultd results]
lappend resultlist {*}$batch
set to_go [expr {$maxresults - [llength $resultlist]}]
if {$to_go <= 0} {break}
incr requests_allowed -1
if {$requests_allowed < 1} {break}
}
if {$outer_return in {table tableobject}} {
package require textblock
set t [textblock::list_as_table -return tableobject -colheaders {id name slug color sample description}]
foreach tag $resultlist {
set name [dict get $tag name]
set rgb [dict get $tag color]
if {[string length $rgb] && [string length $rgb] == 6} {
set sample "[a+ Rgb#$rgb rgb#$rgb-contrasting] $name [a]"
} else {
set sample ""
}
set r [::list\
[dict get $tag id]\
[dict get $tag name]\
[dict get $tag slug]\
$rgb\
$sample\
[dict get $tag description]\
]
$t add_row $r
}
}
switch -- $outer_return {
table {
set result [$t print]
$t destroy
return $result
}
tableobject {
return $t
}
linelist {
set ret ""
foreach r $resultlist {
append ret $r \n
}
return $ret
}
default {
return $resultlist
}
}
}
}
}
tcl::namespace::eval punk::netbox::man::ip-addresses { tcl::namespace::eval punk::netbox::man::ip-addresses {
namespace export {[a-z]*} namespace export {[a-z]*}
@ -1308,6 +1547,8 @@ namespace eval ::punk::args::register {
::punk::netbox::man::tenancy::tenants\ ::punk::netbox::man::tenancy::tenants\
::punk::netbox::man::virtualization\ ::punk::netbox::man::virtualization\
::punk::netbox::man::virtualization::virtual-machines\ ::punk::netbox::man::virtualization::virtual-machines\
::punk::netbox::man::extras\
::punk::netbox::man::extras::tags\
} }
# ----------------------------------------------------------------------------- # -----------------------------------------------------------------------------
