# -*- 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: punkshell/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) 2024 JMN
# (C) 2009 Path Thoyts <patthyts@users.sourceforge.net>
#
# @@ Meta Begin
# Application punk::zip 0.1.1
# Meta platform     tcl
# Meta license      MIT 
# @@ Meta End


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

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

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


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

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

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

#*** !doctools
#[list_end]

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

#*** !doctools
#[section API]


# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Base namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval punk::zip {
    tcl::namespace::export {[a-z]*}  ;# Convention: export all lowercase
    #variable xyz

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

    proc Path_a_atorbelow_b {path_a path_b} {
        return [expr {[StripPath $path_b $path_a] ne $path_a}]
    }
    proc Path_a_at_b {path_a path_b} {
        return [expr {[StripPath $path_a $path_b] eq "." }]
    }

    proc Path_strip_alreadynormalized_prefixdepth {path prefix} {
        if {$prefix eq ""} {
            return $path
        }
        set pathparts   [file split $path]
        set prefixparts [file split $prefix]
        if {[llength $prefixparts] >= [llength $pathparts]} {
            return ""
        }
        return [file join \
            {*}[lrange \
                $pathparts \
                [llength $prefixparts] \
                end]]
    }

    #StripPath - borrowed from tcllib fileutil
    # ::fileutil::stripPath --
    #
    #	If the specified path references/is a path in prefix (or prefix itself) it
    #	is made relative to prefix. Otherwise it is left unchanged.
    #	In the case of it being prefix itself the result is the string '.'.
    #
    # Arguments:
    #	prefix		prefix to strip from the path.
    #	path		path to modify
    #
    # Results:
    #	path		The (possibly) modified path.

    if {[string equal $::tcl_platform(platform) windows]} {
        # Windows. While paths are stored with letter-case preserved al
        # comparisons have to be done case-insensitive. For reference see
        # SF Tcllib Bug 2499641.

        proc StripPath {prefix path} {
            # [file split] is used to generate a canonical form for both
            # paths, for easy comparison, and also one which is easy to modify
            # using list commands.

            set prefix [file split $prefix]
            set npath  [file split $path]

            if {[string equal -nocase $prefix $npath]} {
                return "."
            }

            if {[string match -nocase "${prefix} *" $npath]} {
                set path [eval [linsert [lrange $npath [llength $prefix] end] 0 file join ]]
            }
            return $path
        }
    } else {
        proc StripPath {prefix path} {
            # [file split] is used to generate a canonical form for both
            # paths, for easy comparison, and also one which is easy to modify
            # using list commands.

            set prefix [file split $prefix]
            set npath  [file split $path]

            if {[string equal $prefix $npath]} {
                return "."
            }

            if {[string match "${prefix} *" $npath]} {
                set path [eval [linsert [lrange $npath [llength $prefix] end] 0 file join ]]
            }
            return $path
        }
    }

    proc Timet_to_dos {time_t} {
        #*** !doctools
        #[call [fun Timet_to_dos] [arg time_t]]
        #[para] convert a unix timestamp into a DOS timestamp for ZIP times.
        #[example {
        #   DOS timestamps are 32 bits split into bit regions as follows:
        #                  24                16                 8                 0
        #   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
        #   |Y|Y|Y|Y|Y|Y|Y|m| |m|m|m|d|d|d|d|d| |h|h|h|h|h|m|m|m| |m|m|m|s|s|s|s|s|
        #   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
        #}]
        set s [clock format $time_t -format {%Y %m %e %k %M %S}]
        scan $s {%d %d %d %d %d %d} year month day hour min sec
        expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) 
            | ($hour << 11) | ($min << 5) | ($sec >> 1)}
    }
    punk::args::define {
        @id     -id ::punk::zip::walk
        @cmd    -name punk::zip::walk -help\
            "Walk the directory structure starting at base/<-subpath>
            and return a list of the files and folders encountered.
            Resulting paths are relative to base unless -resultrelative
            is supplied.
            Folder names will end with a trailing slash.
            "
        -resultrelative -optional 1 -help\
            "Resulting paths are relative to this value.
            Defaults to the value of base. If empty string
            is given to -resultrelative the paths returned
            are effectively absolute paths."
        -emptydirs -default 0 -type boolean -help\
            "Whether to include directory trees in the result which had no
            matches for the given fileglobs.
            Intermediate dirs are always returned if there is a match with
            fileglobs further down even if -emptdirs is 0.
            "
        -excludes   -default "" -help "list of glob expressions to match against files and exclude"
        -subpath    -default  "" -help\
            "May contain glob chars for folder elements"
        #If we don't include --, the call walk <options> -- <base> <globs>.. will return nothing as 'base' will receive the --
        -- -type none -optional 1
        @values -min 1 -max -1
        base
        fileglobs -default {*} -multiple 1
    }
    proc walk {args} {
        #*** !doctools
        #[call [fun walk] [arg ?options?] [arg base]]
        #[para] Walk a directory tree rooted at base
        #[para] the -excludes list can be a set of glob expressions to match against files and avoid
        #[para] e.g
        #[example {
        #  punk::zip::walk -exclude {CVS/* *~.#*} library
        #}]

        #todo:  -relative 0|1 flag?
        set argd [punk::args::parse $args withid ::punk::zip::walk]
        set base        [dict get $argd values base]
        set fileglobs   [dict get $argd values fileglobs]
        set subpath     [dict get $argd opts -subpath]
        set excludes    [dict get $argd opts -excludes]
        set emptydirs   [dict get $argd opts -emptydirs]

        set received    [dict get $argd received]

        set imatch [list]
        foreach fg $fileglobs {
            lappend imatch [file join $subpath $fg]
        }

        if {![dict exists $received -resultrelative]} {
            set relto $base
            set prefix ""
        } else {
            set relto [file normalize [dict get $argd opts -resultrelative]]
            if {$relto ne ""} {
                if {![Path_a_atorbelow_b $base $relto]} {
                    error "punk::zip::walk base must be at or below -resultrelative value (backtracking not currently supported)"
                } 
                set prefix [Path_strip_alreadynormalized_prefixdepth $base $relto]
            } else {
                set prefix $base
            }
        }

        set result {}
        #set imatch [file join $subpath $match]
        set files [glob -nocomplain -tails -types f -directory $base -- {*}$imatch]
        foreach file $files {
            set excluded 0
            foreach glob $excludes {
                if {[string match $glob $file]} {
                    set excluded 1
                    break
                }
            }
            if {!$excluded} {lappend result [file join $prefix $file]}
        }
        foreach dir [glob -nocomplain -tails -types d -directory $base -- [file join $subpath *]] {
            set submatches [walk -subpath $dir -emptydirs $emptydirs -excludes $excludes $base {*}$fileglobs]
            set subdir_entries [list]
            set thisdir_match [list] 
            set has_file 0
            foreach sd $submatches {
                set fullpath [file join $prefix $sd] ;#file join destroys trailing slash
                if {[string index $sd end] eq "/"} {
                    lappend subdir_entries $fullpath/
                } else {
                    set has_file 1
                    lappend subdir_entries $fullpath
                }
            }
            if {$emptydirs} {
                set thisdir_match [list "[file join $prefix $dir]/"]
            } else {
                if {$has_file} {
                    set thisdir_match [list "[file join $prefix $dir]/"]
                } else {
                    set subdir_entries [list]
                }
            }
            #NOTE: trailing slash required for entries to be recognised as 'file type' = "directory"
            #This is true for 2024 Tcl9 mounted zipfs at least. zip utilities such as 7zip seem(icon correct) to recognize dirs with or without trailing slash
            #Although there are attributes on some systems to specify if entry is a directory - it appears trailing slash should always be used for folder names.
            set result [list {*}$result {*}$thisdir_match {*}$subdir_entries]
        }
        return $result
    }

    #if there is an external preamble - extract that. (if there is also an internal preamble - ignore and consider part of the archive-data)
    #Otherwise extract an internal preamble.
    #if neither -?
    #review - reconsider auto-determination of internal vs external preamble
    punk::args::define {
        @id     -id ::punk::zip::extract_preamble
        @cmd    -name punk::zip::extract_preamble -help\
            "Split a zipfs based executable or library into its constituent
            binary and zip parts.

            Note that the binary preamble might be either 'within' the zip offsets,
            or simply catenated prior to an unadjusted zip.
            Some build processes may have 'adjusted' the zip offsets to make the zip cover the entire file
            ('file based' offset) whilst the more modern approach is to simply concatenate the binary and the zip
            ('archive based' offset). An archive-based offset is simpler and more reliably points to the proper
            split location. It also allows 'zipfs info //zipfs:/app' to return the correct offset information.

            Either way, extract_preamble can usually separate them, but in the unusual case that there is both an
            external preamble and a preamble within the zip, only the external preamble will be split, with the
            internal one remaining in the zip.

            The inverse of this process would be to extract the .zip file created by this split to a folder,
            e.g extracted_zip_folder (adjusting contents as required) and then to run:
             zipfs mkimg newbinaryname.exe extracted_zip_folder <prefix> \"\" <extracted_preamble_or_alternative exe>
             "
        @values -min 2 -max 3
        infile -type file -optional 0 -help\
            "Name of existing tcl executable or shared lib with attached zipfs filesystem"
        outfile_preamble  -optional 0 -type file -help\
            "Name of output file for binary preamble to be extracted to.
              If this file already exists, an error will be raised"
        outfile_zip -default "" -type file -help\
            "Name of output file for zip data to be extracted to.
              If this file already exists, an error will be raised"
    }
    proc extract_preamble {args} {
        set argd [punk::args::parse $args withid ::punk::zip::extract_preamble]
        lassign [dict values $argd] leaders opts values received

        set infile              [dict get $values infile]
        set outfile_preamble    [dict get $values outfile_preamble]
        set outfile_zip         [dict get $values outfile_zip]

        set inzip [open $infile r]
        fconfigure $inzip -encoding iso8859-1 -translation binary
        if {[file exists $outfile_preamble]} {
            error "outfile_preamble $outfile_preamble already exists - please remove first"
        }
        if {$outfile_zip ne ""} {
            if {[file exists $outfile_zip] && [file size $outfile_zip]} {
                error "outfile_zip $outfile_zip already exists - please remove first"
            }
        }
        chan seek $inzip 0 end
        set insize [tell $inzip] ;#faster (including seeks) than calling out to filesystem using file size - but should be equivalent
        chan seek $inzip 0 start
        #only scan last 64k - cover max signature size?? review
        if {$insize < 65559} {
            set tailsearch_start 0
        } else {
            set tailsearch_start [expr {$insize - 65559}]
        }
        chan seek $inzip $tailsearch_start start
        set scan [read $inzip]
        #EOCD - End Of Central Directory record
        set start_of_end [string last "\x50\x4b\x05\x06" $scan]
        puts stdout "==>start_of_end: $start_of_end"

        if {$start_of_end == -1} {
            #no zip eocdr - consider entire file to be the zip preamble 
            set baseoffset $insize
        } else {
            set filerelative_eocd_posn [expr {$start_of_end + $tailsearch_start}]
            chan seek $inzip $filerelative_eocd_posn
            set cdir_record_plus [read $inzip] ;#can have trailing data
            binary scan $cdir_record_plus issssiis eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \
                    eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) eocd(comment_len) 
            #rule out a false positive from within a nonzip (e.g plain exe)
            #There exists for example a PK\5\6 in a plain tclsh, but it doesn't appear to be zip related.
            #It doesn't seem to occur near the end - so perhaps not an issue - but we'll do some basic checks anyway
            #we only support single disk - so we'll validate a bit more by requiring disknbr and ctrldirdisk to be zeros
            #todo - just search for Pk\5\6\0\0\0\0 in the first place? //review
            if {$eocd(disknbr) + $eocd(ctrldirdisk) != 0} {
                #review - should keep searching?
                #for now we assume not a zip
                set baseoffset $insize 
            } else {
                #use the central dir size to jump back tko start of central dir
                #determine if diroffset is file or archive relative 

                set filerelative_cdir_start [expr {$filerelative_eocd_posn - $eocd(dirsize)}]
                puts stdout "---> [read $inzip 4]"
                if {$filerelative_cdir_start > $eocd(diroffset)} {
                    #'external preamble' easy case
                    # - ie 'archive' offset - (and one of the reasons I prefer archive-offset - it makes finding the 'prefix' easier
                    #though we are assuming zip offsets are not corrupted
                    set baseoffset [expr {$filerelative_cdir_start - $eocd(diroffset)}]
                } else {
                    #'internal preamble' hard case
                    # - either no preamble - or offsets have been adjusted to be file relative.
                    #we could scan from top (ugly) - and with binary prefixes we could get false positives in the data that look like PK\3\4 headers
                    #we could either work out the format for all possible executables that could be appended (across all platforms) and understand where they end?
                    #or we just look for the topmost PK\3\4 header pointed to by a CDR record - and assume the CDR is complete 

                    #step one - read all the CD records and find the highest pointed to local file record (which isn't necessarily the first - but should get us above most if not all of the zip data)
                    #we can't assume they're ordered in any particular way - so we in theory have to look at them all.
                    set baseoffset "unknown"
                    chan seek $inzip $filerelative_cdir_start start
                    #binary scan $cdir_record_plus issssiis eocd(signature) eocd(disknbr) eocd(ctrldirdisk) \
                    #    eocd(numondisk) eocd(totalnum) eocd(dirsize) eocd(diroffset) eocd(comment_len) 
                    #load the whole central dir into cdir

                    #todo! loop through all cdr file headers - find highest offset?
                    #tclZipfs.c just looks at first file header in Central Directory
                    #looking at all entries would be more robust - but we won't work harder than tclZipfs.c for now //REVIEW

                    set cdirdata [read $inzip $eocd(dirsize)]
                    binary scan $cdirdata issssssiiisssssii cdir(signature) cdir(_vermadeby) cdir(_verneeded) cdir(gpbitflag) cdir(compmethod) cdir(lastmodifiedtime) cdir(lastmodifieddate)\
                        cdir(uncompressedcrc32) cdir(compressedsize) cdir(uncompressedsize) cdir(filenamelength) cdir(extrafieldlength) cdir(filecommentlength) cdir(disknbr)\
                        cdir(internalfileattributes) cdir(externalfileatributes) cdir(relativeoffset) 
                    
                    #since we're in this branch - we assume cdir(relativeoffset) is from the start of the file
                    chan seek $inzip $cdir(relativeoffset)
                    #let's at least check that we landed on a local file header..
                    set local_file_header_beginning [read $inzip 28]; #local_file_header without the file name and extra field
                    binary scan $local_file_header_beginning isssssiiiss lfh(signature) lfh(_verneeded) lfh(gpbitflag) lfh(compmethod) lfh(lastmodifiedtime) lfh(lastmodifieddate)\
                        lfh(uncompressedcrc32) lfh(compressedsize) lfh(uncompressedsize) lfh(filenamelength) lfh(extrafieldlength)
                    #dec2hex 67324752 = 4034B50 = PK\3\4
                    puts stdout "1st local file header sig: $lfh(signature)"
                    if {$lfh(signature) == 67324752} {
                        #looks like a local file header
                        #use our cdir(relativeoffset) as the start of the zip-data (//review - possible embedded password + end marker preceeding this)
                        set baseoffset $cdir(relativeoffset) 
                    }
                }
                puts stdout "filerel_cdirstart: $filerelative_cdir_start recorded_offset: $eocd(diroffset)" 
            }
        }
        puts stdout "baseoffset: $baseoffset"
        #expect CDFH PK\1\2
        #above the CD - we expect a bunch of PK\3\4 records - (possibly not all of them pointed to by the CDR) 
        #above that we expect: *possibly* a stored password with trailing marker - then the prefixed exe/script 

        if {![string is integer -strict $baseoffset]} {
            error "unable to determine zip baseoffset of file $infile"
        }

        if {$baseoffset < $insize} {
            set pout   [open $outfile_preamble w] 
            fconfigure $pout -encoding iso8859-1 -translation binary
            chan seek $inzip 0 start
            chan copy $inzip $pout -size $baseoffset
            close $pout
            if {$outfile_zip ne ""} {
                #todo - if it was internal preamble - need to adjust offsets to fix the split off zipfile
                set zout [open $outfile_zip w]
                fconfigure $zout -encoding iso8859-1 -translation binary
                chan copy $inzip $zout
                close $zout
            }
            close $inzip
        } else {
            #no valid (from our perspective) eocdr found - baseoffset has been set to insize
            close $inzip
            file copy $infile $outfile_preamble
            if {$outfile_zip ne ""} {
                #touch equiv?
                set fd [open $outfile_zip w]
                close $fd
            }
        }
    }



    punk::args::define {
        @id     -id ::punk::zip::Addentry
        @cmd   -name punk::zip::Addentry\
            -summary\
            "Add zip-entry for file at 'path'"\
            -help\
            "Add a single file at 'path' to open channel 'zipchan'
            return a central directory file record"
        @opts
        -comment    -default "" -help "An optional comment specific to the added file"
        @values -min 3 -max 4
        zipchan  -help "open file descriptor with cursor at position appropriate for writing a local file header"
        base     -help "base path for entries"
        path     -type file -help "path of file to add"
        zipdataoffset  -default 0 -type integer -range {0 ""} -help "offset of start of zip-data - ie length of prefixing script/exe
        Can be specified as zero even if a prefix exists - which would make offsets 'file relative' as opposed to 'archive relative'"
    }

    # Addentry - was Mkzipfile --
    #
    # FIX ME: should  handle the current offset for non-seekable channels
    #
    proc Addentry {args} {
        #*** !doctools
        #[call [fun Addentry] [arg zipchan] [arg base] [arg path] [arg ?comment?]]
        #[para] Add a single file to a zip archive 
        #[para] The zipchan channel should already be open and binary.
        #[para] You can provide a -comment for the file.
        #[para] The return value is the central directory record that will need to be used when finalizing the zip archive.

        set argd [punk::args::parse $args withid ::punk::zip::Addentry]
        set zipchan [dict get $argd values zipchan]
        set base    [dict get $argd values base]
        set path    [dict get $argd values path]
        set zipdataoffset [dict get $argd values zipdataoffset]

        set comment [dict get $argd opts -comment]

        set fullpath [file join $base $path]
        set mtime [Timet_to_dos [file mtime $fullpath]]
        set utfpath [encoding convertto utf-8 $path]
        set utfcomment [encoding convertto utf-8 $comment]
        set flags [expr {(1<<11)}] ;# utf-8 comment and path
        set method 0               ;# store 0, deflate 8
        set attr 0                 ;# text or binary (default binary)
        set version 20             ;# minumum version req'd to extract
        set extra ""
        set crc 0
        set size 0
        set csize 0
        set data ""
        set seekable [expr {[tell $zipchan] != -1}]
        if {[file isdirectory $fullpath]} {
            set attrex 0x41ff0010  ;# 0o040777 (drwxrwxrwx)
            #set attrex 0x40000010
        } elseif {[file executable $fullpath]} {
            set attrex 0x81ff0080  ;# 0o100777 (-rwxrwxrwx)
        } else {
            set attrex 0x81b60020  ;# 0o100666 (-rw-rw-rw-)
            if {[file extension $fullpath] in {".tcl" ".txt" ".c"}} {
                set attr 1         ;# text
            }
        }
    
        if {[file isfile $fullpath]} {
            set size [file size $fullpath]
            if {!$seekable} {set flags [expr {$flags | (1 << 3)}]}
        }


        set channeloffset [tell $zipchan] ;#position in the channel - this may include prefixing exe/zip
        set local [binary format a4sssiiiiss PK\03\04 \
                        $version $flags $method $mtime $crc $csize $size \
                        [string length $utfpath] [string length $extra]]
        append local $utfpath $extra
        puts -nonewline $zipchan $local
    
        if {[file isfile $fullpath]} {
            # If the file is under 2MB then zip in one chunk, otherwize we use
            # streaming to avoid requiring excess memory. This helps to prevent
            # storing re-compressed data that may be larger than the source when
            # handling PNG or JPEG or nested ZIP files.
            if {$size < 0x00200000} {
                set fin [open $fullpath rb]
                set data [read $fin]
                set crc [zlib crc32 $data]
                set cdata [zlib deflate $data]
                if {[string length $cdata] < $size} {
                    set method 8
                    set data $cdata
                }
                close $fin
                set csize [string length $data]
                puts -nonewline $zipchan $data
            } else {
                set method 8
                set fin [open $fullpath rb]
                set zlib [zlib stream deflate]
                while {![eof $fin]} {
                    set data [read $fin 4096]
                    set crc [zlib crc32 $data $crc]
                    $zlib put $data
                    if {[string length [set zdata [$zlib get]]]} {
                        incr csize [string length $zdata]
                        puts -nonewline $zipchan $zdata
                    }
                }
                close $fin
                $zlib finalize
                set zdata [$zlib get]
                incr csize [string length $zdata]
                puts -nonewline $zipchan $zdata
                $zlib close
            }
        
            if {$seekable} {
                # update the header if the output is seekable
                set local [binary format a4sssiiii PK\03\04 \
                                $version $flags $method $mtime $crc $csize $size]
                set current [tell $zipchan]
                seek $zipchan $channeloffset
                puts -nonewline $zipchan $local
                seek $zipchan $current
            } else {
                # Write a data descriptor record
                set ddesc [binary format a4iii PK\7\8 $crc $csize $size]
                puts -nonewline $zipchan $ddesc
            }
        }

        #PK\x01\x02 Cdentral directory file header
        #set v1 0x0317 ;#upper byte 03 -> UNIX lower byte 23 -> 2.3
        set v1 0x0017 ;#upper byte 00 -> MS_DOS and OS/2 (FAT/VFAT/FAT32 file systems)

        set hdr [binary format a4ssssiiiisssssii PK\01\02 $v1 \
                    $version $flags $method $mtime $crc $csize $size \
                    [string length $utfpath] [string length $extra]\
                    [string length $utfcomment] 0 $attr $attrex [expr {$channeloffset - $zipdataoffset}]] ;#zipdataoffset may be zero - either because it's a pure zip, or file-based offsets desired.
        append hdr $utfpath $extra $utfcomment
        return $hdr
    }

    #### REVIEW!!!
    #JMN - review - this looks to be offset relative to start of file - (same as 2024 Tcl 'mkzip mkimg') 
    # we want to enable (optionally) offsets relative to start of archive for exe/script-prefixed zips.on windows (editability with 7z,peazip)
    ####


    punk::args::define {
        @id     -id ::punk::zip::mkzip
        @cmd   -name punk::zip::mkzip\
            -summary\
            "Create a zip archive in 'filename'."\
            -help\
            "Create a zip archive in 'filename'"
        @opts
        -offsettype -default "archive" -choices {archive file}\
            -help\
            "zip offsets stored relative to start of entire file or relative to start of zip-archive
              Only relevant if the created file has a script/runtime prefix."
        -return     -default "pretty" -choices {pretty list none}\
            -help\
            "mkzip can return a list of the files and folders added to the archive
              the option -return pretty is the default and uses the punk::lib pdict/plist system
              to return a formatted list for the terminal
        "
        -zipkit     -default 0 -type none\
            -help\
            "whether to add mounting script
              mutually exclusive with -runtime option
              currently vfs::zip based - todo - autodetect zipfs/vfs with pref for zipfs"
        -runtime    -default ""\
            -help\
            "specify a prefix file
              e.g punk::zip::mkzip -runtime unzipsfx.exe -directory subdir -base subdir output.zip
              will create a self-extracting zip archive from the subdir/ folder.
              Expects runtime with no existing vfs attached (review)"
        -comment    -default ""\
            -help "An optional comment for the archive"
        -directory  -default ""\
            -help "Scan for  contents within this folder or current directory if not provided."
        -base       -default ""\
            -help\
            "The new zip archive will be rooted in this directory if provided
              it must be a parent of -directory or the same path as -directory"
        -exclude    -default {CVS/* */CVS/* *~ ".#*" "*/.#*"}
        -- -type none -help\
            "End of options marker"

        @values -min 1 -max -1 
        filename -type file -default ""\
            -help "name of zipfile to create"
        globs -default {*} -multiple 1\
            -help\
            "list of glob patterns to match.
                Only directories with matching files will be included in the archive."
    }

    # zip::mkzip --
    #
    #        eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
    #
    proc mkzip {args} {
        #todo - doctools - [arg ?globs...?]  syntax?

        #*** !doctools
        #[call [fun mkzip]\
        #   [opt "[option -offsettype] [arg offsettype]"]\
        #   [opt "[option -return] [arg returntype]"]\
        #   [opt "[option -zipkit] [arg 0|1]"]\
        #   [opt "[option -runtime] [arg preamble_filename]"]\
        #   [opt "[option -comment] [arg zipfilecomment]"]\
        #   [opt "[option -directory] [arg dir_to_zip]"]\
        #   [opt "[option -base] [arg archive_root]"]\
        #   [opt "[option -exclude] [arg globlist]"]\
        #   [arg zipfilename]\
        #   [arg ?glob...?]]
        #[para] Create a zip archive in 'zipfilename'
        #[para] If a file already exists, an error will be raised. 
        #[para] Call 'punk::zip::mkzip' with no arguments for usage display.

        set argd [punk::args::parse $args withid ::punk::zip::mkzip]
        set filename [dict get $argd values filename]
        if {$filename eq ""} {
            error "mkzip filename cannot be empty string"
        }
        if {[regexp {[?*]} $filename]} {
            #catch a likely error where filename is omitted and first glob pattern is misinterpreted as zipfile name
            error "mkzip filename should not contain glob characters ? *"
        }
        if {[file exists $filename]} {
            error "mkzip filename:$filename already exists"
        }
        dict for {k v} [dict get $argd opts] {
            switch -- $k {
                -comment {
                    dict set argd opts $k [encoding convertto utf-8 $v]
                }
                -directory - -base {
                    dict set argd opts $k [file normalize $v]
                }
            }
        }

        array set opts [dict get $argd opts] 


        if {$opts(-directory) ne ""} {
            if {$opts(-base) ne ""} {
                #-base and -directory have been normalized already
                if {![Path_a_atorbelow_b $opts(-directory) $opts(-base)]} {
                    error "punk::zip::mkzip -base $opts(-base) must be above or the same as -directory $opts(-directory)"
                }
                set base $opts(-base)
                set relpath [Path_strip_alreadynormalized_prefixdepth $opts(-directory) $opts(-base)]
            } else {
                set base $opts(-directory)
                set relpath ""
            }
            #will pick up intermediary folders as paths (ending with trailing slash)
            set paths [walk -exclude $opts(-exclude) -subpath $relpath -- $base {*}[dict get $argd values globs]]

            set norm_filename [file normalize $filename]
            set norm_dir [file normalize $opts(-directory)] ;#we only care if filename below -directory (which is where we start scanning)
            if {[Path_a_atorbelow_b $norm_filename $norm_dir]} {
                #check that we aren't adding the zipfile to itself
                #REVIEW - now that we open zipfile after scanning - this isn't really a concern!
                #keep for now in case we can add an -update or a -force facility (or in case we modify to add to zip as we scan for members?) 
                #In the case of -force - we may want to delay replacement of original until scan is done?
                
                #try to avoid looping on all paths and performing (somewhat) expensive file normalizations on each 
                #1st step is to check the patterns and see if our zipfile is already excluded - in which case we need not check the paths
                set self_globs_match 0
                foreach g [dict get $argd values globs] {
                    if {[string match $g [file tail $filename]]} {
                        set self_globs_match 1
                        break
                    }
                }
                if {$self_globs_match} {
                    #still dangerous
                    set self_excluded 0
                    foreach e $opts(-exclude) {
                        if {[string match $e [file tail $filename]]} {
                            set self_excluded 1
                            break
                        }
                    }
                    if {!$self_excluded} {
                        #still dangerous - likely to be in resultset - check each path
                        #puts stderr "zip file $filename is below directory $opts(-directory)"
                        set self_is_matched 0
                        set i 0
                        foreach p $paths {
                            set norm_p [file normalize [file join $opts(-directory) $p]]
                            if {[Path_a_at_b $norm_filename $norm_p]} {
                                set self_is_matched 1
                                break
                            }
                            incr i
                        }
                        if {$self_is_matched} {
                            puts stderr "WARNING - zipfile being created '$filename' was matched.  Excluding this file. Relocate the zip, or use -exclude patterns to avoid this message"
                            set paths [lremove $paths $i]
                        }
                    }
                }
            }
        } else {
            #NOTE that we don't add intermediate folders when creating an archive without using the -directory flag!
            #ie - only the exact *files* matching the glob are stored.
            set paths [list]
            set dir [pwd]
            if {$opts(-base) ne ""} {
                if {![Path_a_atorbelow_b $dir $opts(-base)]} {
                    error "punk::zip::mkzip -base $opts(-base) must be above current directory"
                }
                set relpath [Path_strip_alreadynormalized_prefixdepth [file normalize $dir] [file normalize $opts(-base)]]
            } else {
                set relpath "" 
            }
            set base $opts(-base)

            set matches [glob -nocomplain -type f -- {*}[dict get $argd values globs]]
            foreach m $matches {
                if {$m eq $filename} {
                    #puts stderr "--> excluding $filename"
                    continue
                }
                set isok 1
                foreach e [concat $opts(-exclude) $filename] {
                    if {[string match $e $m]} {
                        set isok 0 
                        break 
                    }
                }
                if {$isok} {
                    lappend paths [file join $relpath $m]
                }
            }
        }

        if {![llength $paths]} {
            return ""
        }

        set zf [open $filename wb]
        if {$opts(-runtime) ne ""} {
            #todo - strip any existing vfs - option to merge contents.. only if zip attached?
            set rt [open $opts(-runtime) rb]
            fcopy $rt $zf
            close $rt
        } elseif {$opts(-zipkit)} {
            #TODO - update to zipfs ?
            #see modpod
            set zkd "#!/usr/bin/env tclkit\n\# This is a zip-based Tcl Module\n"
            append zkd "package require vfs::zip\n"
            append zkd "vfs::zip::Mount \[info script\] \[info script\]\n"
            append zkd "if {\[file exists \[file join \[info script\] main.tcl\]\]} {\n"
            append zkd "    source \[file join \[info script\] main.tcl\]\n"
            append zkd "}\n"
            append zkd \x1A
            puts -nonewline $zf $zkd
        }

        #todo - subtract this from the endrec offset 
        if {$opts(-offsettype) eq "archive"} {
            set dataStartOffset [tell $zf] ;#the overall file offset of the start of archive-data  //JMN 2024
        } else {
            set dataStartOffset 0  ;#offsets relative to file - the (old) zipfs mkzip way :/
        }

        set count 0
        set cd ""

        set members [list]
        foreach path $paths {
            #puts $path
            lappend members $path
            append cd [Addentry $zf $base $path $dataStartOffset] ;#path already includes relpath 
            incr count
        }
        set cdoffset [tell $zf]
        set endrec [binary format a4ssssiis PK\05\06 0 0 \
                        $count $count [string length $cd] [expr {$cdoffset - $dataStartOffset}]\
                        [string length $opts(-comment)]]
        append endrec $opts(-comment)
        puts -nonewline $zf $cd
        puts -nonewline $zf $endrec
        close $zf

        set result ""
        switch -exact -- $opts(-return) {
            list {
                set result $members
            }
            pretty {
                if {[info commands showlist] ne ""} {
                    set result [plist -channel none members]
                } else {
                    set result $members
                }
            }
            none {
                set result ""
            }
        }
        return  $result
    }


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


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



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

#*** !doctools
#[manpage_end]