# -*- 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]