9 changed files with 2871 additions and 94 deletions
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,601 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2025 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::netbox::man 999999.0a1.0 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin shellspy_module_punk::netbox::man 0 999999.0a1.0] |
||||
#[copyright "2025"] |
||||
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||
#[require punk::netbox::man] |
||||
#[keywords module] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of punk::netbox::man |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by punk::netbox::man |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
package require punk::netbox |
||||
package require uri |
||||
package require rest |
||||
|
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package {punk::netbox}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[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 { |
||||
namespace export {[a-z]*} |
||||
variable PUNKARGS |
||||
|
||||
#review + ? |
||||
proc uri_part_decode {uripart} { |
||||
set specialMap {"[" "%5B" "]" "%5D" + " "} |
||||
set seqRE {%([0-9a-fA-F]{2})} |
||||
set replacement {[format "%c" [scan "\1" "%2x"]]} |
||||
set modstr [regsub -all $seqRE [string map $specialMap $uripart] $replacement] |
||||
return [encoding convertfrom utf-8 [subst -nobackslash -novariable $modstr]] |
||||
} |
||||
|
||||
proc uri_get_querystring_as_keyval_list {uri} { |
||||
set parts [uri::split $uri] |
||||
set query ?[dict get $parts query] |
||||
set raw_plist [rest::parameters $query] ;#not a dict - can have repeated params (important for <name>_FILTER methods) |
||||
return [lmap v $raw_plist {uri_part_decode $v}] |
||||
} |
||||
} |
||||
|
||||
|
||||
tcl::namespace::eval punk::netbox::man::prefixes { |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::netbox::man}] |
||||
#[para] Core API functions for punk::netbox::man |
||||
#[list_begin definitions] |
||||
|
||||
namespace export {[a-z]*} |
||||
namespace ensemble create |
||||
|
||||
variable PUNKARGS |
||||
lappend PUNKARGS [::list\ |
||||
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes list"}} ::punk::netbox::ipam::prefixes_list]\ |
||||
{-RETURN -default table -choices {table tableobject list}}\ |
||||
{@values -min 0 -max 0}\ |
||||
] |
||||
|
||||
#caution: must use ::list to avoid loop |
||||
proc list {args} { |
||||
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes list"] |
||||
set token tclread ;#todo |
||||
|
||||
set next "" |
||||
set requests_allowed 1000 ;#review |
||||
set resultlist [::list] |
||||
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 |
||||
#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) |
||||
|
||||
while {$next ne "null"} { |
||||
if {$next ni [::list "" null]} { |
||||
set plist [punk::netbox::man::uri_get_querystring_as_keyval_list $next] |
||||
#don't use any dict write operations on plist/nextopts - can destroy dup keys |
||||
set p_offset [lsearch -stride 2 $plist offset] ;#only search in 'key' positions - for -offset we are only expecting/allowing a single entry |
||||
if {$p_offset != -1} { |
||||
lappend nextopts -offset [lindex $plist $p_offset+1] |
||||
} |
||||
set p_limit [lsearch -stride 2 $plist limit] |
||||
if {$p_limit != -1} { |
||||
lappend nextopts -limit [lindex $plist $p_limit+1] |
||||
} |
||||
} |
||||
puts "-->next:$next nextopts:$nextopts vals:$vals" |
||||
set resultd [punk::netbox::ipam::prefixes_list $token {*}$nextopts -RETURN dict {*}$vals] |
||||
set next [dict get $resultd next] |
||||
set batch [dict get $resultd results] |
||||
lappend resultlist {*}$batch |
||||
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 prefix family vrf tenant children status vlan description _depth}] |
||||
foreach pfx $resultlist { |
||||
if {[dict exists $pfx tenant id]} { |
||||
set tenant "[dict get $pfx tenant id]: [dict get $pfx tenant slug]" |
||||
} else { |
||||
set tenant [dict get $pfx tenant] ;#probably null |
||||
} |
||||
if {[dict exists $pfx vlan id]} { |
||||
set vlan "[dict get $pfx vlan id]: [dict get $pfx vlan display]" |
||||
} else { |
||||
set vlan [dict get $pfx vlan] ;#probably null |
||||
} |
||||
set r [::list\ |
||||
[dict get $pfx id]\ |
||||
[dict get $pfx display]\ |
||||
[dict get $pfx family label]\ |
||||
[dict get $pfx vrf id]\ |
||||
$tenant\ |
||||
[dict get $pfx children]\ |
||||
[dict get $pfx status value]\ |
||||
$vlan\ |
||||
[dict get $pfx description]\ |
||||
[dict get $pfx _depth]\ |
||||
] |
||||
$t add_row $r |
||||
} |
||||
} |
||||
switch -- $outer_return { |
||||
table { |
||||
set result [$t print] |
||||
$t destroy |
||||
return $result |
||||
} |
||||
tableobject { |
||||
return $t |
||||
} |
||||
} |
||||
return $resultlist |
||||
#return [showdict $resultd] |
||||
} |
||||
|
||||
|
||||
#lappend PUNKARGS [::list\ |
||||
# [punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes available-ips_list"}} ::punk::netbox::ipam::prefixes_available-ips_list]\ |
||||
# {-RETURN -default table -choices {table tableobject list}} |
||||
# ] |
||||
lappend PUNKARGS [::list\ |
||||
[punk::args::resolved_def\ |
||||
-antiglobs {apicontextid @leaders -offset}\ |
||||
-override {\ |
||||
@id {-id "::punk::netbox::man::prefixes available-ips_list"}\ |
||||
-limit {-default 254 -help "Maximum number of entries to return"}\ |
||||
-RETURN {-default table -choices {table tableobject list linelist}}\ |
||||
@values {-min 1 -max 1}\ |
||||
}\ |
||||
::punk::netbox::ipam::prefixes_available-ips_list\ |
||||
]\ |
||||
] |
||||
|
||||
proc available-ips_list {args} { |
||||
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes available-ips_list"] |
||||
set token tclread ;#todo |
||||
|
||||
set next "" |
||||
set requests_allowed 1000 ;#review |
||||
set resultlist [::list] |
||||
set opts [dict get $argd opts] |
||||
set valuedict [dict get $argd values] |
||||
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func |
||||
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 |
||||
#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) |
||||
|
||||
#No paging available at endpoint ipam/prefixes/available-ips - but we can still use limit (but offset doesn't seem to work |
||||
set resultlist [punk::netbox::ipam::prefixes_available-ips_list $token {*}$nextopts -RETURN list {*}$vals] |
||||
|
||||
if {$outer_return in {table tableobject}} { |
||||
package require textblock |
||||
set t [textblock::list_as_table -return tableobject -colheaders {address family vrf}] |
||||
foreach ip $resultlist { |
||||
set r [::list\ |
||||
[dict get $ip address]\ |
||||
[dict get $ip family]\ |
||||
"[dict get $ip vrf id]: [dict get $ip vrf name]"\ |
||||
] |
||||
$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 |
||||
} |
||||
jsondump { |
||||
#todo |
||||
package require huddle::json |
||||
#pretty-print via huddle (inefficient review) |
||||
set h [huddle::json::json2huddle parse $result] |
||||
return [huddle::jsondump $h] |
||||
} |
||||
default { |
||||
return $resultlist |
||||
} |
||||
} |
||||
#return [showdict $resultd] |
||||
} |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::netbox::man ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
tcl::namespace::eval punk::netbox::man::ip-addresses { |
||||
namespace export {[a-z]*} |
||||
namespace ensemble create |
||||
variable PUNKARGS |
||||
|
||||
lappend PUNKARGS [::list\ |
||||
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::ip-addresses list"}} ::punk::netbox::ipam::ip-addresses_list]\ |
||||
{-RETURN -default table -choices {table tableobject list}}\ |
||||
{@values -min 0 -max 0}\ |
||||
] |
||||
|
||||
#caution: must use ::list to avoid loop |
||||
proc list {args} { |
||||
set argd [punk::args::parse $args withid "::punk::netbox::man::ip-addresses list"] |
||||
set token tclread ;#todo |
||||
|
||||
set next "" |
||||
set requests_allowed 1000 ;#review |
||||
set resultlist [::list] |
||||
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 |
||||
#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) |
||||
|
||||
while {$next ne "null"} { |
||||
if {$next ni [::list "" null]} { |
||||
set plist [punk::netbox::man::uri_get_querystring_as_keyval_list $next] |
||||
#don't use any dict write operations on plist/nextopts - can destroy dup keys |
||||
set p_offset [lsearch -stride 2 $plist offset] ;#only search in 'key' positions - for -offset we are only expecting/allowing a single entry |
||||
if {$p_offset != -1} { |
||||
lappend nextopts -offset [lindex $plist $p_offset+1] |
||||
} |
||||
set p_limit [lsearch -stride 2 $plist limit] |
||||
if {$p_limit != -1} { |
||||
lappend nextopts -limit [lindex $plist $p_limit+1] |
||||
} |
||||
} |
||||
puts "-->next:$next nextopts:$nextopts vals:$vals" |
||||
set resultd [punk::netbox::ipam::ip-addresses_list $token {*}$nextopts -RETURN dict {*}$vals] |
||||
set next [dict get $resultd next] |
||||
set batch [dict get $resultd results] |
||||
lappend resultlist {*}$batch |
||||
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 address family vrf_id tenant status assigned_object_type deviceinfo dns_name description}] |
||||
foreach ip $resultlist { |
||||
if {[dict exists $ip tenant id]} { |
||||
set tenant "[dict get $ip tenant id]: [dict get $ip tenant slug]" |
||||
} else { |
||||
set tenant [dict get $ip tenant] ;#probably null |
||||
} |
||||
switch -- [dict get $ip assigned_object_type] { |
||||
dcim.interface { |
||||
set device_id [dict get $ip assigned_object device id] |
||||
set device_display [dict get $ip assigned_object device display] |
||||
set deviceinfo "$device_id: $device_display" |
||||
} |
||||
virtualization.vminterface { |
||||
set deviceinfo "vm" |
||||
} |
||||
default { |
||||
set deviceinfo - |
||||
} |
||||
} |
||||
set r [::list\ |
||||
[dict get $ip id]\ |
||||
[dict get $ip address]\ |
||||
[dict get $ip family label]\ |
||||
[dict get $ip vrf id]\ |
||||
$tenant\ |
||||
[dict get $ip status value]\ |
||||
[dict get $ip assigned_object_type]\ |
||||
$deviceinfo\ |
||||
[dict get $ip dns_name]\ |
||||
[dict get $ip description]\ |
||||
] |
||||
$t add_row $r |
||||
} |
||||
} |
||||
switch -- $outer_return { |
||||
table { |
||||
set result [$t print] |
||||
$t destroy |
||||
return $result |
||||
} |
||||
tableobject { |
||||
return $t |
||||
} |
||||
} |
||||
return $resultlist |
||||
#return [showdict $resultd] |
||||
} |
||||
|
||||
|
||||
} |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval punk::netbox::man::lib { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
tcl::namespace::path [tcl::namespace::parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::netbox::man::lib}] |
||||
#[para] Secondary functions that are part of the API |
||||
#[list_begin definitions] |
||||
|
||||
#proc utility1 {p1 args} { |
||||
# #*** !doctools |
||||
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] |
||||
# #[para]Description of utility1 |
||||
# return 1 |
||||
#} |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::netbox::man::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
#tcl::namespace::eval punk::netbox::man::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::netbox::man::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
#} |
||||
|
||||
|
||||
# == === === === === === === === === === === === === === === |
||||
# Sample 'about' function with punk::args documentation |
||||
# == === === === === === === === === === === === === === === |
||||
tcl::namespace::eval punk::netbox::man { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
variable PUNKARGS |
||||
variable PUNKARGS_aliases |
||||
|
||||
lappend PUNKARGS [list { |
||||
@id -id "(package)punk::netbox::man" |
||||
@package -name "punk::netbox::man" -help\ |
||||
"Package |
||||
Description" |
||||
}] |
||||
|
||||
namespace eval argdoc { |
||||
#namespace for custom argument documentation |
||||
proc package_name {} { |
||||
return punk::netbox::man |
||||
} |
||||
proc about_topics {} { |
||||
#info commands results are returned in an arbitrary order (like array keys) |
||||
set topic_funs [info commands [namespace current]::get_topic_*] |
||||
set about_topics [list] |
||||
foreach f $topic_funs { |
||||
set tail [namespace tail $f] |
||||
lappend about_topics [string range $tail [string length get_topic_] end] |
||||
} |
||||
#Adjust this function or 'default_topics' if a different order is required |
||||
return [lsort $about_topics] |
||||
} |
||||
proc default_topics {} {return [list Description *]} |
||||
|
||||
# ------------------------------------------------------------- |
||||
# get_topic_ functions add more to auto-include in about topics |
||||
# ------------------------------------------------------------- |
||||
proc get_topic_Description {} { |
||||
punk::args::lib::tstr [string trim { |
||||
package punk::netbox::man |
||||
A management wrapper over the punk::netbox |
||||
REST API. |
||||
} \n] |
||||
} |
||||
proc get_topic_License {} { |
||||
return "<unspecified>" |
||||
} |
||||
proc get_topic_Version {} { |
||||
return "$::punk::netbox::man::version" |
||||
} |
||||
proc get_topic_Contributors {} { |
||||
set authors {<julian@precisium.com.au> Julian Noble} |
||||
set contributors "" |
||||
foreach a $authors { |
||||
append contributors $a \n |
||||
} |
||||
if {[string index $contributors end] eq "\n"} { |
||||
set contributors [string range $contributors 0 end-1] |
||||
} |
||||
return $contributors |
||||
} |
||||
proc get_topic_custom-topic {} { |
||||
punk::args::lib::tstr -return string { |
||||
todo - next available ip-address from prefix |
||||
} |
||||
} |
||||
# ------------------------------------------------------------- |
||||
} |
||||
|
||||
# we re-use the argument definition from punk::args::standard_about and override some items |
||||
set overrides [dict create] |
||||
dict set overrides @id -id "::punk::netbox::man::about" |
||||
dict set overrides @cmd -name "punk::netbox::man::about" |
||||
dict set overrides @cmd -help [string trim [punk::args::lib::tstr { |
||||
About punk::netbox::man |
||||
}] \n] |
||||
dict set overrides topic -choices [list {*}[punk::netbox::man::argdoc::about_topics] *] |
||||
dict set overrides topic -choicerestricted 1 |
||||
dict set overrides topic -default [punk::netbox::man::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict |
||||
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] |
||||
lappend PUNKARGS [list $newdef] |
||||
proc about {args} { |
||||
package require punk::args |
||||
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on |
||||
set argd [punk::args::parse $args withid ::punk::netbox::man::about] |
||||
lassign [dict values $argd] _leaders opts values _received |
||||
punk::args::package::standard_about -package_about_namespace ::punk::netbox::man::argdoc {*}$opts {*}[dict get $values topic] |
||||
} |
||||
} |
||||
# end of sample 'about' function |
||||
# == === === === === === === === === === === === === === === |
||||
|
||||
|
||||
# ----------------------------------------------------------------------------- |
||||
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked |
||||
# ----------------------------------------------------------------------------- |
||||
# variable PUNKARGS |
||||
# variable PUNKARGS_aliases |
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES\ |
||||
::punk::netbox::man\ |
||||
::punk::netbox::man::prefixes\ |
||||
::punk::netbox::man::ip-addresses |
||||
|
||||
} |
||||
# ----------------------------------------------------------------------------- |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::netbox::man [tcl::namespace::eval punk::netbox::man { |
||||
variable pkg punk::netbox::man |
||||
variable version |
||||
set version 999999.0a1.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
@ -0,0 +1,3 @@
|
||||
0.1.0 |
||||
#First line must be a semantic version number |
||||
#all other lines are ignored. |
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,601 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt |
||||
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2025 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::netbox::man 0.1.0 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# doctools header |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[manpage_begin shellspy_module_punk::netbox::man 0 0.1.0] |
||||
#[copyright "2025"] |
||||
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
||||
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
||||
#[require punk::netbox::man] |
||||
#[keywords module] |
||||
#[description] |
||||
#[para] - |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[section Overview] |
||||
#[para] overview of punk::netbox::man |
||||
#[subsection Concepts] |
||||
#[para] - |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[subsection dependencies] |
||||
#[para] packages used by punk::netbox::man |
||||
#[list_begin itemized] |
||||
|
||||
package require Tcl 8.6- |
||||
package require punk::netbox |
||||
package require uri |
||||
package require rest |
||||
|
||||
#*** !doctools |
||||
#[item] [package {Tcl 8.6}] |
||||
#[item] [package {punk::netbox}] |
||||
|
||||
# #package require frobz |
||||
# #*** !doctools |
||||
# #[item] [package {frobz}] |
||||
|
||||
#*** !doctools |
||||
#[list_end] |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
#*** !doctools |
||||
#[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 { |
||||
namespace export {[a-z]*} |
||||
variable PUNKARGS |
||||
|
||||
#review + ? |
||||
proc uri_part_decode {uripart} { |
||||
set specialMap {"[" "%5B" "]" "%5D" + " "} |
||||
set seqRE {%([0-9a-fA-F]{2})} |
||||
set replacement {[format "%c" [scan "\1" "%2x"]]} |
||||
set modstr [regsub -all $seqRE [string map $specialMap $uripart] $replacement] |
||||
return [encoding convertfrom utf-8 [subst -nobackslash -novariable $modstr]] |
||||
} |
||||
|
||||
proc uri_get_querystring_as_keyval_list {uri} { |
||||
set parts [uri::split $uri] |
||||
set query ?[dict get $parts query] |
||||
set raw_plist [rest::parameters $query] ;#not a dict - can have repeated params (important for <name>_FILTER methods) |
||||
return [lmap v $raw_plist {uri_part_decode $v}] |
||||
} |
||||
} |
||||
|
||||
|
||||
tcl::namespace::eval punk::netbox::man::prefixes { |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Base namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::netbox::man}] |
||||
#[para] Core API functions for punk::netbox::man |
||||
#[list_begin definitions] |
||||
|
||||
namespace export {[a-z]*} |
||||
namespace ensemble create |
||||
|
||||
variable PUNKARGS |
||||
lappend PUNKARGS [::list\ |
||||
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes list"}} ::punk::netbox::ipam::prefixes_list]\ |
||||
{-RETURN -default table -choices {table tableobject list}}\ |
||||
{@values -min 0 -max 0}\ |
||||
] |
||||
|
||||
#caution: must use ::list to avoid loop |
||||
proc list {args} { |
||||
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes list"] |
||||
set token tclread ;#todo |
||||
|
||||
set next "" |
||||
set requests_allowed 1000 ;#review |
||||
set resultlist [::list] |
||||
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 |
||||
#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) |
||||
|
||||
while {$next ne "null"} { |
||||
if {$next ni [::list "" null]} { |
||||
set plist [punk::netbox::man::uri_get_querystring_as_keyval_list $next] |
||||
#don't use any dict write operations on plist/nextopts - can destroy dup keys |
||||
set p_offset [lsearch -stride 2 $plist offset] ;#only search in 'key' positions - for -offset we are only expecting/allowing a single entry |
||||
if {$p_offset != -1} { |
||||
lappend nextopts -offset [lindex $plist $p_offset+1] |
||||
} |
||||
set p_limit [lsearch -stride 2 $plist limit] |
||||
if {$p_limit != -1} { |
||||
lappend nextopts -limit [lindex $plist $p_limit+1] |
||||
} |
||||
} |
||||
puts "-->next:$next nextopts:$nextopts vals:$vals" |
||||
set resultd [punk::netbox::ipam::prefixes_list $token {*}$nextopts -RETURN dict {*}$vals] |
||||
set next [dict get $resultd next] |
||||
set batch [dict get $resultd results] |
||||
lappend resultlist {*}$batch |
||||
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 prefix family vrf tenant children status vlan description _depth}] |
||||
foreach pfx $resultlist { |
||||
if {[dict exists $pfx tenant id]} { |
||||
set tenant "[dict get $pfx tenant id]: [dict get $pfx tenant slug]" |
||||
} else { |
||||
set tenant [dict get $pfx tenant] ;#probably null |
||||
} |
||||
if {[dict exists $pfx vlan id]} { |
||||
set vlan "[dict get $pfx vlan id]: [dict get $pfx vlan display]" |
||||
} else { |
||||
set vlan [dict get $pfx vlan] ;#probably null |
||||
} |
||||
set r [::list\ |
||||
[dict get $pfx id]\ |
||||
[dict get $pfx display]\ |
||||
[dict get $pfx family label]\ |
||||
[dict get $pfx vrf id]\ |
||||
$tenant\ |
||||
[dict get $pfx children]\ |
||||
[dict get $pfx status value]\ |
||||
$vlan\ |
||||
[dict get $pfx description]\ |
||||
[dict get $pfx _depth]\ |
||||
] |
||||
$t add_row $r |
||||
} |
||||
} |
||||
switch -- $outer_return { |
||||
table { |
||||
set result [$t print] |
||||
$t destroy |
||||
return $result |
||||
} |
||||
tableobject { |
||||
return $t |
||||
} |
||||
} |
||||
return $resultlist |
||||
#return [showdict $resultd] |
||||
} |
||||
|
||||
|
||||
#lappend PUNKARGS [::list\ |
||||
# [punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::prefixes available-ips_list"}} ::punk::netbox::ipam::prefixes_available-ips_list]\ |
||||
# {-RETURN -default table -choices {table tableobject list}} |
||||
# ] |
||||
lappend PUNKARGS [::list\ |
||||
[punk::args::resolved_def\ |
||||
-antiglobs {apicontextid @leaders -offset}\ |
||||
-override {\ |
||||
@id {-id "::punk::netbox::man::prefixes available-ips_list"}\ |
||||
-limit {-default 254 -help "Maximum number of entries to return"}\ |
||||
-RETURN {-default table -choices {table tableobject list linelist}}\ |
||||
@values {-min 1 -max 1}\ |
||||
}\ |
||||
::punk::netbox::ipam::prefixes_available-ips_list\ |
||||
]\ |
||||
] |
||||
|
||||
proc available-ips_list {args} { |
||||
set argd [punk::args::parse $args withid "::punk::netbox::man::prefixes available-ips_list"] |
||||
set token tclread ;#todo |
||||
|
||||
set next "" |
||||
set requests_allowed 1000 ;#review |
||||
set resultlist [::list] |
||||
set opts [dict get $argd opts] |
||||
set valuedict [dict get $argd values] |
||||
set vals [dict values $valuedict] ;#we don't need the keys to pass on to next func |
||||
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 |
||||
#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) |
||||
|
||||
#No paging available at endpoint ipam/prefixes/available-ips - but we can still use limit (but offset doesn't seem to work |
||||
set resultlist [punk::netbox::ipam::prefixes_available-ips_list $token {*}$nextopts -RETURN list {*}$vals] |
||||
|
||||
if {$outer_return in {table tableobject}} { |
||||
package require textblock |
||||
set t [textblock::list_as_table -return tableobject -colheaders {address family vrf}] |
||||
foreach ip $resultlist { |
||||
set r [::list\ |
||||
[dict get $ip address]\ |
||||
[dict get $ip family]\ |
||||
"[dict get $ip vrf id]: [dict get $ip vrf name]"\ |
||||
] |
||||
$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 |
||||
} |
||||
jsondump { |
||||
#todo |
||||
package require huddle::json |
||||
#pretty-print via huddle (inefficient review) |
||||
set h [huddle::json::json2huddle parse $result] |
||||
return [huddle::jsondump $h] |
||||
} |
||||
default { |
||||
return $resultlist |
||||
} |
||||
} |
||||
#return [showdict $resultd] |
||||
} |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::netbox::man ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
tcl::namespace::eval punk::netbox::man::ip-addresses { |
||||
namespace export {[a-z]*} |
||||
namespace ensemble create |
||||
variable PUNKARGS |
||||
|
||||
lappend PUNKARGS [::list\ |
||||
[punk::args::resolved_def -antiglobs {apicontextid @leaders @values -RETURN} -override {@id {-id "::punk::netbox::man::ip-addresses list"}} ::punk::netbox::ipam::ip-addresses_list]\ |
||||
{-RETURN -default table -choices {table tableobject list}}\ |
||||
{@values -min 0 -max 0}\ |
||||
] |
||||
|
||||
#caution: must use ::list to avoid loop |
||||
proc list {args} { |
||||
set argd [punk::args::parse $args withid "::punk::netbox::man::ip-addresses list"] |
||||
set token tclread ;#todo |
||||
|
||||
set next "" |
||||
set requests_allowed 1000 ;#review |
||||
set resultlist [::list] |
||||
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 |
||||
#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) |
||||
|
||||
while {$next ne "null"} { |
||||
if {$next ni [::list "" null]} { |
||||
set plist [punk::netbox::man::uri_get_querystring_as_keyval_list $next] |
||||
#don't use any dict write operations on plist/nextopts - can destroy dup keys |
||||
set p_offset [lsearch -stride 2 $plist offset] ;#only search in 'key' positions - for -offset we are only expecting/allowing a single entry |
||||
if {$p_offset != -1} { |
||||
lappend nextopts -offset [lindex $plist $p_offset+1] |
||||
} |
||||
set p_limit [lsearch -stride 2 $plist limit] |
||||
if {$p_limit != -1} { |
||||
lappend nextopts -limit [lindex $plist $p_limit+1] |
||||
} |
||||
} |
||||
puts "-->next:$next nextopts:$nextopts vals:$vals" |
||||
set resultd [punk::netbox::ipam::ip-addresses_list $token {*}$nextopts -RETURN dict {*}$vals] |
||||
set next [dict get $resultd next] |
||||
set batch [dict get $resultd results] |
||||
lappend resultlist {*}$batch |
||||
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 address family vrf_id tenant status assigned_object_type deviceinfo dns_name description}] |
||||
foreach ip $resultlist { |
||||
if {[dict exists $ip tenant id]} { |
||||
set tenant "[dict get $ip tenant id]: [dict get $ip tenant slug]" |
||||
} else { |
||||
set tenant [dict get $ip tenant] ;#probably null |
||||
} |
||||
switch -- [dict get $ip assigned_object_type] { |
||||
dcim.interface { |
||||
set device_id [dict get $ip assigned_object device id] |
||||
set device_display [dict get $ip assigned_object device display] |
||||
set deviceinfo "$device_id: $device_display" |
||||
} |
||||
virtualization.vminterface { |
||||
set deviceinfo "vm" |
||||
} |
||||
default { |
||||
set deviceinfo - |
||||
} |
||||
} |
||||
set r [::list\ |
||||
[dict get $ip id]\ |
||||
[dict get $ip address]\ |
||||
[dict get $ip family label]\ |
||||
[dict get $ip vrf id]\ |
||||
$tenant\ |
||||
[dict get $ip status value]\ |
||||
[dict get $ip assigned_object_type]\ |
||||
$deviceinfo\ |
||||
[dict get $ip dns_name]\ |
||||
[dict get $ip description]\ |
||||
] |
||||
$t add_row $r |
||||
} |
||||
} |
||||
switch -- $outer_return { |
||||
table { |
||||
set result [$t print] |
||||
$t destroy |
||||
return $result |
||||
} |
||||
tableobject { |
||||
return $t |
||||
} |
||||
} |
||||
return $resultlist |
||||
#return [showdict $resultd] |
||||
} |
||||
|
||||
|
||||
} |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# Secondary API namespace |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
tcl::namespace::eval punk::netbox::man::lib { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
tcl::namespace::path [tcl::namespace::parent] |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::netbox::man::lib}] |
||||
#[para] Secondary functions that are part of the API |
||||
#[list_begin definitions] |
||||
|
||||
#proc utility1 {p1 args} { |
||||
# #*** !doctools |
||||
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] |
||||
# #[para]Description of utility1 |
||||
# return 1 |
||||
#} |
||||
|
||||
|
||||
|
||||
#*** !doctools |
||||
#[list_end] [comment {--- end definitions namespace punk::netbox::man::lib ---}] |
||||
} |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#*** !doctools |
||||
#[section Internal] |
||||
#tcl::namespace::eval punk::netbox::man::system { |
||||
#*** !doctools |
||||
#[subsection {Namespace punk::netbox::man::system}] |
||||
#[para] Internal functions that are not part of the API |
||||
|
||||
|
||||
|
||||
#} |
||||
|
||||
|
||||
# == === === === === === === === === === === === === === === |
||||
# Sample 'about' function with punk::args documentation |
||||
# == === === === === === === === === === === === === === === |
||||
tcl::namespace::eval punk::netbox::man { |
||||
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
||||
variable PUNKARGS |
||||
variable PUNKARGS_aliases |
||||
|
||||
lappend PUNKARGS [list { |
||||
@id -id "(package)punk::netbox::man" |
||||
@package -name "punk::netbox::man" -help\ |
||||
"Package |
||||
Description" |
||||
}] |
||||
|
||||
namespace eval argdoc { |
||||
#namespace for custom argument documentation |
||||
proc package_name {} { |
||||
return punk::netbox::man |
||||
} |
||||
proc about_topics {} { |
||||
#info commands results are returned in an arbitrary order (like array keys) |
||||
set topic_funs [info commands [namespace current]::get_topic_*] |
||||
set about_topics [list] |
||||
foreach f $topic_funs { |
||||
set tail [namespace tail $f] |
||||
lappend about_topics [string range $tail [string length get_topic_] end] |
||||
} |
||||
#Adjust this function or 'default_topics' if a different order is required |
||||
return [lsort $about_topics] |
||||
} |
||||
proc default_topics {} {return [list Description *]} |
||||
|
||||
# ------------------------------------------------------------- |
||||
# get_topic_ functions add more to auto-include in about topics |
||||
# ------------------------------------------------------------- |
||||
proc get_topic_Description {} { |
||||
punk::args::lib::tstr [string trim { |
||||
package punk::netbox::man |
||||
A management wrapper over the punk::netbox |
||||
REST API. |
||||
} \n] |
||||
} |
||||
proc get_topic_License {} { |
||||
return "<unspecified>" |
||||
} |
||||
proc get_topic_Version {} { |
||||
return "$::punk::netbox::man::version" |
||||
} |
||||
proc get_topic_Contributors {} { |
||||
set authors {<julian@precisium.com.au> Julian Noble} |
||||
set contributors "" |
||||
foreach a $authors { |
||||
append contributors $a \n |
||||
} |
||||
if {[string index $contributors end] eq "\n"} { |
||||
set contributors [string range $contributors 0 end-1] |
||||
} |
||||
return $contributors |
||||
} |
||||
proc get_topic_custom-topic {} { |
||||
punk::args::lib::tstr -return string { |
||||
todo - next available ip-address from prefix |
||||
} |
||||
} |
||||
# ------------------------------------------------------------- |
||||
} |
||||
|
||||
# we re-use the argument definition from punk::args::standard_about and override some items |
||||
set overrides [dict create] |
||||
dict set overrides @id -id "::punk::netbox::man::about" |
||||
dict set overrides @cmd -name "punk::netbox::man::about" |
||||
dict set overrides @cmd -help [string trim [punk::args::lib::tstr { |
||||
About punk::netbox::man |
||||
}] \n] |
||||
dict set overrides topic -choices [list {*}[punk::netbox::man::argdoc::about_topics] *] |
||||
dict set overrides topic -choicerestricted 1 |
||||
dict set overrides topic -default [punk::netbox::man::argdoc::default_topics] ;#if -default is present 'topic' will always appear in parsed 'values' dict |
||||
set newdef [punk::args::resolved_def -antiglobs -package_about_namespace -override $overrides ::punk::args::package::standard_about *] |
||||
lappend PUNKARGS [list $newdef] |
||||
proc about {args} { |
||||
package require punk::args |
||||
#standard_about accepts additional choices for topic - but we need to normalize any abbreviations to full topic name before passing on |
||||
set argd [punk::args::parse $args withid ::punk::netbox::man::about] |
||||
lassign [dict values $argd] _leaders opts values _received |
||||
punk::args::package::standard_about -package_about_namespace ::punk::netbox::man::argdoc {*}$opts {*}[dict get $values topic] |
||||
} |
||||
} |
||||
# end of sample 'about' function |
||||
# == === === === === === === === === === === === === === === |
||||
|
||||
|
||||
# ----------------------------------------------------------------------------- |
||||
# register namespace(s) to have PUNKARGS,PUNKARGS_aliases variables checked |
||||
# ----------------------------------------------------------------------------- |
||||
# variable PUNKARGS |
||||
# variable PUNKARGS_aliases |
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES\ |
||||
::punk::netbox::man\ |
||||
::punk::netbox::man::prefixes\ |
||||
::punk::netbox::man::ip-addresses |
||||
|
||||
} |
||||
# ----------------------------------------------------------------------------- |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::netbox::man [tcl::namespace::eval punk::netbox::man { |
||||
variable pkg punk::netbox::man |
||||
variable version |
||||
set version 0.1.0 |
||||
}] |
||||
return |
||||
|
||||
#*** !doctools |
||||
#[manpage_end] |
||||
|
||||
Loading…
Reference in new issue