jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

vfscommonupdate: promote pending module bumps into _vfscommon.vfs (punkexe 0.1.1 packagemode doc reaches kits) 

Promotion gate run from a clean tree (both VCS committed at punkshell
0.29.0). Five stamped-version promotions from the deployed modules
tree: punk::args::moduledoc::punkexe 0.1.0 -> 0.1.1 (the G-033
packagemode leader with the proj: contract - kits baked from here on
carry the live launch documentation), plus four bumps pending from
earlier change-sets: argparsingtest 1.2.0 -> 1.3.0, oolib 0.1.3 ->
0.1.4, punk::zip 0.2.0 -> 0.3.0 (punkzip extraction accelerator),
punkcheck 0.6.0 -> 0.6.1 (installtrack self-heal). The
templates-0.2.0.tm modpod refreshed by the same replace (zip .tm,
rides binary-glob; existing artifact updated, no new binaries).

Kits pick these up at their next 'make.tcl bake'.

Claude-Session: https://claude.ai/code/session_0156PuejSCGjgeGb7jiABrDU
Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com
master
Julian Noble 6 days ago
parent
59bdb1ec49
commit
14fc37daba
6 changed files with 409 additions and 185 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 340
      src/vfs/_vfscommon.vfs/modules/argparsingtest-1.3.0.tm
  2. 4
      src/vfs/_vfscommon.vfs/modules/oolib-0.1.4.tm
  3. 44
      src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.1.tm
  4. BIN
      src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm
  5. 175
      src/vfs/_vfscommon.vfs/modules/punk/zip-0.3.0.tm
  6. 31
      src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.1.tm

340
src/vfs/_vfscommon.vfs/modules/argparsingtest-1.2.0.tm → src/vfs/_vfscommon.vfs/modules/argparsingtest-1.3.0.tm
Unescape View File

@ -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 <pkg>} 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

4
src/vfs/_vfscommon.vfs/modules/oolib-0.1.3.tm → src/vfs/_vfscommon.vfs/modules/oolib-0.1.4.tm
Unescape View File

@ -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
}]

44
src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.0.tm → src/vfs/_vfscommon.vfs/modules/punk/args/moduledoc/punkexe-0.1.1.tm
Unescape View File

@ -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 "<punkexe> ?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 (<projectroot>/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 <projectroot>/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

BIN
src/vfs/_vfscommon.vfs/modules/punk/mix/templates-0.2.0.tm
View File

Binary file not shown.

175
src/vfs/_vfscommon.vfs/modules/punk/zip-0.2.0.tm → src/vfs/_vfscommon.vfs/modules/punk/zip-0.3.0.tm
Unescape View File

@ -9,7 +9,7 @@
# (C) 2009 Path Thoyts <patthyts@users.sourceforge.net>
#
# @@ 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 | <path to punkzip executable>
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)
<path> - 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

31
src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.0.tm → src/vfs/_vfscommon.vfs/modules/punkcheck-0.6.1.tm
Unescape View File

@ -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 <module>-0.6.0.tm + <module>-buildversion.txt) the target represents.
#unchanging source fileset (e.g <module>-0.6.1.tm + <module>-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
Write Preview
Loading…
Cancel
Save