# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# 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) 2023
#
# @@ Meta Begin
# Application punk::mix::util 999999.0a1.0
# Meta platform     tcl
# Meta license      <unspecified>
# @@ Meta End



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Requirements
##e.g package require frobz

namespace eval punk::mix::util {
    variable has_winpath 0
}

if {"windows" eq $::tcl_platform(platform)} {
   if {![catch {package require punk::winpath}]} {
       set punk::mix::util::has_winpath 1
   }
}


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::util {
    variable tmpfile_counter 0 ;#additional tmpfile collision avoidance

    namespace export *

    #NOTE fileutil::cat seems to silently ignore options if passed at end instead of before file!
    proc fcat {args} {
        variable has_winpath


        set knownopts [list -eofchar -translation -encoding --]
        set last_opt 0
        for {set i 0} {$i < [llength $args]} {incr i} {
            set ival [lindex $args $i]
            #puts stdout "i:$i a: $ival known: [expr {$ival in $knownopts}]"
            if {$ival eq "--"} {
                set last_opt $i
                break
            } else {
                if {$ival in $knownopts} {
                    #puts ">known at $i : [lindex $args $i]"
                    if {($i % 2) != 0} {
                        error "unexpected option at index $i. known options: $knownopts must come in -opt val pairs."
                    }
                    incr i
                    set last_opt $i
                } else {
                set last_opt [expr {$i - 1}] 
                break
                }
            }
        }
        set first_non_opt [expr {$last_opt + 1}]

        #puts stderr "first_non_opt: $first_non_opt"
        set opts [lrange $args -1 $first_non_opt-1]
        set paths [lrange $args $first_non_opt end]
        if {![llength $paths]} {
            error "Unable to find file in the supplied arguments: $args. Ensure options are all -opt val pairs and that file name(s) follow"
        }

        #puts stderr "opts: $opts  paths: $paths"

        #let's proceed, but warn the user if an apparent option is in paths 
        foreach opt [list -encoding -eofchar -translation] {
            if {$opt in $paths} {
                puts stderr "fcat WARNING: apparent option $opt found after file argument(s) (expected them before filenames). Passing to fileutil::cat anyway - but for at least some versions, these options may be ignored. commandline 'fcat $args'"
            }
        }

        if {$::tcl_platform(platform) ne "windows"} {
            return [fileutil::cat {*}$args]
        }


        set finalpaths [list]
        foreach p $paths {
            if {$has_winpath && [punk::winpath::illegalname_test $p]} {
                lappend finalpaths [punk::winpath::illegalname_fix $p]
            } else {
                lappend finalpaths $p
            }
        }
        fileutil::cat {*}$opts {*}$finalpaths
    }

    #----------------------------------------
    namespace eval internal {
        proc path_common_prefix_pop {varname} {
            upvar 1 $varname var
            set var [lassign $var head]
            return $head
        }
    }
    proc path_common_prefix {args} {
        set dirs $args
        set parts [file split [internal::path_common_prefix_pop dirs]]
        while {[llength $dirs]} {
            set r {}
            foreach cmp $parts elt [file split [internal::path_common_prefix_pop dirs]] {
                if {$cmp ne $elt} break
                lappend r $cmp
            }
            set parts $r
        }
        if {[llength $parts]} {
            return [file join {*}$parts]
        } else {
            return ""
        }
    }

    #retains case from first argument only - caseless comparison
    proc path_common_prefix_nocase {args} {
        set dirs $args
        set parts [file split [internal::path_common_prefix_pop dirs]]
        while {[llength $dirs]} {
            set r {}
            foreach cmp $parts elt [file split [internal::path_common_prefix_pop dirs]] {
                if {![string equal -nocase $cmp $elt]} break
                lappend r $cmp
            }
            set parts $r
        }
        if {[llength $parts]} {
            return [file join {*}$parts]
        } else {
            return ""
        }
    }
    #----------------------------------------

    #namespace import ::punk::ns::nsimport_noclobber 

    proc namespace_import_pattern_to_namespace_noclobber {pattern ns} {
        set source_ns [namespace qualifiers $pattern]
        if {![namespace exists $source_ns]} {
            error "namespace_import_pattern_to_namespace_noclobber error namespace $source_ns not found"
        }
        if {![string match ::* $ns]} {
            set nscaller [uplevel 1 {namespace current}]
            set ns [punk::nsjoin $nscaller $ns]
        }
        set a_export_patterns [namespace eval $source_ns {namespace export}] 
        set a_commands [info commands $pattern]
        set a_tails [lmap v $a_commands {namespace tail $v}]
        set a_exported_tails [list]
        foreach pattern $a_export_patterns {
            set matches [lsearch -all -inline $a_tails $pattern]
            foreach m $matches {
                if {$m ni $a_exported_tails} {
                    lappend a_exported_tails $m
                }
            }
        }
        set imported_commands [list]
        foreach e $a_exported_tails {
            set imported [namespace eval $ns [string map [list <func> $e <a> $source_ns] {
                set cmd ""
                if {![catch {namespace import <a>::<func>}]} {
                    set cmd <func>
                }
                set cmd
            }]]
            if {[string length $imported]} {
                lappend imported_commands $imported
            }
        }
        return $imported_commands
    }

    proc askuser {question} {
        if {![catch {package require punk::lib}]} {
            return [punk::lib::askuser $question] ;#takes account of terminal mode raw vs line (if punk::console used)
        }
        puts stdout $question
        flush stdout
        set stdin_state [fconfigure stdin]
        fconfigure stdin -blocking 1
        set answer [gets stdin]
        fconfigure stdin -blocking [dict get $stdin_state -blocking]
        return $answer
    }

    #review - can be surprising if caller unaware it uses try
    proc do_in_path {path script} {
        #from ::kettle::path::in
        set here [pwd]
        try {
            cd $path
            uplevel 1 $script
        } finally {
            cd $here
        }
    }

    proc foreach-file {path script_pathvariable script} {
        upvar 1 $script_pathvariable thepath

        set known {}
        lappend waiting $path
        while {[llength $waiting]} {
        set pending $waiting
        set waiting {}
        set at 0
        while {$at < [llength $pending]} {
            set current [lindex $pending $at]
            incr at

            # Do not follow into parent.
            if {[string match *.. $current]} continue

            # Ignore what we have visited already.
            set c [file dirname [file normalize $current/___]]
            if {[dict exists $known $c]} continue
            dict set known $c .

            if {[file tail $c] eq ".git"} {
                continue
            }

            # Expand directories.
            if {[file isdirectory $c]} {
                lappend waiting {*}[lsort -unique [glob -directory $c * .*]]
                continue
            }

            # Handle files as per the user's will.
            set thepath $current
            switch -exact -- [catch { uplevel 1 $script } result] {
            0 - 4 {
                # ok, continue - nothing
            }
            2 {
                # return, abort, rethrow
                return -code return
            }
            3 {
                # break, abort
                return
            }
            1 - default {
                # error, any thing else - rethrow
                return -code error $result
            }
            }
        }
        }
        return
    }

    proc is_valid_tm_version {versionpart} {
        #Needs to be suitable for use with Tcl's 'package vcompare'
        if {![catch [list package vcompare $versionpart $versionpart]]} {
            return 1
        } else {
            return 0
        }
    }
    #Note that semver only has a small overlap with tcl tm versions.
    #todo - work out what overlap and whether it's even useful
    #see also TIP #439: Semantic Versioning (tcl 9??)
    proc semver {versionstring} {
        set re {^(0|[1-9]\d*)\.(0|[1-9]\d*)\.(0|[1-9]\d*)(?:-((?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*)(?:\.(?:0|[1-9]\d*|\d*[a-zA-Z-][0-9a-zA-Z-]*))*))?(?:\+([0-9a-zA-Z-]+(?:\.[0-9a-zA-Z-]+)*))?$}
    }
    #todo - semver conversion/validation for other systems?
    proc magic_tm_version {} {
        set magicbase 999999  ;#deliberately large so given load-preference when testing!
        #we split the literal to avoid the literal appearing here - reduce risk of accidentally converting to a release version
        return ${magicbase}.0a1.0
    }



    proc tmpfile {{prefix tmp_}} {
        #note risk of collision if pregenerating a list of tmpfile names
        #we will maintain an icrementing id so the caller doesn't have to bear that in mind
        variable tmpfile_counter
        global tcl_platform
        return .punkutil_$prefix[pid]_[clock microseconds]_[incr tmpfile_counter]_[info hostname]_$tcl_platform(user)
    }

    proc tmpdir {} {
        # Taken from tcllib fileutil.
        global tcl_platform env

        set attempdirs [list]
        set problems   {}

        foreach tmp {TEMP TMP TMPDIR} {
            if { [info exists env($tmp)] } {
                lappend attempdirs $env($tmp)
            } else {
                lappend problems "No environment variable $tmp"
            }
        }

        switch $tcl_platform(platform) {
        windows {
            lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"
        }
        macintosh {
            lappend attempdirs $env(TRASH_FOLDER)  ;# a better place?
        }
        default {
            lappend attempdirs \
            [file join / tmp] \
            [file join / var tmp] \
            [file join / usr tmp]
        }
        }

        lappend attempdirs [pwd]

        foreach tmp $attempdirs {
            if { [file isdirectory $tmp] &&
                [file writable $tmp] } {
                return [file normalize $tmp]
            } elseif { ![file isdirectory $tmp] } {
                lappend problems "Not a directory: $tmp"
            } else {
                lappend problems "Not writable: $tmp"
            }
        }

        # Fail if nothing worked.
        return -code error "Unable to determine a proper directory for temporary files\n[join $problems \n]"
    }



}














# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide punk::mix::util [namespace eval punk::mix::util {
    variable version
    set version 999999.0a1.0 
}]
return