# -*- 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) 2024
#
# @@ Meta Begin
# Application modpod 0.1.2
# Meta platform     tcl
# Meta license      <unspecified>
# @@ Meta End


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin modpod_module_modpod 0 0.1.2]
#[copyright "2024"]
#[titledesc {Module API}]  [comment {-- Name section and table of contents description --}]
#[moddesc {-}]             [comment {-- Description at end of page heading --}] 
#[require modpod]
#[keywords module]
#[description]
#[para] -

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

#*** !doctools
#[section Overview]
#[para] overview of modpod
#[subsection Concepts]
#[para] -


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

#*** !doctools
#[subsection dependencies]
#[para] packages used by modpod
#[list_begin itemized]

package require Tcl 8.6-
package require struct::set  ;#review
package require punk::lib
package require punk::args
#*** !doctools
#[item] [package {Tcl 8.6-}]

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

#*** !doctools
#[list_end]

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

#*** !doctools
#[section API]

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval modpod::class {
    #*** !doctools
    #[subsection {Namespace modpod::class}]
    #[para] class definitions
    if {[info commands [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 ---}]
    }
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++

# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval modpod {
    namespace export {[a-z]*};   # Convention: export all lowercase

    variable connected
    if {![info exists connected(to)]} {
        set connected(to) list
    }
    variable modpodscript
    set modpodscript [info script]
    if {[string tolower [file extension $modpodscript]] eq ".tcl"} {
        set connected(self) [file dirname $modpodscript]
    } else {
        #expecting a .tm
        set connected(self) $modpodscript
    }
    variable loadables [info sharedlibextension]
    variable sourceables {.tcl .tk} ;# .tm ?

    #*** !doctools
    #[subsection {Namespace modpod}]
    #[para] Core API functions for modpod 
    #[list_begin definitions]



    #proc sample1 {p1 args} {
    #    #*** !doctools
    #    #[call [fun sample1] [arg p1] [opt {?option value...?}]]
    #    #[para]Description of sample1 
    #    return "ok" 
    #}

    #old tar connect mechanism - review - not needed?
    proc connect {args} {
        puts stderr "modpod::connect--->>$args" 
        set argd [punk::args::get_dict {
            @id -id ::modpod::connect
            -type -default ""
            @values -min 1 -max 1
            path  -type string -minsize 1  -help "path to .tm file or toplevel .tcl script within #modpod-<pkg>-<ver> folder (unwrapped modpod)"
        } $args]
        catch {
            punk::lib::showdict $argd ;#heavy dependencies
        }
        set opt_path [dict get $argd values path]
        variable connected
        set original_connectpath  $opt_path
        set modpodpath [modpod::system::normalize $opt_path] ;#

        if {$modpodpath in $connected(to)} {
            return [dict create ok ALREADY_CONNECTED]
        }
        lappend connected(to) $modpodpath

        set connected(connectpath,$opt_path) $original_connectpath
        set is_sourced [expr {[file normalize $modpodpath] eq [file normalize [info script]]}]

        set connected(location,$modpodpath) [file dirname $modpodpath]
        set connected(startdata,$modpodpath) -1
        set connected(type,$modpodpath) [dict get $argd opts -type]
        set connected(fh,$modpodpath) ""

        if {[string range [file tail $modpodpath] 0 7] eq "#modpod-"} {
            set connected(type,$modpodpath) "unwrapped"
            lassign [::split [file tail [file dirname $modpodpath]] -] connected(package,$modpodpath) connected(version,$modpodpath)
            set this_pkg_tm_folder [file dirname [file dirname $modpodpath]]

        } else {
            #connect to .tm  but may still be unwrapped version available
            lassign [::split [file rootname [file tail $modpodath]] -] connected(package,$modpodpath) connected(version,$modpodpath)
            set this_pkg_tm_folder [file dirname $modpodpath]
            if {$connected(type,$modpodpath) ne "unwrapped"} {
                #Not directly connected to unwrapped version - but may still be redirected there
                set unwrappedFolder [file join $connected(location,$modpodpath) #modpod-$connected(package,$modpodpath)-$connected(version,$modpodpath)]
                if {[file exists $unwrappedFolder]} {
                    #folder with exact version-match must exist for redirect to 'unwrapped'
                    set con(type,$modpodpath) "modpod-redirecting"
                }
            }

        }
        set unwrapped_tm_file [file join $this_pkg_tm_folder] "[set connected(package,$modpodpath)]-[set connected(version,$modpodpath)].tm"
        set connected(tmfile,$modpodpath)
        set tail_segments [list]
        set lcase_tmfile_segments   [string tolower [file split $this_pkg_tm_folder]]
        set lcase_modulepaths       [string tolower [tcl::tm::list]]
        foreach lc_mpath $lcase_modulepaths {
            set mpath_segments [file split $lc_mpath]
            if {[llength [struct::set intersect $lcase_tmfile_segments $mpath_segments]] == [llength $mpath_segments]} {
                set tail_segments [lrange [file split $this_pkg_tm_folder] [llength $mpath_segments] end]
                break
            }
        }
        if {[llength $tail_segments]} {
            set connected(fullpackage,$modpodpath) [join [concat $tail_segments [set connected(package,$modpodpath)]] ::] ;#full name of package as used in package require
        } else {
            set connected(fullpackage,$modpodpath) [set connected(package,$modpodpath)]
        }

        switch -exact -- $connected(type,$modpodpath) {
            "modpod-redirecting" {
                #redirect to the unwrapped version
                set loadscript_name [file join $unwrappedFolder #modpod-loadscript-$con(package,$modpod).tcl]

            }
            "unwrapped" {
                if {[info commands ::thread::id] ne ""} {
                    set from [pid],[thread::id]
                } else {
                    set from [pid]
                }
                #::modpod::Puts stderr "$from-> Package $connected(package,$modpodpath)-$connected(version,$modpodpath) is using unwrapped version: $modpodpath"
                return [list ok ""]
            }
            default {
                #autodetect .tm - zip/tar ?
                #todo - use vfs ?

                #connect to tarball - start at 1st header
                set connected(startdata,$modpodpath) 0
                set fh [open $modpodpath r]
                set connected(fh,$modpodpath) $fh
                fconfigure $fh -encoding iso8859-1 -translation binary -eofchar {}

                if {$connected(startdata,$modpodpath) >= 0} {
                    #verify we have a valid tar header
                    if {![catch {::modpod::system::tar::readHeader [red $fh 512]}]} {
                        seek $fh $connected(startdata,$modpodpath) start
                        return [list ok $fh]
                    } else {
                        #error "cannot verify tar header"
                    }
                }
                lpop connected(to) end 
                set connected(startdata,$modpodpath) -1
                unset connected(fh,$modpodpath)
                catch {close $fh}
                return [dict create err {Does not appear to be a valid modpod}]
            }
        }
    }
    proc disconnect {{modpod ""}} {
        variable connected
        if {![llength $connected(to)]} {
            return 0
        }
        if {$modpod eq ""} {
            puts stderr "modpod::disconnect WARNING: modpod not explicitly specified. Disconnecting last connected: [lindex $connected(to) end]"
            set modpod [lindex $connected(to) end]
        }

        if {[set posn [lsearch $connected(to) $modpod]] == -1} {
            puts stderr "modpod::disconnect WARNING: disconnect called when not connected: $modpod"
            return 0
        }
        if {[string length $connected(fh,$modpod)]} {
            close $connected(fh,$modpod)
        }
        array unset connected *,$modpod
        set connected(to) [lreplace $connected(to) $posn $posn]
        return 1
    }
    proc get {args} {
        set argd [punk::args::get_dict {
            -from -default "" -help "path to pod"
            *values -min 1 -max 1
            filename
        } $args]
        set frompod [dict get $argd opts -from]
        set filename [dict get $argd values filename]

        variable connected
        #//review
        set modpod [::modpod::system::connect_if_not $frompod]
        set fh $connected(fh,$modpod)
        if {$connected(type,$modpod) eq "unwrapped"} {
            #for unwrapped connection - $connected(location) already points to the #modpod-pkg-ver folder
            if {[string range $filename 0 0 eq "/"]} {
                #absolute path (?)
                set path [file join $connected(location,$modpod) .. [string trim $filename /]]
            } else {
                #relative path - use #modpod-xxx as base
                set path [file join $connected(location,$modpod) $filename]
            }
            set fd [open $path r]
            #utf-8?
            #fconfigure $fd -encoding iso8859-1 -translation binary
            return [list ok [lindex [list [read $fd] [close $fd]]  0]]
        } else {
            #read from vfs
            puts stderr "get $filename from wrapped pod '$frompod' not implemented"
        }
    }


    #*** !doctools
    #[list_end] [comment {--- end definitions namespace modpod ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval modpod::lib {
    namespace export {[a-z]*};   # Convention: export all lowercase
    namespace path [namespace parent]
    #*** !doctools
    #[subsection {Namespace modpod::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 
    #}

    proc is_valid_tm_version {versionpart} {
        #Needs to be suitable for use with Tcl's 'package vcompare'
        if {![catch [list package vcompare $versionparts $versionparts]]} {
            return 1
        } else {
            return 0
        }
    }

    #zipfile is a pure zip at this point - ie no script/exe header
    proc make_zip_modpod {args} {
        set argd [punk::args::get_dict {
            @id -id ::modpod::lib::make_zip_modpod
            -offsettype -default "archive" -choices {archive file} -help\
                "Whether zip offsets are relative to start of file or start of zip-data within the file.
                'archive' relative offsets are easier to work with (for writing/updating) in tools such as 7zip,peazip,
                but other tools may be easier with 'file' relative offsets. (e.g info-zip,pkzip)
                info-zip's 'zip -A' can sometimes convert archive-relative to file-relative.
                -offsettype archive is equivalent to plain 'cat prefixfile zipfile > modulefile'"
            @values -min 2 -max 2
            zipfile  -type path -minsize 1 -help "path to plain zip file with subfolder #modpod-packagename-version containing .tm, data files and/or binaries"
            outfile  -type path -minsize 1 -help "path to output file. Name should be of the form packagename-version.tm"
        } $args]
        set zipfile [dict get $argd values zipfile]
        set outfile [dict get $argd values outfile]
        set opt_offsettype [dict get $argd opts -offsettype]


        set mount_stub [string map [list %offsettype% $opt_offsettype] {
            #zip file with Tcl loader prepended. Requires either builtin zipfs, or vfs::zip to mount while zipped.
            #Alternatively unzip so that extracted #modpod-package-version folder is in same folder as .tm file.
            #generated using: modpod::lib::make_zip_modpod -offsettype %offsettype% <zipfile> <tmfile>
            if {[catch {file normalize [info script]} modfile]} {
                error "modpod zip stub error. Unable to determine module path. (possible safe interp restrictions?)"
            }
            if {$modfile eq "" || ![file exists $modfile]} {
                error "modpod zip stub error. Unable to determine module path" 
            }
            set moddir [file dirname $modfile]
            set mod_and_ver [file rootname [file tail $modfile]]
            lassign [split $mod_and_ver -] moduletail version
            if {[file exists $moddir/#modpod-$mod_and_ver]} {
                source $moddir/#modpod-$mod_and_ver/$mod_and_ver.tm
            } else {
                #determine module namespace so we can mount appropriately
                proc intersect {A B} {
                    if {[llength $A] == 0} {return {}}
                    if {[llength $B] == 0} {return {}}
                    if {[llength $B] > [llength $A]} {
                        set res $A
                        set A $B
                        set B $res
                    }
                    set res {}
                    foreach x $A {set ($x) {}}
                    foreach x $B {
                        if {[info exists ($x)]} {
                            lappend res $x
                        }
                    }
                    return $res
                }
                set lcase_tmfile_segments [string tolower [file split $moddir]]
                set lcase_modulepaths     [string tolower [tcl::tm::list]]
                foreach lc_mpath $lcase_modulepaths {
                    set mpath_segments [file split $lc_mpath]
                    if {[llength [intersect $lcase_tmfile_segments $mpath_segments]] == [llength $mpath_segments]} {
                        set tail_segments [lrange [file split $moddir] [llength $mpath_segments] end] ;#use properly cased tail
                        break
                    }
                }
                if {[llength $tail_segments]} {
                    set fullpackage [join [concat $tail_segments $moduletail] ::] ;#full name of package as used in package require
                    set mount_at #modpod/[file join {*}$tail_segments]/#mounted-modpod-$mod_and_ver
                } else {
                    set fullpackage $moduletail
                    set mount_at #modpod/#mounted-modpod-$mod_and_ver
                }

                if {[info commands tcl::zipfs::mount] ne ""} {
                    #argument order changed to be consistent with vfs::zip::Mount etc
                    #early versions: zipfs::Mount mountpoint zipname
                    #since 2023-09:  zipfs::Mount zipname mountpoint
                    #don't use 'file exists' when testing mountpoints. (some versions at least give massive delays on windows platform for non-existance)
                    #This is presumably related to // being interpreted as a network path 
                    set mountpoints [dict keys [tcl::zipfs::mount]]
                    if {"//zipfs:/$mount_at" ni $mountpoints} {
                        #despite API change tcl::zipfs package version was unfortunately not updated - so we don't know argument order without trying it 
                        if {[catch {
                            #tcl::zipfs::mount $modfile //zipfs:/#mounted-modpod-$mod_and_ver ;#extremely slow if this is a wrong guess (artifact of aforementioned file exists issue ?)
                            #puts "tcl::zipfs::mount $modfile $mount_at"
                            tcl::zipfs::mount $modfile $mount_at 
                        } errM]} {
                            #try old api
                            if {![catch {tcl::zipfs::mount //zipfs:/$mount_at $modfile}]} {
                                puts stderr "modpod stub>>> tcl::zipfs::mount <file> <mountpoint> failed.\nbut old api: tcl::zipfs::mount <mountpoint> <file> succeeded\n tcl::zipfs::mount //zipfs://$mount_at  $modfile"
                                puts stderr "Consider upgrading tcl runtime to one with fixed zipfs API"
                            }
                        }
                        if {![file exists //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm]} {
                            puts stderr "modpod stub>>> mount at //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm failed\n zipfs mounts: [zipfs mount]"
                            #tcl::zipfs::unmount  //zipfs:/$mount_at
                            error "Unable to find $mod_and_ver.tm in $modfile for module $fullpackage"
                        }
                    } 
                    #  #modpod-$mod_and_ver subdirectory always present in the archive so it can be conveniently extracted and run in that form
                    source //zipfs:/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm
                } else {
                    #fallback to slower vfs::zip
                    #NB. We don't create the intermediate dirs - but the mount still works 
                    if {![file exists $moddir/$mount_at]} {
                        if {[catch {package require vfs::zip} errM]} {
                            set msg "Unable to load vfs::zip package to mount module $mod_and_ver (and zipfs not available either)"
                            append msg \n "If neither zipfs or vfs::zip are available - the module can still be loaded by manually unzipping the file $modfile in place."
                            append msg \n "The unzipped data will all be contained in a folder named #modpod-$mod_and_ver in the same parent folder as $modfile"
                            error $msg
                        } else {
                            set fd [vfs::zip::Mount $modfile $moddir/$mount_at]
                            if {![file exists $moddir/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm]} {
                                vfs::zip::Unmount $fd $moddir/$mount_at
                                error "Unable to find $mod_and_ver.tm in $modfile for module $fullpackage"
                            }
                        }
                    }
                    source $moddir/$mount_at/#modpod-$mod_and_ver/$mod_and_ver.tm
                }
            }
            #zipped data follows
        }]
        #todo - test if supplied zipfile has #modpod-loadcript.tcl or some other script/executable before even creating?
        append mount_stub \x1A
        modpod::system::make_mountable_zip $zipfile $outfile $mount_stub $opt_offsettype

    }

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



# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
namespace eval modpod::system {
    #*** !doctools
    #[subsection {Namespace modpod::system}]
    #[para] Internal functions that are not part of the API 

    #deflate,store only supported

    #zipfile here is plain zip - no script/exe prefix part.
    proc make_mountable_zip {zipfile outfile mount_stub {offsettype "archive"}} {
        set inzip [open $zipfile r]
        fconfigure $inzip -encoding iso8859-1 -translation binary
        set out [open $outfile w+]
        fconfigure $out -encoding iso8859-1 -translation binary
        puts -nonewline $out $mount_stub
        set stuboffset [tell $out]
        lappend report "stub size: $stuboffset"
        fcopy $inzip $out
        close $inzip

        set size [tell $out]
        lappend report "tmfile       : [file tail $outfile]"
        lappend report "output size  : $size" 
        lappend report "offsettype   : $offsettype"

        if {$offsettype eq "file"} {
            #make zip offsets relative to start of whole file including prepended script.
            #same offset structure as Tcl's 'zipfs mkimg' as at 2024-10
            #not editable by 7z,nanazip,peazip

            #we aren't adding any new files/folders so we can edit the offsets in place

            #Now seek in $out to find the end of directory signature:
            #The structure itself is 24 bytes Long, followed by a maximum of 64Kbytes text
            if {$size < 65559} {
                set tailsearch_start 0
            } else {
                set tailsearch_start [expr {$size - 65559}]
            }
            seek $out $tailsearch_start
            set data [read $out]
            #EOCD - End of Central Directory record
            #PK\5\6
            set start_of_end [string last "\x50\x4b\x05\x06" $data]
            #set start_of_end [expr {$start_of_end + $seek}]
            #incr start_of_end $seek
            set filerelative_eocd_posn [expr {$start_of_end + $tailsearch_start}]

            lappend report "kitfile-relative START-OF-EOCD: $filerelative_eocd_posn"

            seek $out $filerelative_eocd_posn
            set end_of_ctrl_dir [read $out]
            binary scan $end_of_ctrl_dir issssiis eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \
                eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) eocd(comment_len)

            lappend report "End of central directory: [array get eocd]"
            seek $out [expr {$filerelative_eocd_posn+16}]

            #adjust offset of start of central directory by the length of our sfx stub
            puts -nonewline $out [binary format i [expr {$eocd(diroffset) + $stuboffset}]]
            flush $out

            seek $out $filerelative_eocd_posn
            set end_of_ctrl_dir [read $out]
            binary scan $end_of_ctrl_dir issssiis eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \
                eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) eocd(comment_len)

            # 0x06054b50 - end of central dir signature
            puts stderr "$end_of_ctrl_dir"
            puts stderr "comment_len: $eocd(comment_len)"
            puts stderr "eocd sig: $eocd(signature) [punk::lib::dec2hex $eocd(signature)]"
            lappend report "New dir offset: $eocd(diroffset)"
            lappend report "Adjusting $eocd(totalnum) zip file items."
            catch {
                punk::lib::showdict -roottype list -chan stderr $report ;#heavy dependencies
            }
            
            seek $out $eocd(diroffset)
            for {set i 0} {$i <$eocd(totalnum)} {incr i} {
                set current_file [tell $out]
                set fileheader [read $out 46]
                puts --------------
                puts [ansistring VIEW -lf 1 $fileheader]
                puts --------------
                #binary scan $fileheader is2sss2ii2s3ssii x(sig) x(version) x(flags) x(method) \
                #    x(date) x(crc32) x(sizes) x(lengths) x(diskno) x(iattr) x(eattr) x(offset)

                binary scan $fileheader ic4sss2ii2s3ssii x(sig) x(version) x(flags) x(method) \
                    x(date) x(crc32) x(sizes) x(lengths) x(diskno) x(iattr) x(eattr) x(offset)
                set ::last_header $fileheader

                puts "sig: $x(sig) (hex: [punk::lib::dec2hex $x(sig)])" 
                puts "ver: $x(version)"
                puts "method: $x(method)"

                #PK\1\2 
                #33639248 dec = 0x02014b50 - central directory file header signature
                if { $x(sig) != 33639248 } {
                    error "modpod::system::make_mountable_zip Bad file header signature at item $i: dec:$x(sig) hex:[punk::lib::dec2hex $x(sig)]" 
                }
                
                foreach size $x(lengths) var {filename extrafield comment} {
                    if { $size > 0 } {
                        set x($var) [read $out $size] 
                    } else {
                        set x($var) ""
                    }
                }
                set next_file [tell $out]
                lappend report "file $i: $x(offset) $x(sizes) $x(filename)"
                
                seek $out [expr {$current_file+42}]
                puts -nonewline $out [binary format i [expr {$x(offset)+$stuboffset}]]
            
                #verify:
                flush $out
                seek $out $current_file
                set fileheader [read $out 46]
                lappend report "old $x(offset) + $stuboffset"    
                binary scan $fileheader is2sss2ii2s3ssii x(sig) x(version) x(flags) x(method) \
                    x(date) x(crc32) x(sizes) x(lengths) x(diskno) x(iattr) x(eattr) x(offset)
                lappend report "new $x(offset)"    
            
                seek $out $next_file        
            }
        }

        close $out
        #pdict/showdict reuire punk & textlib - ie lots of dependencies
        #don't fall over just because of that
        catch {
            punk::lib::showdict -roottype list -chan stderr $report
        }
        #puts [join $report \n]
        return
    }

    proc connect_if_not {{podpath ""}} {
        upvar ::modpod::connected connected
        set podpath [::modpod::system::normalize $podpath]
        set docon 0
        if {![llength $connected(to)]} {
            if {![string length $podpath]} {
                error "modpod::system::connect_if_not - Not connected to a modpod file, and no podpath specified"
            } else {
                set docon 1
            }
        } else {
            if {![string length $podpath]} {
                set podpath [lindex $connected(to) end]
                puts stderr "modpod::system::connect_if_not WARNING: using last connected modpod:$podpath for operation\n -podpath not explicitly specified during operation: [info level -1]"
            } else {
                if {$podpath ni $connected(to)} {
                    set docon 1
                }
            }
        }
        if {$docon} {
            if {[lindex [modpod::connect $podpath]] 0] ne "ok"} {
                error "modpod::system::connect_if_not error. file $podpath does not seem to be a valid modpod"
            } else {
                return $podpath
            }
        }
        #we were already connected
        return $podpath
    }

    proc myversion {} {
        upvar ::modpod::connected connected
        set script [info script]
        if {![string length $script]} {
            error "No result from \[info script\] - modpod::system::myversion should only be called from within a loading modpod"
        }
        set fname [file tail [file rootname [file normalize $script]]]
        set scriptdir [file dirname $script]
        
        if {![string match "#modpod-*" $fname]} {
            lassign [lrange [split $fname -] end-1 end] _pkgname version
        } else {
            lassign [scan [file tail [file rootname $script]] {#modpod-loadscript-%[a-z]-%s}] _pkgname version
            if {![string length $version]} {
                #try again on the name of the containing folder
                lassign [scan [file tail $scriptdir] {#modpod-%[a-z]-%s}] _pkgname version
                #todo - proper walk up the directory tree
                if {![string length $version]} {
                    #try again on the grandparent folder (this is a standard depth for sourced .tcl files in a modpod)
                    lassign [scan [file tail [file dirname $scriptdir]] {#modpod-%[a-z]-%s}] _pkgname version
                }
            }
        }

        #tarjar::Log debug "'myversion' determined version for [info script]:  $version"
        return $version
    }

    proc myname {} {
        upvar ::modpod::connected connected
        set script [info script]
        if {![string length $script]} {
            error "No result from \[info script\] - modpod::system::myname should only be called from within a loading modpod"
        }
        return $connected(fullpackage,$script)
    }
    proc myfullname {} {
        upvar ::modpod::connected connected
        set script [info script]
        #set script [::tarjar::normalize $script] 
        set script [file normalize $script]
        if {![string length $script]} {
            error "No result from \[info script\] - modpod::system::myfullname should only be called from within a loading tarjar"
        }
        return $::tarjar::connected(fullpackage,$script)
    }
    proc normalize {path} {
        #newer versions of Tcl don't do tilde sub

        #Tcl's 'file normalize' seems to do some unfortunate tilde substitution on windows.. (at least for relative paths)
        # we take the assumption here that if Tcl's tilde substitution is required - it should be done before the path is provided to this function.
        set matilda "<_tarjar_tilde_placeholder_>"  ;#token that is *unlikely* to occur in the wild, and is somewhat self describing in case it somehow ..escapes.. 
        set path [string map [list ~ $matilda] $path]  ;#give our tildes to matilda to look after
        set path [file normalize $path]
        #set path [string tolower $path] ;#must do this after file normalize
        return [string map [list $matilda ~] $path]  ;#get our tildes back.
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
##  Ready   
package provide modpod [namespace eval modpod {
    variable pkg modpod
    variable version
    set version 0.1.2 
}]
return

#*** !doctools
#[manpage_end]