From a3ca4745e9e3a50a62ba4072755d28934030a8c1 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Mon, 3 Aug 2026 15:00:19 +1000 Subject: [PATCH] promotion outputs: punk::path 0.5.0 into bootsupport + _vfscommon.vfs make.tcl modules + bootsupport + vfscommonupdate outputs for the path 0.5.0 arc (source commits ed17fb6c, 4d481e42): src/bootsupport/modules and src/vfs/_vfscommon.vfs/modules move from path-0.4.0 to path-0.5.0 (superseded copies pruned with punkcheck DELETE records; promoted copies byte-identical to the minted module). Note: the vfscommonupdate PROVENANCE-WARNING emitted during this run referred to the preceding bootsupport step's own outputs - batched here per the build-outputs commit convention. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.com --- .../punk/{path-0.4.0.tm => path-0.5.0.tm} | 594 ++++++++++-------- .../punk/{path-0.4.0.tm => path-0.5.0.tm} | 594 ++++++++++-------- 2 files changed, 630 insertions(+), 558 deletions(-) rename src/bootsupport/modules/punk/{path-0.4.0.tm => path-0.5.0.tm} (76%) rename src/vfs/_vfscommon.vfs/modules/punk/{path-0.4.0.tm => path-0.5.0.tm} (76%) diff --git a/src/bootsupport/modules/punk/path-0.4.0.tm b/src/bootsupport/modules/punk/path-0.5.0.tm similarity index 76% rename from src/bootsupport/modules/punk/path-0.4.0.tm rename to src/bootsupport/modules/punk/path-0.5.0.tm index 84cd007b..b5994edd 100644 --- a/src/bootsupport/modules/punk/path-0.4.0.tm +++ b/src/bootsupport/modules/punk/path-0.5.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::path 0.4.0 +# Application punk::path 0.5.0 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::path 0 0.4.0] +#[manpage_begin punkshell_module_punk::path 0 0.5.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] @@ -46,9 +46,11 @@ package require Tcl 8.6- package require punk::args +package require punk::winpath ;#is_dos_device_path - called by normjoin on every input #*** !doctools #[item] [package {Tcl 8.6-}] #[item] [package {punk::args}] +#[item] [package {punk::winpath}] # #package require frobz # #*** !doctools @@ -184,7 +186,41 @@ namespace eval punk::path { #normjoin c: should theoretically return current per drive working directory on c: # - would need to use win32 GetFullPathName to resolve this. + punk::args::define { + @id -id ::punk::path::normjoin + @cmd -name punk::path::normjoin -& + -summary -& + "Join and normalize path parts as a string operation, respecting server/scheme/volume roots." -& + -help -& + "Joins the supplied parts and simplifies . and .. segments as far as + possible, as a purely textual operation - no filesystem, vfs or + zipfs-mount knowledge is consulted (so e.g windows shortnames and + per-drive working directories are preserved rather than resolved, + and case is never normalized). + Backslashes in the parts are converted to forward slashes. + Relative results are returned with a leading ./ segment (this helps + prevent inadvertent conversion to absolute paths on rejoining) and + unresolvable leading .. segments of a relative result are preserved. + Unlike 'file normalize', a leading //server, scheme:// (e.g https://), + //./, :/ or / is treated as a root that .. + cannot backtrack above, and //server style paths are not treated as + volumerelative on windows (the ambiguous bare //server form draws a + warning to stderr there). + A bare volume/scheme result gains a trailing slash (c: -> c:/, + //zipfs: -> //zipfs:/); with no parts at all an empty string is + returned, and an empty-string part contributes '.'. + If the final segment has a .lnk extension and punk::winlnk is + available, the windows shortcut's target is returned when resolvable + (otherwise the .lnk path itself). + Known textual-analysis edge cases (e.g d://a/b is treated as a + scheme like https://a/b) are recorded in the comment block above + this definition in the module source." + @values -min 0 -max -1 + part -type string -optional 1 -multiple 1 -help -& + "path parts to join and normalize" + } proc normjoin {args} { + #see PUNKARGS id ::punk::path::normjoin (documentation-only - variadic parts) set args [lmap a $args {string map "\\\\ /" $a}] set path [plainjoin {*}$args] switch -exact -- $path { @@ -488,53 +524,53 @@ namespace eval punk::path { namespace eval argdoc { lappend PUNKARGS [list { @id -id ::punk::path::scriptlib_resolve - @cmd -name "punk::path::scriptlib_resolve"\ - -summary\ - "Resolve a scriptlib script name to a path using the punk kit search policy"\ - -help\ - "Resolves a relative script name (the part after a 'lib:' prefix - in punk executable launch arguments) against the scriptlib - locations, in the same order the punk shell uses: - - 1. the kit vfs internal scriptlib (/app/scriptlib, - or /scriptlib for an unwrapped kit directory). - Internal scripts are deliberately NOT overridable by - external files (integrity and performance). - 2. /scriptlib - e.g /scriptlib for - an executable in /bin. - 3. /scriptlib. - - If the name's extension (lowercased) is one of the known - scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that - exact name is searched. Otherwise two spellings are tried within - EACH location before moving to the next (so the kit-internal - precedence above is never crossed by a spelling preference): - 1. the exact name as called - accepted only if the file's - first lines identify it as a tcl script: a leading - '# tcl' comment, a shebang naming tclsh/tclkit/wish, or - the portable sh-trampoline ('#!/bin/sh' followed by a - commented 'exec tclsh ...' in the next lines). - 2. the name with '.tcl' appended. - An exact-name file that fails the tcl identification check is - skipped (recorded in notes) and resolution falls through. - - Returns a dict with keys: - path - resolved absolute path, or empty string if not found - scriptname - the relative name that matched; when not found, - the primary name searched for - scripttype - resolved script type: the extension without its - dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an - extensionless file that passed the identification - check, or empty string when not found - candidates - the locations that were (or would be) checked, - for use in error messages - notes - explanatory notes (e.g files skipped by the tcl - identification check), for use in error messages. - Raises an error if name is not a relative path." + @cmd -name "punk::path::scriptlib_resolve" -& + -summary -& + "Resolve a scriptlib script name to a path using the punk kit search policy" -& + -help -& + "Resolves a relative script name (the part after a 'lib:' prefix + in punk executable launch arguments) against the scriptlib + locations, in the same order the punk shell uses: + + 1. the kit vfs internal scriptlib (/app/scriptlib, + or /scriptlib for an unwrapped kit directory). + Internal scripts are deliberately NOT overridable by + external files (integrity and performance). + 2. /scriptlib - e.g /scriptlib for + an executable in /bin. + 3. /scriptlib. + + If the name's extension (lowercased) is one of the known + scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that + exact name is searched. Otherwise two spellings are tried within + EACH location before moving to the next (so the kit-internal + precedence above is never crossed by a spelling preference): + 1. the exact name as called - accepted only if the file's + first lines identify it as a tcl script: a leading + '# tcl' comment, a shebang naming tclsh/tclkit/wish, or + the portable sh-trampoline ('#!/bin/sh' followed by a + commented 'exec tclsh ...' in the next lines). + 2. the name with '.tcl' appended. + An exact-name file that fails the tcl identification check is + skipped (recorded in notes) and resolution falls through. + + Returns a dict with keys: + path - resolved absolute path, or empty string if not found + scriptname - the relative name that matched; when not found, + the primary name searched for + scripttype - resolved script type: the extension without its + dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an + extensionless file that passed the identification + check, or empty string when not found + candidates - the locations that were (or would be) checked, + for use in error messages + notes - explanatory notes (e.g files skipped by the tcl + identification check), for use in error messages. + Raises an error if name is not a relative path." @leaders - name -type string -optional 0 -help\ - "relative script name, with or without a known extension - (any leading lib: prefix should already be stripped)" + name -type string -optional 0 -help -& + "relative script name, with or without a known extension + (any leading lib: prefix should already be stripped)" }] } proc scriptlib_resolve {name} { @@ -675,14 +711,50 @@ namespace eval punk::path { #proc filepath_dotted_dirname {path} { #} + punk::args::define { + @id -id ::punk::path::strip_prefixdepth + @cmd -name punk::path::strip_prefixdepth -& + -summary -& + "Strip as many leading segments from path as prefix has segments (depth-based, content not compared)." -& + -help -& + "Returns path, normjoin-normalized, with its first N segments removed - + where N is the number of 'file split' segments of the normjoin-normalized + prefix. Only the prefix's DEPTH is used: its segment content is not + compared against path (a deliberate speed tradeoff inherited from + kettle::path::strip via punk::repo::path_strip_prefixdepth - callers are + expected to already know path lies under prefix). + This is the purely textual punk::path variant: normalization is + punk::path::normjoin, so relative inputs stay relative (gaining a + leading ./ segment which then counts towards depth on whichever sides + are relative). Pass path and prefix of the same pathtype (both + relative or both absolute) for intuitive results. + punk::repo::path_strip_prefixdepth is the filesystem-normalizing + variant ('file normalize' based - absolutizes relative inputs against + the current directory). + An empty prefix returns the normjoin-normalized path unchanged. + Segment counting uses 'file split', so root/volume segmentation + follows the platform's rules (e.g //server/share/a splits as + {//server/share a} on windows but {/ server share a} on unix). + If prefix has as many or more segments than path, nothing remains and + an error is raised (file join with no arguments)." + @leaders -min 2 -max 2 + path -type string -help -& + "path to strip leading segments from" + prefix -type string -help -& + "path whose depth (segment count after normjoin + file split) + determines how many leading segments are removed" + } proc strip_prefixdepth {path prefix} { + #see PUNKARGS id ::punk::path::strip_prefixdepth (documentation-only - positional args) + #deliberately the textual normjoin, not 'file normalize' - punk::repo::path_strip_prefixdepth + #is the filesystem-normalizing sibling of this proc if {$prefix eq ""} { - return [norm $path] + return [normjoin $path] } return [file join {*}{ - } {*}[lrange {*}{ - } [file split [norm $path]] {*}{ - } [llength [file split [norm $prefix]]] {*}{ + } {*}[lrange {*}{ + } [file split [normjoin $path]] {*}{ + } [llength [file split [normjoin $prefix]]] {*}{ } end ] ] @@ -722,7 +794,54 @@ namespace eval punk::path { # } # return "^[join $pats ::]\$" #} + namespace eval argdoc { + #Canonical description of the path glob syntax implemented by pathglob_as_re + #and consumed by globmatchpath, treefilenames/treefilenames_zipfs and the + #subfolders -exclude-paths patterns. + #Referenced from PUNKARGS -help fields via the tstr placeholder: + # ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + #Continuation lines are deliberately unindented: placeholder substitution + #prepends the placeholder line's own indentation to every line after the + #first, so indented continuations here would render double-indented. + variable PATHGLOB_SEGMENT_SYNTAX {The glob elements *, **, *** and ? may appear in any segment of a path pattern: +* matches any single segment, or any span of characters within a segment + (/usr/*/bin matches /usr/local/bin but not /usr/bin or /usr/a/b/bin; + /usr/te*t matches /usr/test and /usr/teeeet but not /usr/te/t) +** as a whole segment matches 1 or more segments + (/usr/**/bin matches /usr/x/bin and /usr/x/y/bin but not /usr/bin. + Within a segment ** also spans segments: /usr/**.txt matches .txt files + at any depth below /usr) +*** as a whole segment matches 0 or more segments + (/usr/*** matches /usr itself as well as everything below it) +? matches any single character within a segment + (/usr/te?t matches /usr/test and /usr/text but not /usr/texxt or /usr/te/t) +* and ? are treated as glob characters wherever they appear in the pattern +- escaping is not supported. All other characters, including square brackets, +match as literals (unlike Tcl glob patterns).} + } + + punk::args::define { + @id -id ::punk::path::pathglob_as_re + @cmd -name punk::path::pathglob_as_re -& + -summary -& + "Return a regular expression for matching paths to a *|**|***|? path glob pattern." -& + -help -& + "Returns an anchored regular expression string for matching a path to a + glob pattern which can contain the glob elements *|**|***|? in any + segment of the path structure. + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + The pathglob doesn't have to contain glob characters - a pathglob + without them produces a regex matching that path exactly. + Regular expression syntax is deliberately not supported within the + pathglob string - supplied regex characters are treated as literals. + This is the engine behind punk::path::globmatchpath and the path + pattern matching of the treefilenames/subfolders family." + @leaders -min 1 -max 1 + pathglob -type string -optional 0 -help -& + "path glob pattern" + } proc pathglob_as_re {pathglob} { + #see PUNKARGS id ::punk::path::pathglob_as_re (documentation-only - single positional arg) #*** !doctools #[call [fun pathglob_as_re] [arg pathglob]] #[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|**|***|? in any segment of the path structure @@ -799,52 +918,40 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::globmatchpath - @cmd -name punk::path::globmatchpath\ - -summary\ - "Match path to *|**|? glob patterns"\ - -help\ - "Return a boolean indicating whether the path matches the specialised glob pattern. - A pattern such as /usr/*/bin will match any path that has /usr as the first segment and bin as the third segment, - with any single segment in between. - A pattern such as /usr/**/bin will match any path that has /usr as the first segment and bin as the last segment, - with 1 or more segments in between (so it will not match /usr/bin). - A pattern such as /usr/** will match any path that has /usr as the first segment, with 1 or more segments - following (so it will not match /usr itself). - A pattern such as /usr/*** will match /usr itself as well as any path below /usr - - *** as a whole segment matches zero or more segments (added 2026-07-20, G-093). - A pattern such as **/*.txt will match any path that ends with .txt, with 1 or more leading segments - (so it will not match test.txt or .txt). Use ***/*.txt to also match a bare test.txt. - A pattern such as ** will match any path. - The glob characters * and ? (and the whole-segment forms ** and ***) are the only special characters in the pathglob syntax. - - they are treated as glob characters regardless of where they appear in the pathglob string. - Note that this is different from other Tcl glob contexts where square brackets can be used. - The pathglob syntax treats other characters, including square brackets as literals. - For example, the pattern /usr/te?t will match /usr/test and /usr/text but not /usr/texxt, and the pattern /usr/te*t - will match /usr/test, /usr/teat, and /usr/teeeet but not /usr/te/t. - The pathglob syntax does not support escaping of glob characters - any glob characters in the pathglob are treated - as glob characters. For example, the pattern /usr/* will match any path that has /usr as the first segment and any - single segment as the second segment, but there is no way to specify a pattern that matches any path that has /usr - as the first segment and a literal * as the second segment. - Caller must ensure that file separator is forward slash. (e.g use file normalize on windows) - - options: - -nocase 0|1 (default 0 - case sensitive) - If -nocase is not supplied - default to case sensitive *except for driveletter* - ie - the driveletter alone in paths such as c:/etc will still be case insensitive. (ie c:/ETC/* will match C:/ETC/blah but not C:/etc/blah) - Explicitly specifying -nocase 0 will require the entire case to match including the driveletter. - " + @cmd -name punk::path::globmatchpath -& + -summary -& + "Match path to *|**|***|? glob patterns" -& + -help -& + "Return a boolean indicating whether the path matches the specialised + glob pattern. + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + Further whole-pattern examples: + /usr/** will match any path that has /usr as the first segment and 1 + or more segments following (so it will not match /usr itself). + /usr/*** will match /usr itself as well as any path below /usr. + **/*.txt will match any path that ends with .txt, with 1 or more + leading segments (so it will not match test.txt or .txt). Use + ***/*.txt to also match a bare test.txt. + ** will match any path. + Caller must ensure that file separator is forward slash. (e.g use + file normalize on windows)" @leaders - pathglob -type string -help "glob pattern to match path against. See [fun pathglob_as_re] for syntax of glob patterns" + pathglob -type string -help -& + "glob pattern to match path against (syntax as described above - + punk::path::pathglob_as_re documents the underlying conversion)" path -type string -help "path to match against glob pattern" @opts - -nocase -type boolean -default 0 -help\ + -nocase -type boolean -default 0 -help -& "case insensitive matching (default false - case sensitive) - - except for driveletter on windows which is always case insensitive - unless -nocase 0 is explicitly specified" + - except for the driveletter on windows paths: when -nocase is not + supplied, matching is case sensitive EXCEPT for a leading + driveletter (c:/ETC/* will match C:/ETC/blah but not C:/etc/blah). + Explicitly specifying -nocase 0 requires the entire case to match + including the driveletter." @values -min 0 -max 0 } - # -id proc globmatchpath {pathglob path args} { + #see PUNKARGS id ::punk::path::globmatchpath (documentation-only - args parsed manually below; keep synchronized) #*** !doctools #[call [fun globmatchpath] [arg pathglob] [arg path] [opt {option value...}]] #[para] Return true if the pathglob matches the path @@ -899,120 +1006,15 @@ namespace eval punk::path { } return $ismatch } - punk::args::define { - @id -id ::punk::path::subfolders1 - @cmd -name punk::path::subfolders1\ - -summary\ - "Listing of directories below supplied path."\ - -help\ - "List of folders below path. - The resulting list is unsorted." - @opts - -recursive -type none -help\ - "" - -exclude-paths -type list -default {} -help\ - "list of path patterns to exclude from results. - May include * and ** path segments e.g /usr/** - A single /*/ will match any single segment in the path, and a single /**/ will match any number of segments in the path. - - e.g to exclude any path with _aside as a segment in the middle: -exclude-paths **/_aside/** - i.e this would exclude /usr/_aside/etc and /usr/x/_aside/etc but not /usr/x/_aside or _aside/etc - - To exclude all paths with _aside as a segment anywhere: -exclude-paths { **/_aside/** **/_aside _aside/**} - " - #todo -depth - @values -min 0 -max 1 - path -type directory -optional 1 -help\ - "Path of folder. If not supplied current directory is used. - This may be a relative or absolute path. Relative paths are treated as relative to current directory. - When using relative paths - the result will also be relative paths with the same relative prefix. - (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc) - Patterns in -exclude-paths are matched against the resulting paths - (so should be written to match the same relative prefix if path is relative)" - } - - proc subfolders1 {args} { - #NOTE - this algorithm based on omit_only_patterns and prune_base_patterns was suggested by a 2026 AI model - it is apparent to this programmer that it is inadequate for the purpose. - #e.g consider subfolders1 -recursion -exclude {**/vfs/** **/src/**} - #This can still return something like c:/repo/etc/src/vfs - which should be excluded by the pattern **/src/** - #todo - review and fix properly. - set argd [punk::args::parse $args withid ::punk::path::subfolders1] - lassign [dict values $argd] leaders opts values received - set do_recursion [dict exists $received -recursive] - set exclude_paths [dict get $opts -exclude-paths] - if {"**" in $exclude_paths} { - #if ** is in exclude_paths - then we can skip all glob matching and just return empty list - #This is likely user error - so we'll be loud about it for now but will still return empty list rather than erroring. - #If user code is building exclude_paths dynamically - they can check for this case themselves and avoid the call to subfolders1 to suppress this message. - puts stderr "punk::path::subfolders1 Warning - exclude_paths contains '**' - all paths will be excluded" - return [list] - } - if {[dict exists $received path]} { - set path [dict get $values path] - } else { - set path [pwd] - } - - set all_subfolders [glob -nocomplain -directory $path -types d *] - - - #example of expected exclude_paths pattern behaviour when recursion is enabled: - # **/dirname -> omit /x/y/dirname, but still visit /x/y/dirname/* - - # **/dirname/* -> include /x/y/dirname and /x/y/dirname/a/b but omit directories that are a single level below /x/y/dirname such as /x/y/dirname/a - - #c:/** - would exclude all subfolders below c: but not c: itself - - # **/test/** - would exclude any path with test as a segment and all its subfolders - #- but not paths with test as a segment that is the final segment - - set folders [list] - set recurse_subdirs [list] - - foreach f $all_subfolders { - set include_in_results 1 - set allow_recurse 1 - foreach pat $exclude_paths { - set pat_parts [file split $pat] ;#note file split c:/test gives {c:/ test} but file split **/test gives {** test} - #also note that file split on windows treats forward slashes and backslashes the same. - #by using file split, we gain some flexibility in syntax of paths and patterns, - #but lose the ability to use backslashes as escapes to allow literal glob characters in path segments. - #This is almost always a non-issue on windows since * and ? are not valid in path segments there, and is rarely an issue on unix even though - # * and ? are technically valid in path segments, but it is inadvisable there anyway for compatibility with shells etc. - if {[llength $pat_parts] >= 2 && [lindex $pat_parts end] eq "**"} { - set base_pat [file join {*}[lrange $pat_parts 0 end-1]] - if {[globmatchpath $pat $f]} { - set include_in_results 0 - set allow_recurse 0 - } elseif {[globmatchpath $base_pat $f]} { - set allow_recurse 0 - } - } elseif {[globmatchpath $pat $f]} { - set include_in_results 0 - } - if {!$include_in_results && !$allow_recurse} { - break - } - } - if {$include_in_results} { - lappend folders $f - } - if {$allow_recurse} { - lappend recurse_subdirs $f - } - } - if {$do_recursion} { - foreach subdir $recurse_subdirs { - lappend folders {*}[subfolders1 -exclude-paths $exclude_paths -recursive $subdir] - } - } - return $folders - } - namespace eval subfolder_priv { proc classify_exclude_pattern {pat} { set parts [file split $pat] - if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} { + if {[llength $parts] >= 2 && [lindex $parts end] in {** ***}} { + #a trailing *** full-matches the boundary folder too (zero segments + #below), so the descend test alone omits the boundary and prunes - + #this IS the decomposition of X/*** to the pair {X/** X}. A trailing + #** matches only below the boundary; the boundary branch then keeps + #the boundary folder while still pruning descent. set boundary_pat [file join {*}[lrange $parts 0 end-1]] return [dict create {*}{ } pattern $pat {*}{ @@ -1107,35 +1109,52 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::subfolders - @cmd -name punk::path::subfolders\ - -summary\ - "Listing of directories below supplied path."\ - -help\ + @cmd -name punk::path::subfolders -& + -summary -& + "Listing of directories below supplied path." -& + -help -& "List of folders below path. - The resulting list is unsorted. - " + The resulting list is unsorted." @opts - -recursive -type none -help\ - "" - -exclude-paths -type list -default {} -help\ - "list of path patterns to exclude from results. - May include * and ** path segments e.g /usr/** - A single /*/ will match any single segment in the path, and a single /**/ will match any number of segments in the path. - - e.g to exclude any path with _aside as a segment in the middle: -exclude-paths **/_aside/** - i.e this would exclude /usr/_aside/etc and /usr/x/_aside/etc but not /usr/x/_aside or _aside/etc - - To exclude all paths with _aside as a segment anywhere: -exclude-paths { **/_aside/** **/_aside ./_aside/**} - " + -recursive -type none -help -& + "Recurse into subfolders, returning the whole tree of folders below + path rather than only its immediate subfolders. + Subtrees pruned by a trailing-** or trailing-*** -exclude-paths + pattern are not descended." + -exclude-paths -type list -default {} -help -& + "List of path patterns for folders to exclude from the results. + Patterns are matched against the result paths as they would be + returned (see the path argument help regarding relative paths). + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + The form of a matching pattern determines what is excluded: + **/_aside (plain tail) each matching folder is omitted from + the results, but its subfolders are still visited + and remain eligible + **/_aside/* as above - only folders exactly one level below an + _aside folder are omitted + **/_aside/** (tail **) the matching folder itself is KEPT, but + nothing below it is returned - and the walk does + not descend below it + **/_aside/*** (tail ***) the matching folder and everything below + it are omitted, and the walk does not descend below + it (handled internally as the equivalent pair + {**/_aside/** **/_aside}) + So to exclude every folder with _aside as a segment anywhere below + an absolute base path: -exclude-paths {**/_aside/***} + (with a relative base path, also supply forms matching the same + relative prefix as the results when needed) + A pattern list containing a bare ** or *** (which would exclude + every result) is rejected with a warning and an empty list is + returned." #todo -depth @values -min 0 -max 1 - path -type directory -optional 1 -help\ + path -type directory -optional 1 -help -& "Path of base folder. If not supplied current directory is used. - This may be a relative or absolute path. Relative paths are treated as relative to current directory. - When using relative paths - the result will also be relative paths with the same relative prefix. - (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc) - Patterns in -exclude-paths are matched against the resulting paths - (so should be written to match the same relative prefix if path is relative)" + This may be a relative or absolute path. Relative paths are treated as relative to current directory. + When using relative paths - the result will also be relative paths with the same relative prefix. + (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc) + Patterns in -exclude-paths are matched against the resulting paths + (so should be written to match the same relative prefix if path is relative)" } proc subfolders {args} { @@ -1143,8 +1162,9 @@ namespace eval punk::path { lassign [dict values $argd] leaders opts values received set do_recursion [dict exists $received -recursive] set exclude_paths [dict get $opts -exclude-paths] - if {"**" in $exclude_paths} { - puts stderr "punk::path::subfolders Warning - exclude_paths contains '**' - all paths will be excluded" + if {"**" in $exclude_paths || "***" in $exclude_paths} { + #likely user error - be loud about it but return empty rather than erroring. + puts stderr "punk::path::subfolders Warning - exclude_paths contains a bare '**' or '***' - all paths will be excluded" return [list] } if {[dict exists $received path]} { @@ -1597,22 +1617,25 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::treefilenames - @cmd -name punk::path::treefilenames\ - -summary\ - "List of filenames below supplied path."\ - -help\ + @cmd -name punk::path::treefilenames -& + -summary -& + "List of filenames below supplied path." -& + -help -& "List of filenames below path. - The resulting list is unsorted. - - The path globbing syntax supports *, **, *** and ? as glob characters in any segment of the path, with the following semantics: - * matches any single segment in the path - ** as a whole segment matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin ) - *** as a whole segment matches 0 or more segments in the path (so /usr/*** will match /usr itself as well as anything below it) - ? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt) + Results are gathered depth-first; the -sort option (default natural) + controls the ordering of files and subfolder visits within each + directory as the tree is walked. + For a -directory under //zipfs:/ the walk dispatches to the + treefilenames_zipfs implementation (also callable directly), which + applies -sort to its combined result list instead. + + The path patterns of -include-paths and -exclude-paths use the + following syntax: + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} " - -directory -type directory -help\ + -directory -type directory -help -& "folder in which to begin recursive scan for files." - -tailbase -type string -default "" -help\ + -tailbase -type string -default "" -help -& "if supplied, only the relative path compared to the tailbase will be returned for each file. So if tailbase is /usr and a file is found at /usr/x/y/file.txt, the returned path for that file would be x/y/file.txt. If tailbase is not supplied, the full path to each file will be returned. @@ -1624,10 +1647,16 @@ namespace eval punk::path { see: punk::path::relative to compute relative paths " - -sort -type any -default natural -choices {none ascii dictionary natural} - -exclude-paths -default {} -help\ + -sort -type any -default natural -choices {none ascii dictionary natural} -help -& + "Ordering of files and subfolder visits within each directory during + the walk - the combined result list is not re-sorted. + (treefilenames_zipfs instead applies the sort to its combined + result list) + natural sorting requires the natsort package." + -exclude-paths -type list -default {} -help -& "list of directory path patterns to exclude - may include *, ** and *** path segments e.g + may include *, **, *** and ? glob elements + (path glob syntax - see punk::path::pathglob_as_re) e.g /usr (exclude files directly within /usr; subfolders are still walked) /usr/* (exclude files in folders exactly one below /usr) @@ -1639,10 +1668,15 @@ namespace eval punk::path { Patterns whose final segment is ** or *** prune the matched subtree; other matches exclude only the files directly in the matching folder. Exclusion wins over inclusion for the same file." - -exclude-files -default {} - -include-paths -default {**} -help\ + -exclude-files -type list -default {} -help -& + "list of patterns matched against the filename portion (last segment) + of each file path - matching files are excluded. + These are ordinary Tcl glob patterns (string match) - not the path + glob syntax used by -include-paths/-exclude-paths." + -include-paths -type list -default {**} -help -& "list of directory path patterns to include - may include *, ** and *** path segments e.g + may include *, **, *** and ? glob elements + (path glob syntax - see punk::path::pathglob_as_re) e.g /usr (include files directly within /usr only) /usr/* (include files in folders exactly one below /usr) /usr/** (include files in subfolders based at /usr but not @@ -1656,9 +1690,11 @@ namespace eval punk::path { below their match. The /usr, /usr/*, /usr/** and /usr/*** forms are deliberately separable." @values -min 0 -max -1 -optional 1 -type string - tailglobs -default * -multiple 1 -help\ + tailglobs -default * -multiple 1 -help -& "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched. + These are ordinary Tcl glob patterns - not the path glob syntax of + -include-paths/-exclude-paths." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -1682,28 +1718,28 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::relative - @cmd -name punk::path::relative\ - -summary\ - "Compute the relative path from a reference path to a location path."\ - -help\ - "Taking two directory paths, a reference and a location, computes the path - of the location relative to the reference. + @cmd -name punk::path::relative -& + -summary -& + "Compute the relative path from a reference path to a location path." -& + -help -& + "Taking two directory paths, a reference and a location, computes the path + of the location relative to the reference. - Will return a single dot '.' if the paths are the same. + Will return a single dot '.' if the paths are the same. - Both paths must be the same type - ie both absolute or both relative. + Both paths must be the same type - ie both absolute or both relative. - Matching is case sensitive. On windows, the drive-letter component (only) is - not case sensitive, so punk::path::relative c:/etc C:/etc returns '.'. - The part following the driveletter is case sensitive, so - punk::path::relative c:/etc C:/Etc returns ../Etc. + Matching is case sensitive. On windows, the drive-letter component (only) is + not case sensitive, so punk::path::relative c:/etc C:/etc returns '.'. + The part following the driveletter is case sensitive, so + punk::path::relative c:/etc C:/Etc returns ../Etc. - On windows, if the paths are absolute and specify different volumes, - only the location will be returned." + On windows, if the paths are absolute and specify different volumes, + only the location will be returned." @leaders -min 2 -max 2 - reference -type string -help\ + reference -type string -help -& "The path from which the relative path to location is determined." - location -type string -help\ + location -type string -help -& "The location path which may be above or below the reference path." } #maint warning - also in punkcheck @@ -1812,20 +1848,20 @@ namespace eval punk::path::system { namespace eval argdoc { lappend PUNKARGS [list { @id -id ::punk::path::system::scriptfile_is_tcl - @cmd -name "punk::path::system::scriptfile_is_tcl"\ - -summary\ - "Test whether a script file's first lines identify it as a tcl script"\ - -help\ - "Reads a small bounded chunk (512 bytes) of the file and reports 1 if - the first line is a '# tcl'-prefixed comment (case-insensitive), a - shebang naming tclsh/tclkit/wish, or any other shebang whose next - few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. - A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for - unreadable files and anything not identified as tcl. - Used by punk::path::scriptlib_resolve to allow extensionless tcl - scripts to be called via the lib: prefix." + @cmd -name "punk::path::system::scriptfile_is_tcl" -& + -summary -& + "Test whether a script file's first lines identify it as a tcl script" -& + -help -& + "Reads a small bounded chunk (512 bytes) of the file and reports 1 if + the first line is a '# tcl'-prefixed comment (case-insensitive), a + shebang naming tclsh/tclkit/wish, or any other shebang whose next + few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. + A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for + unreadable files and anything not identified as tcl. + Used by punk::path::scriptlib_resolve to allow extensionless tcl + scripts to be called via the lib: prefix." @leaders - fpath -type string -optional 0 -help\ + fpath -type string -optional 0 -help -& "path of the file to examine" }] } @@ -1881,7 +1917,7 @@ namespace eval ::punk::args::register { package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.4.0 + set version 0.5.0 }] return diff --git a/src/vfs/_vfscommon.vfs/modules/punk/path-0.4.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/path-0.5.0.tm similarity index 76% rename from src/vfs/_vfscommon.vfs/modules/punk/path-0.4.0.tm rename to src/vfs/_vfscommon.vfs/modules/punk/path-0.5.0.tm index 84cd007b..b5994edd 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/path-0.4.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/path-0.5.0.tm @@ -7,7 +7,7 @@ # (C) 2023 # # @@ Meta Begin -# Application punk::path 0.4.0 +# Application punk::path 0.5.0 # Meta platform tcl # Meta license # @@ Meta End @@ -17,7 +17,7 @@ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools -#[manpage_begin punkshell_module_punk::path 0 0.4.0] +#[manpage_begin punkshell_module_punk::path 0 0.5.0] #[copyright "2023"] #[titledesc {Filesystem path utilities}] [comment {-- Name section and table of contents description --}] #[moddesc {punk path filesystem utils}] [comment {-- Description at end of page heading --}] @@ -46,9 +46,11 @@ package require Tcl 8.6- package require punk::args +package require punk::winpath ;#is_dos_device_path - called by normjoin on every input #*** !doctools #[item] [package {Tcl 8.6-}] #[item] [package {punk::args}] +#[item] [package {punk::winpath}] # #package require frobz # #*** !doctools @@ -184,7 +186,41 @@ namespace eval punk::path { #normjoin c: should theoretically return current per drive working directory on c: # - would need to use win32 GetFullPathName to resolve this. + punk::args::define { + @id -id ::punk::path::normjoin + @cmd -name punk::path::normjoin -& + -summary -& + "Join and normalize path parts as a string operation, respecting server/scheme/volume roots." -& + -help -& + "Joins the supplied parts and simplifies . and .. segments as far as + possible, as a purely textual operation - no filesystem, vfs or + zipfs-mount knowledge is consulted (so e.g windows shortnames and + per-drive working directories are preserved rather than resolved, + and case is never normalized). + Backslashes in the parts are converted to forward slashes. + Relative results are returned with a leading ./ segment (this helps + prevent inadvertent conversion to absolute paths on rejoining) and + unresolvable leading .. segments of a relative result are preserved. + Unlike 'file normalize', a leading //server, scheme:// (e.g https://), + //./, :/ or / is treated as a root that .. + cannot backtrack above, and //server style paths are not treated as + volumerelative on windows (the ambiguous bare //server form draws a + warning to stderr there). + A bare volume/scheme result gains a trailing slash (c: -> c:/, + //zipfs: -> //zipfs:/); with no parts at all an empty string is + returned, and an empty-string part contributes '.'. + If the final segment has a .lnk extension and punk::winlnk is + available, the windows shortcut's target is returned when resolvable + (otherwise the .lnk path itself). + Known textual-analysis edge cases (e.g d://a/b is treated as a + scheme like https://a/b) are recorded in the comment block above + this definition in the module source." + @values -min 0 -max -1 + part -type string -optional 1 -multiple 1 -help -& + "path parts to join and normalize" + } proc normjoin {args} { + #see PUNKARGS id ::punk::path::normjoin (documentation-only - variadic parts) set args [lmap a $args {string map "\\\\ /" $a}] set path [plainjoin {*}$args] switch -exact -- $path { @@ -488,53 +524,53 @@ namespace eval punk::path { namespace eval argdoc { lappend PUNKARGS [list { @id -id ::punk::path::scriptlib_resolve - @cmd -name "punk::path::scriptlib_resolve"\ - -summary\ - "Resolve a scriptlib script name to a path using the punk kit search policy"\ - -help\ - "Resolves a relative script name (the part after a 'lib:' prefix - in punk executable launch arguments) against the scriptlib - locations, in the same order the punk shell uses: - - 1. the kit vfs internal scriptlib (/app/scriptlib, - or /scriptlib for an unwrapped kit directory). - Internal scripts are deliberately NOT overridable by - external files (integrity and performance). - 2. /scriptlib - e.g /scriptlib for - an executable in /bin. - 3. /scriptlib. - - If the name's extension (lowercased) is one of the known - scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that - exact name is searched. Otherwise two spellings are tried within - EACH location before moving to the next (so the kit-internal - precedence above is never crossed by a spelling preference): - 1. the exact name as called - accepted only if the file's - first lines identify it as a tcl script: a leading - '# tcl' comment, a shebang naming tclsh/tclkit/wish, or - the portable sh-trampoline ('#!/bin/sh' followed by a - commented 'exec tclsh ...' in the next lines). - 2. the name with '.tcl' appended. - An exact-name file that fails the tcl identification check is - skipped (recorded in notes) and resolution falls through. - - Returns a dict with keys: - path - resolved absolute path, or empty string if not found - scriptname - the relative name that matched; when not found, - the primary name searched for - scripttype - resolved script type: the extension without its - dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an - extensionless file that passed the identification - check, or empty string when not found - candidates - the locations that were (or would be) checked, - for use in error messages - notes - explanatory notes (e.g files skipped by the tcl - identification check), for use in error messages. - Raises an error if name is not a relative path." + @cmd -name "punk::path::scriptlib_resolve" -& + -summary -& + "Resolve a scriptlib script name to a path using the punk kit search policy" -& + -help -& + "Resolves a relative script name (the part after a 'lib:' prefix + in punk executable launch arguments) against the scriptlib + locations, in the same order the punk shell uses: + + 1. the kit vfs internal scriptlib (/app/scriptlib, + or /scriptlib for an unwrapped kit directory). + Internal scripts are deliberately NOT overridable by + external files (integrity and performance). + 2. /scriptlib - e.g /scriptlib for + an executable in /bin. + 3. /scriptlib. + + If the name's extension (lowercased) is one of the known + scriptlib extensions (.tcl .kit .py .pl .ps1 .sh), only that + exact name is searched. Otherwise two spellings are tried within + EACH location before moving to the next (so the kit-internal + precedence above is never crossed by a spelling preference): + 1. the exact name as called - accepted only if the file's + first lines identify it as a tcl script: a leading + '# tcl' comment, a shebang naming tclsh/tclkit/wish, or + the portable sh-trampoline ('#!/bin/sh' followed by a + commented 'exec tclsh ...' in the next lines). + 2. the name with '.tcl' appended. + An exact-name file that fails the tcl identification check is + skipped (recorded in notes) and resolution falls through. + + Returns a dict with keys: + path - resolved absolute path, or empty string if not found + scriptname - the relative name that matched; when not found, + the primary name searched for + scripttype - resolved script type: the extension without its + dot (tcl, kit, py, pl, ps1, sh), 'tcl' for an + extensionless file that passed the identification + check, or empty string when not found + candidates - the locations that were (or would be) checked, + for use in error messages + notes - explanatory notes (e.g files skipped by the tcl + identification check), for use in error messages. + Raises an error if name is not a relative path." @leaders - name -type string -optional 0 -help\ - "relative script name, with or without a known extension - (any leading lib: prefix should already be stripped)" + name -type string -optional 0 -help -& + "relative script name, with or without a known extension + (any leading lib: prefix should already be stripped)" }] } proc scriptlib_resolve {name} { @@ -675,14 +711,50 @@ namespace eval punk::path { #proc filepath_dotted_dirname {path} { #} + punk::args::define { + @id -id ::punk::path::strip_prefixdepth + @cmd -name punk::path::strip_prefixdepth -& + -summary -& + "Strip as many leading segments from path as prefix has segments (depth-based, content not compared)." -& + -help -& + "Returns path, normjoin-normalized, with its first N segments removed - + where N is the number of 'file split' segments of the normjoin-normalized + prefix. Only the prefix's DEPTH is used: its segment content is not + compared against path (a deliberate speed tradeoff inherited from + kettle::path::strip via punk::repo::path_strip_prefixdepth - callers are + expected to already know path lies under prefix). + This is the purely textual punk::path variant: normalization is + punk::path::normjoin, so relative inputs stay relative (gaining a + leading ./ segment which then counts towards depth on whichever sides + are relative). Pass path and prefix of the same pathtype (both + relative or both absolute) for intuitive results. + punk::repo::path_strip_prefixdepth is the filesystem-normalizing + variant ('file normalize' based - absolutizes relative inputs against + the current directory). + An empty prefix returns the normjoin-normalized path unchanged. + Segment counting uses 'file split', so root/volume segmentation + follows the platform's rules (e.g //server/share/a splits as + {//server/share a} on windows but {/ server share a} on unix). + If prefix has as many or more segments than path, nothing remains and + an error is raised (file join with no arguments)." + @leaders -min 2 -max 2 + path -type string -help -& + "path to strip leading segments from" + prefix -type string -help -& + "path whose depth (segment count after normjoin + file split) + determines how many leading segments are removed" + } proc strip_prefixdepth {path prefix} { + #see PUNKARGS id ::punk::path::strip_prefixdepth (documentation-only - positional args) + #deliberately the textual normjoin, not 'file normalize' - punk::repo::path_strip_prefixdepth + #is the filesystem-normalizing sibling of this proc if {$prefix eq ""} { - return [norm $path] + return [normjoin $path] } return [file join {*}{ - } {*}[lrange {*}{ - } [file split [norm $path]] {*}{ - } [llength [file split [norm $prefix]]] {*}{ + } {*}[lrange {*}{ + } [file split [normjoin $path]] {*}{ + } [llength [file split [normjoin $prefix]]] {*}{ } end ] ] @@ -722,7 +794,54 @@ namespace eval punk::path { # } # return "^[join $pats ::]\$" #} + namespace eval argdoc { + #Canonical description of the path glob syntax implemented by pathglob_as_re + #and consumed by globmatchpath, treefilenames/treefilenames_zipfs and the + #subfolders -exclude-paths patterns. + #Referenced from PUNKARGS -help fields via the tstr placeholder: + # ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + #Continuation lines are deliberately unindented: placeholder substitution + #prepends the placeholder line's own indentation to every line after the + #first, so indented continuations here would render double-indented. + variable PATHGLOB_SEGMENT_SYNTAX {The glob elements *, **, *** and ? may appear in any segment of a path pattern: +* matches any single segment, or any span of characters within a segment + (/usr/*/bin matches /usr/local/bin but not /usr/bin or /usr/a/b/bin; + /usr/te*t matches /usr/test and /usr/teeeet but not /usr/te/t) +** as a whole segment matches 1 or more segments + (/usr/**/bin matches /usr/x/bin and /usr/x/y/bin but not /usr/bin. + Within a segment ** also spans segments: /usr/**.txt matches .txt files + at any depth below /usr) +*** as a whole segment matches 0 or more segments + (/usr/*** matches /usr itself as well as everything below it) +? matches any single character within a segment + (/usr/te?t matches /usr/test and /usr/text but not /usr/texxt or /usr/te/t) +* and ? are treated as glob characters wherever they appear in the pattern +- escaping is not supported. All other characters, including square brackets, +match as literals (unlike Tcl glob patterns).} + } + + punk::args::define { + @id -id ::punk::path::pathglob_as_re + @cmd -name punk::path::pathglob_as_re -& + -summary -& + "Return a regular expression for matching paths to a *|**|***|? path glob pattern." -& + -help -& + "Returns an anchored regular expression string for matching a path to a + glob pattern which can contain the glob elements *|**|***|? in any + segment of the path structure. + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + The pathglob doesn't have to contain glob characters - a pathglob + without them produces a regex matching that path exactly. + Regular expression syntax is deliberately not supported within the + pathglob string - supplied regex characters are treated as literals. + This is the engine behind punk::path::globmatchpath and the path + pattern matching of the treefilenames/subfolders family." + @leaders -min 1 -max 1 + pathglob -type string -optional 0 -help -& + "path glob pattern" + } proc pathglob_as_re {pathglob} { + #see PUNKARGS id ::punk::path::pathglob_as_re (documentation-only - single positional arg) #*** !doctools #[call [fun pathglob_as_re] [arg pathglob]] #[para] Returns a regular expression for matching a path to a glob pattern which can contain glob chars *|**|***|? in any segment of the path structure @@ -799,52 +918,40 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::globmatchpath - @cmd -name punk::path::globmatchpath\ - -summary\ - "Match path to *|**|? glob patterns"\ - -help\ - "Return a boolean indicating whether the path matches the specialised glob pattern. - A pattern such as /usr/*/bin will match any path that has /usr as the first segment and bin as the third segment, - with any single segment in between. - A pattern such as /usr/**/bin will match any path that has /usr as the first segment and bin as the last segment, - with 1 or more segments in between (so it will not match /usr/bin). - A pattern such as /usr/** will match any path that has /usr as the first segment, with 1 or more segments - following (so it will not match /usr itself). - A pattern such as /usr/*** will match /usr itself as well as any path below /usr - - *** as a whole segment matches zero or more segments (added 2026-07-20, G-093). - A pattern such as **/*.txt will match any path that ends with .txt, with 1 or more leading segments - (so it will not match test.txt or .txt). Use ***/*.txt to also match a bare test.txt. - A pattern such as ** will match any path. - The glob characters * and ? (and the whole-segment forms ** and ***) are the only special characters in the pathglob syntax. - - they are treated as glob characters regardless of where they appear in the pathglob string. - Note that this is different from other Tcl glob contexts where square brackets can be used. - The pathglob syntax treats other characters, including square brackets as literals. - For example, the pattern /usr/te?t will match /usr/test and /usr/text but not /usr/texxt, and the pattern /usr/te*t - will match /usr/test, /usr/teat, and /usr/teeeet but not /usr/te/t. - The pathglob syntax does not support escaping of glob characters - any glob characters in the pathglob are treated - as glob characters. For example, the pattern /usr/* will match any path that has /usr as the first segment and any - single segment as the second segment, but there is no way to specify a pattern that matches any path that has /usr - as the first segment and a literal * as the second segment. - Caller must ensure that file separator is forward slash. (e.g use file normalize on windows) - - options: - -nocase 0|1 (default 0 - case sensitive) - If -nocase is not supplied - default to case sensitive *except for driveletter* - ie - the driveletter alone in paths such as c:/etc will still be case insensitive. (ie c:/ETC/* will match C:/ETC/blah but not C:/etc/blah) - Explicitly specifying -nocase 0 will require the entire case to match including the driveletter. - " + @cmd -name punk::path::globmatchpath -& + -summary -& + "Match path to *|**|***|? glob patterns" -& + -help -& + "Return a boolean indicating whether the path matches the specialised + glob pattern. + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + Further whole-pattern examples: + /usr/** will match any path that has /usr as the first segment and 1 + or more segments following (so it will not match /usr itself). + /usr/*** will match /usr itself as well as any path below /usr. + **/*.txt will match any path that ends with .txt, with 1 or more + leading segments (so it will not match test.txt or .txt). Use + ***/*.txt to also match a bare test.txt. + ** will match any path. + Caller must ensure that file separator is forward slash. (e.g use + file normalize on windows)" @leaders - pathglob -type string -help "glob pattern to match path against. See [fun pathglob_as_re] for syntax of glob patterns" + pathglob -type string -help -& + "glob pattern to match path against (syntax as described above - + punk::path::pathglob_as_re documents the underlying conversion)" path -type string -help "path to match against glob pattern" @opts - -nocase -type boolean -default 0 -help\ + -nocase -type boolean -default 0 -help -& "case insensitive matching (default false - case sensitive) - - except for driveletter on windows which is always case insensitive - unless -nocase 0 is explicitly specified" + - except for the driveletter on windows paths: when -nocase is not + supplied, matching is case sensitive EXCEPT for a leading + driveletter (c:/ETC/* will match C:/ETC/blah but not C:/etc/blah). + Explicitly specifying -nocase 0 requires the entire case to match + including the driveletter." @values -min 0 -max 0 } - # -id proc globmatchpath {pathglob path args} { + #see PUNKARGS id ::punk::path::globmatchpath (documentation-only - args parsed manually below; keep synchronized) #*** !doctools #[call [fun globmatchpath] [arg pathglob] [arg path] [opt {option value...}]] #[para] Return true if the pathglob matches the path @@ -899,120 +1006,15 @@ namespace eval punk::path { } return $ismatch } - punk::args::define { - @id -id ::punk::path::subfolders1 - @cmd -name punk::path::subfolders1\ - -summary\ - "Listing of directories below supplied path."\ - -help\ - "List of folders below path. - The resulting list is unsorted." - @opts - -recursive -type none -help\ - "" - -exclude-paths -type list -default {} -help\ - "list of path patterns to exclude from results. - May include * and ** path segments e.g /usr/** - A single /*/ will match any single segment in the path, and a single /**/ will match any number of segments in the path. - - e.g to exclude any path with _aside as a segment in the middle: -exclude-paths **/_aside/** - i.e this would exclude /usr/_aside/etc and /usr/x/_aside/etc but not /usr/x/_aside or _aside/etc - - To exclude all paths with _aside as a segment anywhere: -exclude-paths { **/_aside/** **/_aside _aside/**} - " - #todo -depth - @values -min 0 -max 1 - path -type directory -optional 1 -help\ - "Path of folder. If not supplied current directory is used. - This may be a relative or absolute path. Relative paths are treated as relative to current directory. - When using relative paths - the result will also be relative paths with the same relative prefix. - (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc) - Patterns in -exclude-paths are matched against the resulting paths - (so should be written to match the same relative prefix if path is relative)" - } - - proc subfolders1 {args} { - #NOTE - this algorithm based on omit_only_patterns and prune_base_patterns was suggested by a 2026 AI model - it is apparent to this programmer that it is inadequate for the purpose. - #e.g consider subfolders1 -recursion -exclude {**/vfs/** **/src/**} - #This can still return something like c:/repo/etc/src/vfs - which should be excluded by the pattern **/src/** - #todo - review and fix properly. - set argd [punk::args::parse $args withid ::punk::path::subfolders1] - lassign [dict values $argd] leaders opts values received - set do_recursion [dict exists $received -recursive] - set exclude_paths [dict get $opts -exclude-paths] - if {"**" in $exclude_paths} { - #if ** is in exclude_paths - then we can skip all glob matching and just return empty list - #This is likely user error - so we'll be loud about it for now but will still return empty list rather than erroring. - #If user code is building exclude_paths dynamically - they can check for this case themselves and avoid the call to subfolders1 to suppress this message. - puts stderr "punk::path::subfolders1 Warning - exclude_paths contains '**' - all paths will be excluded" - return [list] - } - if {[dict exists $received path]} { - set path [dict get $values path] - } else { - set path [pwd] - } - - set all_subfolders [glob -nocomplain -directory $path -types d *] - - - #example of expected exclude_paths pattern behaviour when recursion is enabled: - # **/dirname -> omit /x/y/dirname, but still visit /x/y/dirname/* - - # **/dirname/* -> include /x/y/dirname and /x/y/dirname/a/b but omit directories that are a single level below /x/y/dirname such as /x/y/dirname/a - - #c:/** - would exclude all subfolders below c: but not c: itself - - # **/test/** - would exclude any path with test as a segment and all its subfolders - #- but not paths with test as a segment that is the final segment - - set folders [list] - set recurse_subdirs [list] - - foreach f $all_subfolders { - set include_in_results 1 - set allow_recurse 1 - foreach pat $exclude_paths { - set pat_parts [file split $pat] ;#note file split c:/test gives {c:/ test} but file split **/test gives {** test} - #also note that file split on windows treats forward slashes and backslashes the same. - #by using file split, we gain some flexibility in syntax of paths and patterns, - #but lose the ability to use backslashes as escapes to allow literal glob characters in path segments. - #This is almost always a non-issue on windows since * and ? are not valid in path segments there, and is rarely an issue on unix even though - # * and ? are technically valid in path segments, but it is inadvisable there anyway for compatibility with shells etc. - if {[llength $pat_parts] >= 2 && [lindex $pat_parts end] eq "**"} { - set base_pat [file join {*}[lrange $pat_parts 0 end-1]] - if {[globmatchpath $pat $f]} { - set include_in_results 0 - set allow_recurse 0 - } elseif {[globmatchpath $base_pat $f]} { - set allow_recurse 0 - } - } elseif {[globmatchpath $pat $f]} { - set include_in_results 0 - } - if {!$include_in_results && !$allow_recurse} { - break - } - } - if {$include_in_results} { - lappend folders $f - } - if {$allow_recurse} { - lappend recurse_subdirs $f - } - } - if {$do_recursion} { - foreach subdir $recurse_subdirs { - lappend folders {*}[subfolders1 -exclude-paths $exclude_paths -recursive $subdir] - } - } - return $folders - } - namespace eval subfolder_priv { proc classify_exclude_pattern {pat} { set parts [file split $pat] - if {[llength $parts] >= 2 && [lindex $parts end] eq "**"} { + if {[llength $parts] >= 2 && [lindex $parts end] in {** ***}} { + #a trailing *** full-matches the boundary folder too (zero segments + #below), so the descend test alone omits the boundary and prunes - + #this IS the decomposition of X/*** to the pair {X/** X}. A trailing + #** matches only below the boundary; the boundary branch then keeps + #the boundary folder while still pruning descent. set boundary_pat [file join {*}[lrange $parts 0 end-1]] return [dict create {*}{ } pattern $pat {*}{ @@ -1107,35 +1109,52 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::subfolders - @cmd -name punk::path::subfolders\ - -summary\ - "Listing of directories below supplied path."\ - -help\ + @cmd -name punk::path::subfolders -& + -summary -& + "Listing of directories below supplied path." -& + -help -& "List of folders below path. - The resulting list is unsorted. - " + The resulting list is unsorted." @opts - -recursive -type none -help\ - "" - -exclude-paths -type list -default {} -help\ - "list of path patterns to exclude from results. - May include * and ** path segments e.g /usr/** - A single /*/ will match any single segment in the path, and a single /**/ will match any number of segments in the path. - - e.g to exclude any path with _aside as a segment in the middle: -exclude-paths **/_aside/** - i.e this would exclude /usr/_aside/etc and /usr/x/_aside/etc but not /usr/x/_aside or _aside/etc - - To exclude all paths with _aside as a segment anywhere: -exclude-paths { **/_aside/** **/_aside ./_aside/**} - " + -recursive -type none -help -& + "Recurse into subfolders, returning the whole tree of folders below + path rather than only its immediate subfolders. + Subtrees pruned by a trailing-** or trailing-*** -exclude-paths + pattern are not descended." + -exclude-paths -type list -default {} -help -& + "List of path patterns for folders to exclude from the results. + Patterns are matched against the result paths as they would be + returned (see the path argument help regarding relative paths). + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} + The form of a matching pattern determines what is excluded: + **/_aside (plain tail) each matching folder is omitted from + the results, but its subfolders are still visited + and remain eligible + **/_aside/* as above - only folders exactly one level below an + _aside folder are omitted + **/_aside/** (tail **) the matching folder itself is KEPT, but + nothing below it is returned - and the walk does + not descend below it + **/_aside/*** (tail ***) the matching folder and everything below + it are omitted, and the walk does not descend below + it (handled internally as the equivalent pair + {**/_aside/** **/_aside}) + So to exclude every folder with _aside as a segment anywhere below + an absolute base path: -exclude-paths {**/_aside/***} + (with a relative base path, also supply forms matching the same + relative prefix as the results when needed) + A pattern list containing a bare ** or *** (which would exclude + every result) is rejected with a warning and an empty list is + returned." #todo -depth @values -min 0 -max 1 - path -type directory -optional 1 -help\ + path -type directory -optional 1 -help -& "Path of base folder. If not supplied current directory is used. - This may be a relative or absolute path. Relative paths are treated as relative to current directory. - When using relative paths - the result will also be relative paths with the same relative prefix. - (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc) - Patterns in -exclude-paths are matched against the resulting paths - (so should be written to match the same relative prefix if path is relative)" + This may be a relative or absolute path. Relative paths are treated as relative to current directory. + When using relative paths - the result will also be relative paths with the same relative prefix. + (e.g if path is ../test - the results will be ../test/subfolder1 ../test/subfolder2 etc) + Patterns in -exclude-paths are matched against the resulting paths + (so should be written to match the same relative prefix if path is relative)" } proc subfolders {args} { @@ -1143,8 +1162,9 @@ namespace eval punk::path { lassign [dict values $argd] leaders opts values received set do_recursion [dict exists $received -recursive] set exclude_paths [dict get $opts -exclude-paths] - if {"**" in $exclude_paths} { - puts stderr "punk::path::subfolders Warning - exclude_paths contains '**' - all paths will be excluded" + if {"**" in $exclude_paths || "***" in $exclude_paths} { + #likely user error - be loud about it but return empty rather than erroring. + puts stderr "punk::path::subfolders Warning - exclude_paths contains a bare '**' or '***' - all paths will be excluded" return [list] } if {[dict exists $received path]} { @@ -1597,22 +1617,25 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::treefilenames - @cmd -name punk::path::treefilenames\ - -summary\ - "List of filenames below supplied path."\ - -help\ + @cmd -name punk::path::treefilenames -& + -summary -& + "List of filenames below supplied path." -& + -help -& "List of filenames below path. - The resulting list is unsorted. - - The path globbing syntax supports *, **, *** and ? as glob characters in any segment of the path, with the following semantics: - * matches any single segment in the path - ** as a whole segment matches 1 or more segments in the path (so /usr/**/bin will match /usr/x/bin and user/x/y/bin but not /usr/bin ) - *** as a whole segment matches 0 or more segments in the path (so /usr/*** will match /usr itself as well as anything below it) - ? matches any single character in a single segment of the path (so /usr/te?t will match /usr/test and /usr/text but not /usr/texxt) + Results are gathered depth-first; the -sort option (default natural) + controls the ordering of files and subfolder visits within each + directory as the tree is walked. + For a -directory under //zipfs:/ the walk dispatches to the + treefilenames_zipfs implementation (also callable directly), which + applies -sort to its combined result list instead. + + The path patterns of -include-paths and -exclude-paths use the + following syntax: + ${$::punk::path::argdoc::PATHGLOB_SEGMENT_SYNTAX} " - -directory -type directory -help\ + -directory -type directory -help -& "folder in which to begin recursive scan for files." - -tailbase -type string -default "" -help\ + -tailbase -type string -default "" -help -& "if supplied, only the relative path compared to the tailbase will be returned for each file. So if tailbase is /usr and a file is found at /usr/x/y/file.txt, the returned path for that file would be x/y/file.txt. If tailbase is not supplied, the full path to each file will be returned. @@ -1624,10 +1647,16 @@ namespace eval punk::path { see: punk::path::relative to compute relative paths " - -sort -type any -default natural -choices {none ascii dictionary natural} - -exclude-paths -default {} -help\ + -sort -type any -default natural -choices {none ascii dictionary natural} -help -& + "Ordering of files and subfolder visits within each directory during + the walk - the combined result list is not re-sorted. + (treefilenames_zipfs instead applies the sort to its combined + result list) + natural sorting requires the natsort package." + -exclude-paths -type list -default {} -help -& "list of directory path patterns to exclude - may include *, ** and *** path segments e.g + may include *, **, *** and ? glob elements + (path glob syntax - see punk::path::pathglob_as_re) e.g /usr (exclude files directly within /usr; subfolders are still walked) /usr/* (exclude files in folders exactly one below /usr) @@ -1639,10 +1668,15 @@ namespace eval punk::path { Patterns whose final segment is ** or *** prune the matched subtree; other matches exclude only the files directly in the matching folder. Exclusion wins over inclusion for the same file." - -exclude-files -default {} - -include-paths -default {**} -help\ + -exclude-files -type list -default {} -help -& + "list of patterns matched against the filename portion (last segment) + of each file path - matching files are excluded. + These are ordinary Tcl glob patterns (string match) - not the path + glob syntax used by -include-paths/-exclude-paths." + -include-paths -type list -default {**} -help -& "list of directory path patterns to include - may include *, ** and *** path segments e.g + may include *, **, *** and ? glob elements + (path glob syntax - see punk::path::pathglob_as_re) e.g /usr (include files directly within /usr only) /usr/* (include files in folders exactly one below /usr) /usr/** (include files in subfolders based at /usr but not @@ -1656,9 +1690,11 @@ namespace eval punk::path { below their match. The /usr, /usr/*, /usr/** and /usr/*** forms are deliberately separable." @values -min 0 -max -1 -optional 1 -type string - tailglobs -default * -multiple 1 -help\ + tailglobs -default * -multiple 1 -help -& "Patterns to match against filename portion (last segment) of each file path - within the directory tree being searched." + within the directory tree being searched. + These are ordinary Tcl glob patterns - not the path glob syntax of + -include-paths/-exclude-paths." } #todo - implement treefiles which acts like dirfiles but allows path globbing in the same way as punk::ns::ns/ @@ -1682,28 +1718,28 @@ namespace eval punk::path { punk::args::define { @id -id ::punk::path::relative - @cmd -name punk::path::relative\ - -summary\ - "Compute the relative path from a reference path to a location path."\ - -help\ - "Taking two directory paths, a reference and a location, computes the path - of the location relative to the reference. + @cmd -name punk::path::relative -& + -summary -& + "Compute the relative path from a reference path to a location path." -& + -help -& + "Taking two directory paths, a reference and a location, computes the path + of the location relative to the reference. - Will return a single dot '.' if the paths are the same. + Will return a single dot '.' if the paths are the same. - Both paths must be the same type - ie both absolute or both relative. + Both paths must be the same type - ie both absolute or both relative. - Matching is case sensitive. On windows, the drive-letter component (only) is - not case sensitive, so punk::path::relative c:/etc C:/etc returns '.'. - The part following the driveletter is case sensitive, so - punk::path::relative c:/etc C:/Etc returns ../Etc. + Matching is case sensitive. On windows, the drive-letter component (only) is + not case sensitive, so punk::path::relative c:/etc C:/etc returns '.'. + The part following the driveletter is case sensitive, so + punk::path::relative c:/etc C:/Etc returns ../Etc. - On windows, if the paths are absolute and specify different volumes, - only the location will be returned." + On windows, if the paths are absolute and specify different volumes, + only the location will be returned." @leaders -min 2 -max 2 - reference -type string -help\ + reference -type string -help -& "The path from which the relative path to location is determined." - location -type string -help\ + location -type string -help -& "The location path which may be above or below the reference path." } #maint warning - also in punkcheck @@ -1812,20 +1848,20 @@ namespace eval punk::path::system { namespace eval argdoc { lappend PUNKARGS [list { @id -id ::punk::path::system::scriptfile_is_tcl - @cmd -name "punk::path::system::scriptfile_is_tcl"\ - -summary\ - "Test whether a script file's first lines identify it as a tcl script"\ - -help\ - "Reads a small bounded chunk (512 bytes) of the file and reports 1 if - the first line is a '# tcl'-prefixed comment (case-insensitive), a - shebang naming tclsh/tclkit/wish, or any other shebang whose next - few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. - A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for - unreadable files and anything not identified as tcl. - Used by punk::path::scriptlib_resolve to allow extensionless tcl - scripts to be called via the lib: prefix." + @cmd -name "punk::path::system::scriptfile_is_tcl" -& + -summary -& + "Test whether a script file's first lines identify it as a tcl script" -& + -help -& + "Reads a small bounded chunk (512 bytes) of the file and reports 1 if + the first line is a '# tcl'-prefixed comment (case-insensitive), a + shebang naming tclsh/tclkit/wish, or any other shebang whose next + few lines contain the portable sh-trampoline 'exec tclsh ...' idiom. + A UTF-8 BOM and CRLF line endings are tolerated. Returns 0 for + unreadable files and anything not identified as tcl. + Used by punk::path::scriptlib_resolve to allow extensionless tcl + scripts to be called via the lib: prefix." @leaders - fpath -type string -optional 0 -help\ + fpath -type string -optional 0 -help -& "path of the file to examine" }] } @@ -1881,7 +1917,7 @@ namespace eval ::punk::args::register { package provide punk::path [namespace eval punk::path { variable pkg punk::path variable version - set version 0.4.0 + set version 0.5.0 }] return