# -*- tcl -*-
# 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::libunknown 0.1
# Meta platform     tcl
# Meta license      MIT
# @@ Meta End


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin shellspy_module_punk::libunknown 0.1]
#[copyright "2025"]
#[titledesc {Module API}]  [comment {-- Name section and table of contents description --}]
#[moddesc {-}]             [comment {-- Description at end of page heading --}]
#[require punk::libunknown]
#[keywords module]
#[description]
#[para] -

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[section Overview]
#[para] overview of punk::libunknown
#[subsection Concepts]
#[para] -


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[subsection dependencies]
#[para] packages used by punk::libunknown
#[list_begin itemized]

package require Tcl 8.6-
#*** !doctools
#[item] [package {Tcl 8.6}]

# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]

#*** !doctools
#[list_end]

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

#*** !doctools
#[section API]



tcl::namespace::eval punk::libunknown {
    # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
    # Base namespace
    # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
    #*** !doctools
    #[subsection {Namespace punk::libunknown}]
    #[para] Core API functions for punk::libunknown
    #[list_begin definitions]

    variable PUNKARGS


    variable searchpath_tms [dict create] ;#zipfs is static
    #tcl::tm::list may be added to - with non zipfs paths
    #package forget may be used
    #so we can't avoid rechecking tm paths
    #can cache only the tm files in each searchpath
    variable searchpath_modules_added [dict create]

    variable searchpath_indexes [dict create]
    variable searchpath_packages_added [dict create]



    #proc sample1 {p1 n args} {
    #    #*** !doctools
    #    #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]]
    #    #[para]Description of sample1
    #    #[para] Arguments:
    #    #   [list_begin arguments]
    #    #   [arg_def tring p1]       A description of string argument p1.
    #    #   [arg_def integer n]      A description of integer argument n.
    #    #   [list_end]
    #    return "ok"
    #}




    #*** !doctools
    #[list_end] [comment {--- end definitions namespace punk::libunknown ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++





tcl::namespace::eval punk::libunknown {
    tcl::namespace::export {[a-z]*}  ;# Convention: export all lowercase
    variable PUNKARGS
    variable PUNKARGS_aliases

    lappend PUNKARGS [list {
            @id     -id "(package)punk::libunknown"
            @package    -name "punk::libunknown" -help\
            "Experimental set of replacements for default 'package unknown' entries."
        }]


    #will use standard mechanism for non zipfs paths in the tm list.
    proc zipfs_tm_UnknownHandler {original name args} {
        # Import the list of paths to search for packages in module form.
        # Import the pattern used to check package names in detail.
        variable searchpath_tms
        variable searchpath_modules_added

        #variable paths
        upvar ::tcl::tm::paths paths
        #variable pkgpattern
        upvar ::tcl::tm::pkgpattern pkgpattern

        # Without paths to search we can do nothing. (Except falling back to the
        # regular search).
        set tid [format %-19s -]
        catch {set tid [thread::id]}

        if {[llength $paths]} {
            set pkgpath [string map {:: /} $name]
            set pkgroot [file dirname $pkgpath]
            if {$pkgroot eq "."} {
                set pkgroot ""
            }

            # We don't remember a copy of the paths while looping. Tcl Modules are
            # unable to change the list while we are searching for them. This also
            # simplifies the loop, as we cannot get additional directories while
            # iterating over the list. A simple foreach is sufficient.

            set satisfied 0
            foreach path $paths {
                if {![interp issafe] && ![file exists $path]} {
                    continue
                }
                set currentsearchpath [file join $path $pkgroot]

                # Get the module files out of the subdirectories.
                # - Safe Base interpreters have a restricted "glob" command that
                #   works in this case.
                # - The "catch" was essential when there was no safe glob and every
                #   call in a safe interp failed; it is retained only for corner
                #   cases in which the eventual call to glob returns an error.

                if {[string match [tcl::zipfs::root]* $path]} {
                    if {[dict exists $searchpath_tms $currentsearchpath]} {
                        set tmfiles [dict keys [dict get $searchpath_tms $currentsearchpath]]
                        #puts "--->zipfs_tm_UnknownHandler $tid llength tmfiles ( cached ): [format %4d [llength $tmfiles]] name:$name  searchpath:$currentsearchpath"
                    } else {

                        if {![interp issafe] && ![file exists $currentsearchpath]} {
                            continue
                        }

                        #set tmfiles [glob -nocomplain -directory $currentsearchpath *.tm]
                        #dict set searchpath_tms $currentsearchpath $tmfiles

                        dict set searchpath_tms $currentsearchpath [dict create]

                        # #################################################################
                        set tm_paths [::tcl::zipfs::list $currentsearchpath/*.tm] ;#could theoretically be a dir - this is effectively a tree traversal
                        #puts "--->zipfs_tm_UnknownHandler llength tm_paths: [llength $tm_paths]"
                        #process in the order they came - sorting large list more expensive?? review
                        foreach tm_path $tm_paths {
                            set loc [file dirname $tm_path]
                            dict set searchpath_tms $loc $tm_path 1
                        }
                        set tmfiles [dict keys [dict get $searchpath_tms $currentsearchpath]]
                        #puts "--->zipfs_tm_UnknownHandler $tid llength tmfiles (UNcached): [format %4d [llength $tmfiles]] name:$name  searchpath:$currentsearchpath"

                        # #################################################################
                    }

                    # like normal processing - but track searchpath_modules_added (for static zipfs)

                    set can_skip_update 0
                    if {[dict exists $searchpath_modules_added $currentsearchpath]} {
                        if {![dict exists $searchpath_modules_added $currentsearchpath $name]} {
                            #$name wasn't provided by this path before - in static zipfs it shouldn't be necessary to look here again.
                            #puts stderr "zipfs_tm_UnknownHandler CAN SKIP orig:$original name:$name args:$args searchpath:$currentsearchpath"
                            set can_skip_update 1
                        }
                        #if this name is in searchpath_modules_added then we must have done a package forget or it wouldn't come back to package unknown
                    }

                    if {!$can_skip_update} {
                        set strip [llength [file split $path]]
                        catch {
                            foreach file $tmfiles {
                                set pkgfilename [join [lrange [file split $file] $strip end] ::]

                                if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} {
                                    # Ignore everything not matching our pattern for
                                    # package names.
                                    continue
                                }
                                try {
                                    package vcompare $pkgversion 0
                                } on error {} {
                                    # Ignore everything where the version part is not
                                    # acceptable to "package vcompare".
                                    continue
                                }

                                if {([package ifneeded $pkgname $pkgversion] ne {})
                                    && (![interp issafe])
                                } {
                                    # There's already a provide script registered for
                                    # this version of this package.  Since all units of
                                    # code claiming to be the same version of the same
                                    # package ought to be identical, just stick with
                                    # the one we already have.
                                    # This does not apply to Safe Base interpreters because
                                    # the token-to-directory mapping may have changed.
                                    continue
                                }

                                # We have found a candidate, generate a "provide script"
                                # for it, and remember it.  Note that we are using ::list
                                # to do this; locally [list] means something else without
                                # the namespace specifier.

                                # NOTE. When making changes to the format of the provide
                                # command generated below CHECK that the 'LOCATE'
                                # procedure in core file 'platform/shell.tcl' still
                                # understands it, or, if not, update its implementation
                                # appropriately.
                                #
                                # Right now LOCATE's implementation assumes that the path
                                # of the package file is the last element in the list.

                                package ifneeded $pkgname $pkgversion \
                                "[::list package provide $pkgname $pkgversion];[::list source $file]"

                                #JMN
                                #store only once for each name, although there may be multiple versions
                                dict set searchpath_modules_added $currentsearchpath $pkgname 1

                                # We abort in this unknown handler only if we got a
                                # satisfying candidate for the requested package.
                                # Otherwise we still have to fallback to the regular
                                # package search to complete the processing.

                                if {($pkgname eq $name)
                                    && [package vsatisfies $pkgversion {*}$args]} {
                                    set satisfied 1

                                    # We do not abort the loop, and keep adding provide
                                    # scripts for every candidate in the directory, just
                                    # remember to not fall back to the regular search
                                    # anymore.
                                }
                            }
                        }
                    }

                } else {
                    #non zipfs tm path - normal processing
                    # We always look for _all_ possible modules in the current
                    # path, to get the max result out of the glob.
                    set tmfiles [glob -nocomplain -directory $currentsearchpath *.tm]
                    set strip [llength [file split $path]]
                    catch {
                        foreach file $tmfiles {
                            set pkgfilename [join [lrange [file split $file] $strip end] ::]

                            if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} {
                                # Ignore everything not matching our pattern for
                                # package names.
                                continue
                            }
                            try {
                                package vcompare $pkgversion 0
                            } on error {} {
                                # Ignore everything where the version part is not
                                # acceptable to "package vcompare".
                                continue
                            }

                            if {([package ifneeded $pkgname $pkgversion] ne {})
                                && (![interp issafe])
                            } {
                                # There's already a provide script registered for
                                # this version of this package.  Since all units of
                                # code claiming to be the same version of the same
                                # package ought to be identical, just stick with
                                # the one we already have.
                                # This does not apply to Safe Base interpreters because
                                # the token-to-directory mapping may have changed.
                                continue
                            }

                            # We have found a candidate, generate a "provide script"
                            # for it, and remember it.  Note that we are using ::list
                            # to do this; locally [list] means something else without
                            # the namespace specifier.

                            # NOTE. When making changes to the format of the provide
                            # command generated below CHECK that the 'LOCATE'
                            # procedure in core file 'platform/shell.tcl' still
                            # understands it, or, if not, update its implementation
                            # appropriately.
                            #
                            # Right now LOCATE's implementation assumes that the path
                            # of the package file is the last element in the list.

                            package ifneeded $pkgname $pkgversion \
                            "[::list package provide $pkgname $pkgversion];[::list source $file]"

                            # We abort in this unknown handler only if we got a
                            # satisfying candidate for the requested package.
                            # Otherwise we still have to fallback to the regular
                            # package search to complete the processing.

                            if {($pkgname eq $name)
                                && [package vsatisfies $pkgversion {*}$args]} {
                            set satisfied 1

                            # We do not abort the loop, and keep adding provide
                            # scripts for every candidate in the directory, just
                            # remember to not fall back to the regular search
                            # anymore.
                            }
                        }
                    }

                }
                    ##ZZZ

            }

            if {$satisfied} {
                return
            }
        }

        # Fallback to previous command, if existing.  See comment above about
        # ::list...

        if {[llength $original]} {
            #puts "zipfs_tm_UnknownHandler passing on to: $original [::linsert $args 0 $name]"
            uplevel 1 $original [::linsert $args 0 $name]
        }
    }
    proc zipfs_tclPkgUnknown {name args} {
        #puts "-> zipfs_tclPkgUnknown $name $args EXPERIMENTAL"

        variable searchpath_indexes
        variable searchpath_packages_added

        global auto_path env

        if {![info exists auto_path]} {
            return
        }

        set tid [format %-19s -]
        catch {set tid [thread::id]}

        # Cache the auto_path, because it may change while we run through the
        # first set of pkgIndex.tcl files
        set old_path [set use_path $auto_path]
        while {[llength $use_path]} {
            set dir [lindex $use_path end]

            # Make sure we only scan each directory one time.
            if {[info exists tclSeenPath($dir)]} {
                set use_path [lrange $use_path 0 end-1]
                continue
            }
            set tclSeenPath($dir) 1

            # Get the pkgIndex.tcl files in subdirectories of auto_path directories.
            # - Safe Base interpreters have a restricted "glob" command that
            #   works in this case.
            # - The "catch" was essential when there was no safe glob and every
            #   call in a safe interp failed; it is retained only for corner
            #   cases in which the eventual call to glob returns an error.
                if {[string match [tcl::zipfs::root]* $dir]} {
                    set currentsearchpath $dir
                    if {[dict exists $searchpath_indexes $currentsearchpath]} {
                        set indexfiles [dict keys [dict get $searchpath_indexes $currentsearchpath]]
                        #puts stderr "--->zipfs_tclPkgUnknown     $tid llength tmfiles ( cached ): [format %4d [llength $indexfiles]] name:$name  searchpath:$currentsearchpath"
                    } else {
                        dict set searchpath_indexes $currentsearchpath [dict create]
                        # #################################################################
                        set indexpaths [::tcl::zipfs::list $currentsearchpath/*pkgIndex.tcl] ;#'treelike' and returns dirs and files with no way to discern without 'file type' tests
                        #glob can return xxxpkgIndex.tcl too - still need final check that tail is pkgIndex.tcl

                        #puts "--->zipfs_tclPkgUnknown llength indexpaths: [llength $indexpaths]"
                        set dirlen [string length $currentsearchpath]
                        #process in the order they came - sorting large list more expensive?? review
                        foreach idxpath $indexpaths {
                            if {[file tail $idxpath] ne "pkgIndex.tcl"} {
                                #strictly, should be a 'file type' test too
                                continue
                            }
                            set tail [string range $idxpath $dirlen+1 end] ;#dirlen is without trailing slash
                            set tailparts [file split $tail]
                            if {[llength $tailparts] == 1} {
                                #dict lappend searchpath_indexes $currentsearchpath $idxpath
                                dict set searchpath_indexes $currentsearchpath $idxpath 1
                            } else {
                                #standard package search for libs looks 1 down only? - review
                                #review
                                set parent [file dirname $idxpath]
                                set gparent [file dirname $parent]
                                dict set searchpath_indexes $parent  $idxpath 1
                                dict set searchpath_indexes $gparent $idxpath 1
                            }
                        }
                        set indexfiles [dict keys [dict get $searchpath_indexes $currentsearchpath]]
                        #puts stderr "--->zipfs_tclPkgUnknown     $tid llength tmfiles (UNcached): [format %4d [llength $indexfiles]] name:$name  searchpath:$currentsearchpath"
                        # #################################################################
                    }

                    set can_skip_sourcing 0
                    if {[dict exists $searchpath_packages_added $currentsearchpath]} {
                        if {![dict exists $searchpath_packages_added $currentsearchpath $name]} {
                           #if {$name ni [dict get $searchpath_packages_added $currentsearchpath]} {}
                            #$name wasn't provided by this path before - in static zipfs it shouldn't be necessary to look here again.
                            #An edge case exception is that after a package forget, a deliberate call to 'package require non-existant'
                            #will not trigger rescans for all versions of other packages.
                            #A rescan of a specific package for all versions can still be triggered with a package require for
                            #an exact non-existant version. e.g package require md5 0-0
                            #(or misordered min max e.g package require md5 1-0 i.e a deliberately unsatisfiable version range)
                            #puts stderr "zipfs_tclPkgUnknown CAN SKIP $name currentsearchpath:$currentsearchpath"
                            set can_skip_sourcing 1
                        }
                        #else
                        #if this name is in searchpath_packages_added then we must have done a package forget or it wouldn't come back to package unknown ?
                    }

                    set sourced 0
                    if {!$can_skip_sourcing} {
                        #Note - naive comparison of before_pkgs vs after_pkgs isn't quite enough to tell if something was added. It could have added a version.
                        #this will stop us rescanning everything properly by doing a 'package require nonexistant'
                        set before_pkgs [package names]
                        set before_dict [dict create]
                        foreach bp $before_pkgs {
                            dict set before_dict $bp [package versions $bp]
                        }
                        catch {
                            foreach file $indexfiles {
                                set dir [file dirname $file]
                                if {![info exists procdDirs($dir)]} {
                                    try {
                                        #puts stderr "----->0 sourcing $file"
                                        ::tcl::Pkg::source $file
                                        incr sourced
                                    } trap {POSIX EACCES} {} {
                                        # $file was not readable; silently ignore
                                        continue
                                    } on error msg {
                                        if {[regexp {version conflict for package} $msg]} {
                                            # In case of version conflict, silently ignore
                                            continue
                                        }
                                        tclLog "error reading package index file $file: $msg"
                                    } on ok {} {
                                        set procdDirs($dir) 1
                                    }
                                }
                            }
                        }
                        set after_pkgs [package names]
                        set just_added [dict create]
                        if {[llength $after_pkgs] > [llength $before_pkgs]} {
                            foreach a $after_pkgs {
                                if {![dict exists $before_dict $a]} {
                                    dict set just_added $a 1
                                    dict set searchpath_packages_added $currentsearchpath $a 1
                                }
                            }
                            #puts stderr ">>>zipfs_tclPkgUnknown added [llength $added_pkgs]"
                            #puts stderr ">>> [join [lrange $added_pkgs 0 10] \n]..."
                        }
                        dict for {bp bpversions} $before_dict {
                            if {[dict exists $just_added $bp]} {
                                continue
                            }
                            if {[llength $bpversions] != [llength [package versions $bp]]} {
                                dict set searchpath_packages_added $currentsearchpath $bp 1
                            }
                        }
                        #puts stderr "zipfs_tclPkgUnknown $tid sourced: $sourced (under path: $currentsearchpath)"
                    }

                } else {
                    #normal processing - not a static filesystem - we can't skip.
                    set indexfiles [glob -directory $dir -join -nocomplain * pkgIndex.tcl]
                    catch {
                        foreach file $indexfiles {
                            set dir [file dirname $file]
                            if {![info exists procdDirs($dir)]} {
                                try {
                                    #puts "----->1 sourcing $file"
                                    ::tcl::Pkg::source $file
                                } trap {POSIX EACCES} {} {
                                    # $file was not readable; silently ignore
                                    continue
                                } on error msg {
                                    if {[regexp {version conflict for package} $msg]} {
                                        # In case of version conflict, silently ignore
                                        continue
                                    }
                                    tclLog "error reading package index file $file: $msg"
                                } on ok {} {
                                    set procdDirs($dir) 1
                                }
                            }
                        }
                    }

                    set dir [lindex $use_path end]
                    if {![info exists procdDirs($dir)]} {
                        set file [file join $dir pkgIndex.tcl]
                        # safe interps usually don't have "file exists",
                        if {([interp issafe] || [file exists $file])} {
                            try {
                                #puts "----->2 sourcing $file"
                                ::tcl::Pkg::source $file
                            } trap {POSIX EACCES} {} {
                                # $file was not readable; silently ignore
                                continue
                            } on error msg {
                                if {[regexp {version conflict for package} $msg]} {
                                    # In case of version conflict, silently ignore
                                    continue
                                }
                                tclLog "error reading package index file $file: $msg"
                            } on ok {} {
                                set procdDirs($dir) 1
                            }
                        }
                    }

                }


            set use_path [lrange $use_path 0 end-1]

            # Check whether any of the index scripts we [source]d above set a new
            # value for $::auto_path.  If so, then find any new directories on the
            # $::auto_path, and lappend them to the $use_path we are working from.
            # This gives index scripts the (arguably unwise) power to expand the
            # index script search path while the search is in progress.
            set index 0
            if {[llength $old_path] == [llength $auto_path]} {
                foreach dir $auto_path old $old_path {
                    if {$dir ne $old} {
                        # This entry in $::auto_path has changed.
                        break
                    }
                    incr index
                }
            }

            # $index now points to the first element of $auto_path that has
            # changed, or the beginning if $auto_path has changed length Scan the
            # new elements of $auto_path for directories to add to $use_path.
            # Don't add directories we've already seen, or ones already on the
            # $use_path.
            foreach dir [lrange $auto_path $index end] {
                if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
                    lappend use_path $dir
                }
            }
            set old_path $auto_path
        }
        #puts "zipfs_tclPkgUnknown DONE"
    }

    proc init {} {
        if {[catch {tcl::tm::list} tmlist]} {
            set tmlist [list]
        }
        set apath  [list]
        if {[info commands tcl::tm::list] ne ""} {
            set tmlist [tcl::tm::list]
        }
        if {[info exists ::auto_path]} {
            set apath $::auto_path
        }
        if {![llength $tmlist] && ![llength $apath]} {
            #shouldn't happen - be noisy about it for now
            puts stderr "punk::libunknown::init - init while empty/unreadable tcl::tm::list and empty/unreadable ::auto_path"
        }
        if {[info commands ::tcl::zipfs::root] ne ""} {
            set has_zipfs_tm 0
            foreach t $tmlist {
                if {[string match [::tcl::zipfs::root]* $t]} {
                    set has_zipfs_tm 1
                    break ;#zipfs_tm_UnknownHandler can handle either - a single zipfs path is enough
                }
            }
            set has_zipfs_auto 0
            foreach a $apath {
                if {[string match [::tcl::zipfs::root]* $a]} {
                    set has_zipfs_auto 1
                    break
                }
            }
            if {$has_zipfs_tm || $has_zipfs_auto} {
                if {$has_zipfs_tm && $has_zipfs_auto} {
                    package unknown {::punk::libunknown::zipfs_tm_UnknownHandler ::punk::libunknown::zipfs_tclPkgUnknown}
                } elseif {$has_zipfs_tm} {
                    package unknown {::punk::libunknown::zipfs_tm_UnknownHandler ::tclPkgUnknown}
                } else {
                    #must only have auto
                    #puts "tmlist  : $tmlist"
                    #puts "autopath: $apath"
                    package unknown {::tcl::tm::UnknownHandler ::punk::libunknown::zipfs_tclPkgUnknown}
                }
            }
            #review - tm and auto_path entries for safebase interps are obscured. For now we will ignore and defaults will apply.
            #to load in safebase anyway - module would probably have to be passed to interp as source to eval?
        }
    }

    proc default {} {
        package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
    }
}
# == === === === === === === === === === === === === === ===


# -----------------------------------------------------------------------------
#    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::libunknown
}
# -----------------------------------------------------------------------------

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready
package provide punk::libunknown [tcl::namespace::eval punk::libunknown {
    variable pkg punk::libunknown
    variable version
    set version 0.1
}]
return

#*** !doctools
#[manpage_end]