diff --git a/src/vfs/_vfscommon.vfs/modules/argparsingtest-1.2.0.tm b/src/vfs/_vfscommon.vfs/modules/argparsingtest-1.3.0.tm similarity index 93% rename from src/vfs/_vfscommon.vfs/modules/argparsingtest-1.2.0.tm rename to src/vfs/_vfscommon.vfs/modules/argparsingtest-1.3.0.tm index 6e54f739..91d9e1b8 100644 --- a/src/vfs/_vfscommon.vfs/modules/argparsingtest-1.2.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/argparsingtest-1.3.0.tm @@ -8,7 +8,7 @@ # (C) Julian Noble 2024 # # @@ Meta Begin -# Application argparsingtest 1.2.0 +# Application argparsingtest 1.3.0 # Meta platform tcl # Meta license MIT # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_argparsingtest 0 1.2.0] +#[manpage_begin punkshell_module_argparsingtest 0 1.3.0] #[copyright "2024"] #[titledesc {Module API}] [comment {-- Name section and table of contents description --}] #[moddesc {-}] [comment {-- Description at end of page heading --}] @@ -50,15 +50,28 @@ package require Tcl 8.6- package require punk::args -package require opt -package require cmdline -package require tepam + +# Every parser package this module compares is OPTIONAL, including the tcllib ones. +# A comparison harness that cannot load at all because one of the libraries it +# compares is absent is useless on exactly the runtime you most want to measure - +# and punkshell builds do ship without tcllib. A missing library must degrade to a +# not_loaded row (see the {optional } roster markers), never to a load failure. +# Guarded here rather than at the call sites because the guard needed differs: +# cmdline - used only INSIDE proc bodies, so the requires below are the whole story +# opt - tcl::OptProc DEFINES the wrapper procs, so each definition site is +# tepam additionally guarded by an 'is the package present' test. Those sites +# test presence rather than catching, so a genuine error in a spec still +# surfaces loudly on a runtime that does have the package. +# argp, parse_args and argparse are required further down, at their own sites. +catch {package require opt} +catch {package require cmdline} +catch {package require tepam} #*** !doctools #[item] [package {Tcl 8.6}] #[item] [package {punk::args}] -#[item] [package {opt}] -#[item] [package {cmdline}] -#[item] [package {tepam}] +#[item] [package {opt}] (optional - parser under test) +#[item] [package {cmdline}] (optional - parser under test) +#[item] [package {tepam}] (optional - parser under test) # #package require frobz # #*** !doctools @@ -163,13 +176,13 @@ namespace eval argparsingtest { punkargs_by_id always punkargs_parsecache always punkargs_validate_ansistripped always - opt always - cmdline_untyped always - cmdline_typed always + opt {optional opt} + cmdline_untyped {optional cmdline} + cmdline_typed {optional cmdline} argp {optional argp} parse_args {optional parse_args} argparse {optional argparse} - tepam always + tepam {optional tepam} } } tkstyle { @@ -180,8 +193,8 @@ namespace eval argparsingtest { punkargs always punkargs_by_id always punkargs_parsecache always - opt always - tepam always + opt {optional opt} + tepam {optional tepam} argparse {optional argparse} cmdline_untyped unsupported cmdline_typed unsupported @@ -197,10 +210,10 @@ namespace eval argparsingtest { punkargs always punkargs_by_id always punkargs_parsecache always - opt always - cmdline_untyped always - cmdline_typed always - tepam always + opt {optional opt} + cmdline_untyped {optional cmdline} + cmdline_typed {optional cmdline} + tepam {optional tepam} parse_args {optional parse_args} argparse {optional argparse} argp unsupported @@ -214,7 +227,7 @@ namespace eval argparsingtest { punkargs always punkargs_by_id always punkargs_parsecache always - opt always + opt {optional opt} argparse {optional argparse} cmdline_untyped unsupported cmdline_typed unsupported @@ -1494,24 +1507,27 @@ namespace eval argparsingtest::opts { -join -type none -multiple 1 }] } - tcl::OptProc opt { - {-return string "return type"} - {-frametype \uFFEF "type of frame"} - {-show_edge \uFFEF "show table outer borders"} - {-show_seps \uFFEF "show separators"} - {-join "solo option"} - {-x "" "x val"} - {-y b "y val"} - {-z c "z val"} - {-1 1 "1val"} - {-2 -int 2 "2val"} - {-3 -int 3 "3val"} - } { - set opts [dict create] - foreach v [info locals] { - dict set opts $v [set $v] + #tcl::OptProc DEFINES this proc, so skip the definition when opt is absent - see the optional-package requires at the module top + if {![catch {package present opt}]} { + tcl::OptProc opt { + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + } { + set opts [dict create] + foreach v [info locals] { + dict set opts $v [set $v] + } + return $opts } - return $opts } #cmdline::getoptions is much faster than typedGetoptions @@ -1736,22 +1752,25 @@ namespace eval argparsingtest::opts { -join -type none -multiple 1 }] } - tepam::procedure {tepam} { - -args { - {-return -type string -default string} - {-frametype -type string -default \uFFEF} - {-show_edge -type string -default \uFFEF} - {-show_seps -type string -default \uFFEF} - {-join -type none -multiple} - {-x -type string -default ""} - {-y -type string -default b} - {-z -type string -default c} - {-1 -type boolean -default 1} - {-2 -type integer -default 2} - {-3 -type integer -default 3} - } - } { - return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join] + #tepam::procedure DEFINES this proc, so skip the definition when tepam is absent - see the optional-package requires at the module top + if {![catch {package present tepam}]} { + tepam::procedure {tepam} { + -args { + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default ""} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + } + } { + return [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join] + } } #*** !doctools @@ -1967,28 +1986,31 @@ namespace eval argparsingtest::tkstyle { -join -type none -multiple 1 }] } - tcl::OptProc opt { - {p1 -string "first positional argument"} - {p2 -string "second positional argument"} - {-return string "return type"} - {-frametype \uFFEF "type of frame"} - {-show_edge \uFFEF "show table outer borders"} - {-show_seps \uFFEF "show separators"} - {-join "solo option"} - {-x "" "x val"} - {-y b "y val"} - {-z c "z val"} - {-1 1 "1val"} - {-2 -int 2 "2val"} - {-3 -int 3 "3val"} - } { - set opts [dict create] - foreach v [info locals] { - if {$v ni {p1 p2 opts args Args}} { - dict set opts $v [set $v] + #tcl::OptProc DEFINES this proc, so skip the definition when opt is absent - see the optional-package requires at the module top + if {![catch {package present opt}]} { + tcl::OptProc opt { + {p1 -string "first positional argument"} + {p2 -string "second positional argument"} + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + } { + set opts [dict create] + foreach v [info locals] { + if {$v ni {p1 p2 opts args Args}} { + dict set opts $v [set $v] + } } + return [list $p1 $p2 $opts] } - return [list $p1 $p2 $opts] } namespace eval argdoc { @@ -2015,25 +2037,28 @@ namespace eval argparsingtest::tkstyle { -join -type none -multiple 1 }] } - tepam::procedure {tepam} { - -named_arguments_first 0 - -args { - {p1 -type string} - {p2 -type string} - {-return -type string -default string} - {-frametype -type string -default \uFFEF} - {-show_edge -type string -default \uFFEF} - {-show_seps -type string -default \uFFEF} - {-join -type none -multiple} - {-x -type string -default ""} - {-y -type string -default b} - {-z -type string -default c} - {-1 -type boolean -default 1} - {-2 -type integer -default 2} - {-3 -type integer -default 3} - } - } { - return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]] + #tepam::procedure DEFINES this proc, so skip the definition when tepam is absent - see the optional-package requires at the module top + if {![catch {package present tepam}]} { + tepam::procedure {tepam} { + -named_arguments_first 0 + -args { + {p1 -type string} + {p2 -type string} + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default ""} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + } + } { + return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]] + } } namespace eval argdoc { @@ -2296,28 +2321,31 @@ namespace eval argparsingtest::tclstyle { p2 -type string -optional 0 }] } - tcl::OptProc opt { - {-return string "return type"} - {-frametype \uFFEF "type of frame"} - {-show_edge \uFFEF "show table outer borders"} - {-show_seps \uFFEF "show separators"} - {-join "solo option"} - {-x "" "x val"} - {-y b "y val"} - {-z c "z val"} - {-1 1 "1val"} - {-2 -int 2 "2val"} - {-3 -int 3 "3val"} - {p1 -string "first positional argument"} - {p2 -string "second positional argument"} - } { - set opts [dict create] - foreach v [info locals] { - if {$v ni {p1 p2 opts args Args}} { - dict set opts $v [set $v] + #tcl::OptProc DEFINES this proc, so skip the definition when opt is absent - see the optional-package requires at the module top + if {![catch {package present opt}]} { + tcl::OptProc opt { + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + {p1 -string "first positional argument"} + {p2 -string "second positional argument"} + } { + set opts [dict create] + foreach v [info locals] { + if {$v ni {p1 p2 opts args Args}} { + dict set opts $v [set $v] + } } + return [list $p1 $p2 $opts] } - return [list $p1 $p2 $opts] } namespace eval argdoc { @@ -2439,24 +2467,27 @@ namespace eval argparsingtest::tclstyle { p2 -type string -optional 0 }] } - tepam::procedure {tepam} { - -args { - {-return -type string -default string} - {-frametype -type string -default \uFFEF} - {-show_edge -type string -default \uFFEF} - {-show_seps -type string -default \uFFEF} - {-join -type none -multiple} - {-x -type string -default ""} - {-y -type string -default b} - {-z -type string -default c} - {-1 -type boolean -default 1} - {-2 -type integer -default 2} - {-3 -type integer -default 3} - {p1 -type string} - {p2 -type string} - } - } { - return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]] + #tepam::procedure DEFINES this proc, so skip the definition when tepam is absent - see the optional-package requires at the module top + if {![catch {package present tepam}]} { + tepam::procedure {tepam} { + -args { + {-return -type string -default string} + {-frametype -type string -default \uFFEF} + {-show_edge -type string -default \uFFEF} + {-show_seps -type string -default \uFFEF} + {-join -type none -multiple} + {-x -type string -default ""} + {-y -type string -default b} + {-z -type string -default c} + {-1 -type boolean -default 1} + {-2 -type integer -default 2} + {-3 -type integer -default 3} + {p1 -type string} + {p2 -type string} + } + } { + return [list $p1 $p2 [dict create return $return frametype $frametype show_edge $show_edge show_seps $show_seps x $x y $y z $z 1 $1 2 $2 3 $3 join $join]] + } } namespace eval argdoc { @@ -2848,31 +2879,34 @@ namespace eval argparsingtest::sandwich { p5 -type string -optional 0 }] } - tcl::OptProc opt { - {p1 -string "first leading positional argument"} - {p2 -string "second leading positional argument"} - {-return string "return type"} - {-frametype \uFFEF "type of frame"} - {-show_edge \uFFEF "show table outer borders"} - {-show_seps \uFFEF "show separators"} - {-join "solo option"} - {-x "" "x val"} - {-y b "y val"} - {-z c "z val"} - {-1 1 "1val"} - {-2 -int 2 "2val"} - {-3 -int 3 "3val"} - {p3 -string "first trailing positional argument"} - {p4 -string "second trailing positional argument"} - {p5 -string "third trailing positional argument"} - } { - set opts [dict create] - foreach v [info locals] { - if {$v ni {p1 p2 p3 p4 p5 opts args Args}} { - dict set opts $v [set $v] + #tcl::OptProc DEFINES this proc, so skip the definition when opt is absent - see the optional-package requires at the module top + if {![catch {package present opt}]} { + tcl::OptProc opt { + {p1 -string "first leading positional argument"} + {p2 -string "second leading positional argument"} + {-return string "return type"} + {-frametype \uFFEF "type of frame"} + {-show_edge \uFFEF "show table outer borders"} + {-show_seps \uFFEF "show separators"} + {-join "solo option"} + {-x "" "x val"} + {-y b "y val"} + {-z c "z val"} + {-1 1 "1val"} + {-2 -int 2 "2val"} + {-3 -int 3 "3val"} + {p3 -string "first trailing positional argument"} + {p4 -string "second trailing positional argument"} + {p5 -string "third trailing positional argument"} + } { + set opts [dict create] + foreach v [info locals] { + if {$v ni {p1 p2 p3 p4 p5 opts args Args}} { + dict set opts $v [set $v] + } } + return [list [list $p1 $p2] [list $p3 $p4 $p5] $opts] } - return [list [list $p1 $p2] [list $p3 $p4 $p5] $opts] } namespace eval argdoc { @@ -2985,7 +3019,7 @@ namespace eval ::punk::args::register { package provide argparsingtest [namespace eval argparsingtest { variable pkg argparsingtest variable version - set version 1.2.0 + set version 1.3.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/oolib-0.1.3.tm b/src/vfs/_vfscommon.vfs/modules/oolib-0.1.4.tm similarity index 98% rename from src/vfs/_vfscommon.vfs/modules/oolib-0.1.3.tm rename to src/vfs/_vfscommon.vfs/modules/oolib-0.1.4.tm index e44e2a8d..0701e6a4 100644 --- a/src/vfs/_vfscommon.vfs/modules/oolib-0.1.3.tm +++ b/src/vfs/_vfscommon.vfs/modules/oolib-0.1.4.tm @@ -136,7 +136,7 @@ namespace eval oolib { error "[self object] collection key must not be an integer. Use another structure if integer keys required" } if {[dict exists $o_data $key]} { - error "[self object] col_processors object error: key '$key' already exists in collection" + error "[self object] collection error: key '$key' already exists in collection" } dict set o_data $key $value return [expr {[dict size $o_data] - 1}] ;#return index of item @@ -196,5 +196,5 @@ namespace eval oolib { package provide oolib [namespace eval oolib { variable version - set version 0.1.3 + set version 0.1.4 }] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.1.tm similarity index 87% rename from src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.1.tm index 0fd5cef0..785c0514 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.1.tm @@ -8,7 +8,7 @@ # (C) 2026 # # @@ Meta Begin -# Application punk::args::moduledoc::punkexe 0.1.0 +# Application punk::args::moduledoc::punkexe 0.1.1 # Meta platform tcl # Meta license BSD # @@ Meta End @@ -18,7 +18,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::args::moduledoc::punkexe 0 0.1.0] +#[manpage_begin punkshell_module_punk::args::moduledoc::punkexe 0 0.1.1] #[copyright "2026"] #[titledesc {punk executable launch documentation}] [comment {-- Name section and table of contents description --}] #[moddesc {-}] [comment {-- Description at end of page heading --}] @@ -91,9 +91,13 @@ tcl::namespace::eval punk::args::moduledoc::punkexe { An optional FIRST argument selects package modes: one or more of the tokens dev, os, src, internal joined with '-' when combined - (e.g 'dev', 'src', 'dev-src'). Modes decide which module sources - the shell trusts and their precedence; 'internal' (kit-bundled - modules) is always appended when absent. Details: bin/AGENTS.md + (e.g 'dev', 'src', 'dev-src'), optionally scoped with the + 'proj:' prefix (e.g 'proj:internal-src') so dev/src resolve + against the project containing the current directory instead of + the executable's own (G-033 visitor mode). Modes decide which + module sources the shell trusts and their precedence; 'internal' + (kit-bundled modules) is always appended when absent. Full + contract: the packagemode leader below and bin/AGENTS.md 'launch package modes' in the punkshell source tree. The next argument selects a subcommand from the choices below. @@ -102,7 +106,33 @@ tcl::namespace::eval punk::args::moduledoc::punkexe { ('shell'); any other first argument is treated as a script invocation (handled as for the 'script' subcommand)." @form -synopsis " ?packagemode? ?subcommand? ?arg ...?" - @leaders -min 0 -max 1 + @leaders -min 0 -max 2 + packagemode -type string -optional 1 -default internal -help\ + "Package-source mode: an ordered dash-separated list of path + blocks, optionally scoped with the 'proj:' prefix. + Blocks (each adds a group of module/library paths): + internal - paths inside the executable's kit (always included; + appended last unless listed explicitly) + dev - the project's built output (/modules ...) + src - the project's unbuilt source (src/modules, + src/bootsupport/modules, src/vendormodules, src/lib) + os - ad-hoc .tm paths from the current directory/environment + Without 'proj:', dev/src resolve against the executable's own + project (executable in /bin). With 'proj:', they + resolve against the nearest project root at or above the current + directory (a git or fossil repository root) - for an installed + punkshell binary visiting a project that builds no shell of its + own. + ORDER MATTERS: earlier blocks win when the same version of a + module exists in more than one location. + Examples: + src work on the executable's own project source + proj:internal-src explore the cwd project; the executable's own + copies win version ties (robust visitor default) + proj:src explore the cwd project; ITS copies win version + ties (faithful to the project's snapshot vintage) + The launch reports the detected project root and effective + precedence." subcommand -type string -optional 1 -choicerestricted 0 -choices {tclsh script shell punk shellspy} -choicelabels { tclsh " Run as a (near) stock tclsh - no punk modules loaded." @@ -335,7 +365,7 @@ namespace eval ::punk::args::register { package provide punk::args::moduledoc::punkexe [tcl::namespace::eval punk::args::moduledoc::punkexe { variable pkg punk::args::moduledoc::punkexe variable version - set version 0.1.0 + set version 0.1.1 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm index 96b4ab8f..664ca687 100644 Binary files a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm and b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm differ diff --git a/src/vfs/_vfscommon.vfs/modules/punk/zip-0.2.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/zip-0.3.0.tm similarity index 89% rename from src/vfs/_vfscommon.vfs/modules/punk/zip-0.2.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/zip-0.3.0.tm index eb1651da..60b20732 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/zip-0.2.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/zip-0.3.0.tm @@ -9,7 +9,7 @@ # (C) 2009 Path Thoyts # # @@ Meta Begin -# Application punk::zip 0.2.0 +# Application punk::zip 0.3.0 # Meta platform tcl # Meta license MIT # @@ Meta End @@ -19,7 +19,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::zip 0 0.2.0] +#[manpage_begin punkshell_module_punk::zip 0 0.3.0] #[copyright "2024"] #[titledesc {Module API}] [comment {-- Name section and table of contents description --}] #[moddesc {-}] [comment {-- Description at end of page heading --}] @@ -66,7 +66,15 @@ package require punk::args # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ tcl::namespace::eval punk::zip { tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase - #variable xyz + + #G-126 accelerator state - see punk::zip::accelerator and punk::zip::unzip. + #The pure-Tcl reader is the always-available floor; the vendored punkzip + #binary is an optional per-call extraction accelerator. + variable accelerator_config auto ;#auto | none | + variable accelerator_resolved "" + variable accelerator_resolved_for "\uFFFF" ;#config value the cached resolution was computed for + variable last_unzip_engine "" ;#tcl | accelerated - which engine the last unzip used + variable last_accelerator_note "" ;#why the last unzip skipped the accelerator or fell back #*** !doctools #[subsection {Namespace punk::zip}] @@ -1104,6 +1112,79 @@ tcl::namespace::eval punk::zip { return [Select_members [dict get $arc members] $globs $excludes] } + punk::args::define { + @id -id ::punk::zip::accelerator + @cmd -name punk::zip::accelerator\ + -summary\ + "Query or configure the optional punkzip extraction accelerator"\ + -help\ + "punk::zip can hand whole-archive extraction to the vendored punkzip + tool (goal G-126; built to bin/ by 'make.tcl tool build punkzip') + when a usable binary is present - materially faster for large member + counts - while the pure-Tcl reader remains the always-available + floor and the authority on preflight refusals, member selection and + returned names. + + With no argument, returns the currently resolved accelerator path, + or an empty string when none is usable. With an argument, sets the + configuration and returns the new resolution: + auto - (default) probe: env(PUNKZIP_EXE) if set, else a punkzip + executable beside [info nameofexecutable] + none - disable the accelerator (pure-Tcl always) + - use the punkzip binary at an explicit path + + Resolution is cached until the configuration changes. See + punk::zip::unzip for when the accelerator is actually used: calls it + cannot serve identically run pure-Tcl, and an accelerator failure + falls back to pure-Tcl silently. For diagnostics and tests, + punk::zip::last_unzip_engine records which engine the last unzip + used (tcl|accelerated) and punk::zip::last_accelerator_note records + why the accelerator was skipped or abandoned." + @values -min 0 -max 1 + config -optional 1 -default "" -help\ + "auto | none | path of a punkzip executable. + Empty (or omitted) queries without changing the configuration." + } + proc accelerator {args} { + set argd [punk::args::parse $args withid ::punk::zip::accelerator] + variable accelerator_config + variable accelerator_resolved + variable accelerator_resolved_for + set config [dict get $argd values config] + if {$config ne ""} { + set accelerator_config $config + } + if {$accelerator_resolved_for eq $accelerator_config} { + return $accelerator_resolved + } + set resolved "" + set candidates [list] + switch -exact -- $accelerator_config { + none {} + auto { + if {[info exists ::env(PUNKZIP_EXE)] && $::env(PUNKZIP_EXE) ne ""} { + lappend candidates $::env(PUNKZIP_EXE) + } else { + set exedir [file dirname [info nameofexecutable]] + lappend candidates [file join $exedir punkzip.exe] [file join $exedir punkzip] + } + } + default { + lappend candidates $accelerator_config + } + } + foreach c $candidates { + #file executable is unreliable for some windows setups - existence suffices there + if {[file isfile $c] && ([file executable $c] || $::tcl_platform(platform) eq "windows")} { + set resolved [file normalize $c] + break + } + } + set accelerator_resolved $resolved + set accelerator_resolved_for $accelerator_config + return $resolved + } + punk::args::define { @id -id ::punk::zip::unzip @cmd -name punk::zip::unzip\ @@ -1124,6 +1205,15 @@ tcl::namespace::eval punk::zip { naming the reason instead of leaving a half-populated directory. A member whose path would escape targetdir is refused the same way. + When the punkzip accelerator is available (see punk::zip::accelerator) + and the call is one it serves identically - whole archive, default + -overwrite/-mtime/-verify, ascii member names - the member data is + written by the accelerator instead of the pure-Tcl loop, with mtimes + re-stamped to this module's convention afterwards; preflight, member + selection and the returned names always come from punk::zip's own + reader, and any accelerator failure falls back to pure Tcl silently. + punk::zip::last_unzip_engine records which engine ran. + Returns the list of member names extracted (see -return). Examples: @@ -1178,6 +1268,11 @@ tcl::namespace::eval punk::zip { set restoremtime [dict get $argd opts -mtime] set verify [dict get $argd opts -verify] + variable last_unzip_engine + variable last_accelerator_note + set last_unzip_engine tcl + set last_accelerator_note "" + set arc [Open_archive $zipfile 1] set chan [dict get $arc chan] set extracted [list] @@ -1186,6 +1281,7 @@ tcl::namespace::eval punk::zip { set selected [Select_members [dict get $arc members] $globs $excludes] #preflight - nothing is written until every selected member is known good set targets [list] + set names_ascii 1 foreach m $selected { set reason [Member_unsupported_reason $m] if {$reason ne ""} { @@ -1195,24 +1291,71 @@ tcl::namespace::eval punk::zip { if {!$overwrite && !([dict get $m isdirectory]) && [file exists $target]} { error "punk::zip::unzip: '$target' already exists and -overwrite is 0" } + if {![string is ascii [dict get $m name]]} { + set names_ascii 0 + } lappend targets $target } file mkdir $targetdir - foreach m $selected target $targets { - set name [dict get $m name] - if {[dict get $m isdirectory]} { - file mkdir $target - if {$restoremtime && [dict get $m mtime]} { - lappend dirtimes $target [dict get $m mtime] - } + + #G-126 accelerator: hand whole-archive member WRITING to the vendored + #punkzip binary when this call is one it serves identically. punk::zip's + #own parse above stays authoritative for preflight refusals, member + #selection and the returned names; the pure-Tcl loop below is the + #always-available floor and any accelerator failure falls back to it + #silently. Eligibility: whole archive (globs {*}, no excludes), the + #default -overwrite/-mtime/-verify semantics punkzip matches (it always + #overwrites, restores times and crc-verifies), and ascii member names + #(punkzip's name handling is wtf-8; punk::zip decodes cp437/utf-8 flags). + #punkzip stamps mtimes with its tz-free utc convention, so after a + #successful run the members are re-stamped below with this module's + #local-time convention - the two engines produce identical trees. + set accelerated 0 + if {$verify && $overwrite && $restoremtime && $names_ascii + && [llength $excludes] == 0 && [llength $globs] == 1 && [lindex $globs 0] eq "*"} { + set acc [accelerator] + if {$acc eq ""} { + set last_accelerator_note "no accelerator binary resolved (see punk::zip::accelerator)" + } elseif {[catch {exec $acc extract -d $targetdir $zipfile 2>@1} accout]} { + set last_accelerator_note "accelerator '$acc' failed - fell back to pure tcl: [string range $accout 0 300]" } else { - file mkdir [file dirname $target] - Extract_member $chan $m $target $verify - if {$restoremtime && [dict get $m mtime]} { - catch {file mtime $target [dict get $m mtime]} + set accelerated 1 + } + } else { + set last_accelerator_note "call not accelerator-eligible (selective, non-default options, or non-ascii names) - pure tcl" + } + + if {$accelerated} { + set last_unzip_engine accelerated + foreach m $selected target $targets { + if {[dict get $m isdirectory]} { + if {[dict get $m mtime]} { + lappend dirtimes $target [dict get $m mtime] + } + } else { + if {[dict get $m mtime]} { + catch {file mtime $target [dict get $m mtime]} + } + } + lappend extracted [dict get $m name] + } + } else { + foreach m $selected target $targets { + set name [dict get $m name] + if {[dict get $m isdirectory]} { + file mkdir $target + if {$restoremtime && [dict get $m mtime]} { + lappend dirtimes $target [dict get $m mtime] + } + } else { + file mkdir [file dirname $target] + Extract_member $chan $m $target $verify + if {$restoremtime && [dict get $m mtime]} { + catch {file mtime $target [dict get $m mtime]} + } } + lappend extracted $name } - lappend extracted $name } } finally { close $chan @@ -1689,7 +1832,7 @@ tcl::namespace::eval punk::zip::lib { package provide punk::zip [tcl::namespace::eval punk::zip { variable pkg punk::zip variable version - set version 0.2.0 + set version 0.3.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm b/src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.1.tm similarity index 98% rename from src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm rename to src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.1.tm index e1839e8b..848b6f20 100644 --- a/src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.1.tm @@ -910,14 +910,31 @@ namespace eval punkcheck { #(the record keys are -ts_begin/-ts_end - passing the raw record gave the constructor's # -tsbegin/-tsend defaults, so reconstructed events took 'now' as begin and empty end, # and any later flush/save_installer_record rewrote prior event history with those values) + set eid [punkcheck::dict_getwithdefault $e -id ""] + #self-heal damaged persisted history rather than abort the caller's operation: + #files written by punkcheck < 0.3.2 carry EVENT records whose -id (and + #-source/-targets/-config) hold the LITERAL strings of the old writer's braced + #template ('$eventid' etc - the 0.3.2 buildversion note fixed the writer, but + #files keep the damage) and any two such records collide on the duplicate key + #here. History is advisory - reconstruct the record under a synthesized unique + #id and warn naming the file, instead of failing e.g a whole bake's vfslibs + #phase. Synthesized ids match no INSTALL record's -eventid reference, so + #healed events age out through normal -keep_events pruning. + if {$eid eq "" || $eid in [my events keys]} { + set healed_id "damaged-id-[my events count]-[clock microseconds]" + set shown [string range $eid 0 60] + set why [expr {$eid eq "" ? "missing" : "duplicates an earlier event"}] + puts stderr "punkcheck: WARNING damaged event history in '$o_checkfile': event -id '$shown' $why - keeping record under synthesized id '$healed_id' (safe to ignore; delete the file to reset history)" + set eid $healed_id + } set eargs [list] - lappend eargs -id [punkcheck::dict_getwithdefault $e -id ""] + lappend eargs -id $eid lappend eargs -tsbegin [punkcheck::dict_getwithdefault $e -ts_begin ""] lappend eargs -tsend [punkcheck::dict_getwithdefault $e -ts_end ""] lappend eargs -types [punkcheck::dict_getwithdefault $e -types {}] lappend eargs -config [punkcheck::dict_getwithdefault $e -config {}] - set eobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] [dict get $e -source] [dict get $e -targets] {*}$eargs] - $o_events add $eobj [dict get $e -id] + set eobj [punkcheck::installevent create [namespace current]::event_[my events count] [self] [punkcheck::dict_getwithdefault $e -source ""] [punkcheck::dict_getwithdefault $e -targets ""] {*}$eargs] + $o_events add $eobj $eid } } @@ -1426,7 +1443,7 @@ namespace eval punkcheck { #The -changed flag is computed by comparing -value against the matching virtual SOURCE in the last completed #install record (no filesystem access) - so virtual sources participate in targetset_source_changes like file sources. #Typical use: recording the resolved build version of a module target, so records identify which product of an - #unchanging source fileset (e.g -0.6.0.tm + -buildversion.txt) the target represents. + #unchanging source fileset (e.g -0.6.1.tm + -buildversion.txt) the target represents. proc installsource_add_virtual {file_record id value} { if {![lib::is_file_record_inprogress $file_record]} { error "installsource_add_virtual error: bad file_record - expected FILEINFO with last body element *-INPROGRESS ($file_record)" @@ -2069,11 +2086,11 @@ namespace eval punkcheck { #FILEINFO -targets jjjetc-0.1.0.tm -keep_installrecords 2 -keep_skipped 1 -keep_inprogress 2 { # INSTALL-RECORD -tsiso 2023-09-20T07:30:30 -ts 1695159030266610 -installer punk::mix::cli::build_modules_from_source_to_base -metadata_us 18426 -ts_start_transfer 1695159030285036 -transfer_us 10194 -elapsed_us 28620 { # SOURCE -type file -path ../src/modules/jjjetc-buildversion.txt -cksum c7c71839c36b3d21c8370fed106192fcd659eca9 -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 1 -metadata_us 3423 - # SOURCE -type file -path ../src/modules/jjjetc-0.6.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 1 -metadata_us 3413 + # SOURCE -type file -path ../src/modules/jjjetc-0.6.1.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 1 -metadata_us 3413 # } # INSTALL-SKIPPED -tsiso 2023-09-20T08:14:26 -ts 1695161666087880 -installer punk::mix::cli::build_modules_from_source_to_base -elapsed_us 18914 { # SOURCE -type file -path ../src/modules/jjjetc-buildversion.txt -cksum c7c71839c36b3d21c8370fed106192fcd659eca9 -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3435 - # SOURCE -type file -path ../src/modules/jjjetc-0.6.0.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 + # SOURCE -type file -path ../src/modules/jjjetc-0.6.1.tm -cksum b646fc2ee88cbd068d2e946fe929b7aea96bd39d -cksum_all_opts {-cksum_content 1 -cksum_meta 0 -cksum_acls 0 -cksum_usetar 0 -cksum_algorithm sha1} -changed 0 -metadata_us 3338 # } #} @@ -2778,6 +2795,6 @@ namespace eval ::punk::args::register { package provide punkcheck [namespace eval punkcheck { set pkg punkcheck variable version - set version 0.6.0 + set version 0.6.1 }] return