Browse Source
make.tcl bootsupport refresh following the stage-2 cutover; superseded 0.1.1 handler and 0.1.4 modpod pruned (the modpod copy required manual deletion - the running make.tcl mounts it and the prune self-locks; flagged in the G-087 detail file). Layout custom/_project bootsupport copies mirrored by the build. Assisted-by: harness=claude; primary-model=claude-fable-5; api-location=anthropic.commaster
3 changed files with 833 additions and 24 deletions
Binary file not shown.
@ -0,0 +1,804 @@
|
||||
# -*- tcl -*- |
||||
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt |
||||
# |
||||
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. |
||||
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. |
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
# (C) 2023 |
||||
# |
||||
# @@ Meta Begin |
||||
# Application punk::cap::handlers::templates 0.2.0 |
||||
# Meta platform tcl |
||||
# Meta license <unspecified> |
||||
# @@ Meta End |
||||
|
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Requirements |
||||
##e.g package require frobz |
||||
|
||||
package require punk::repo |
||||
package require fauxlink ;#layout refs are .fauxlink/.fxlnk files (G-087 stage 2 - bespoke .ref grammar retired) |
||||
|
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
#register using: |
||||
# punk::cap::register_capabilityname templates ::punk::cap::handlers::templates |
||||
|
||||
#By convention and for consistency, we don't register here during package loading - but require the calling app to do it. |
||||
# (even if it tends to be done immediately after package require anyway) |
||||
# registering capability handlers can involve validating existing provider data and is best done explicitly as required. |
||||
# It is also possible for a capability handler to be registered to handle more than one capabilityname |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
namespace eval punk::cap::handlers::templates { |
||||
namespace eval capsystem { |
||||
#interfaces for punk::cap to call into |
||||
if {[info commands caphandler.registry] eq ""} { |
||||
punk::cap::class::interface_caphandler.registry create caphandler.registry |
||||
oo::objdefine caphandler.registry { |
||||
method pkg_register {pkg capname capdict caplist} { |
||||
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?) |
||||
|
||||
# -- --- --- --- --- --- --- ---- --- |
||||
# validation of capdict |
||||
# -- --- --- --- --- --- --- ---- --- |
||||
if {![dict exists $capdict vendor]} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing the 'vendor' key" |
||||
return 0 |
||||
} |
||||
if {![dict exists $capdict path] || ![dict exists $capdict pathtype]} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing the 'path' or 'pathtype' key" |
||||
return 0 |
||||
} |
||||
set pathtype [dict get $capdict pathtype] |
||||
set vendor [dict get $capdict vendor] |
||||
set known_pathtypes [list adhoc currentproject_multivendor currentproject shellproject_multivendor shellproject module absolute] |
||||
if {$pathtype ni $known_pathtypes} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but 'pathtype' value '$pathtype' is not recognised. Known type: $known_pathtypes" |
||||
return 0 |
||||
} |
||||
|
||||
set path [dict get $capdict path] |
||||
|
||||
set cname [string map {. _} $capname] |
||||
|
||||
set multivendor_package_whitelist [list punk::mix::templates] |
||||
|
||||
|
||||
#for template pathtype module & shellproject* we can resolve whether it's within a project at registration time and store the base rather than rechecking it each time the templates handler api is called |
||||
#for template pathtype absolute - we can do the same. |
||||
#There is a small chance for a long-running shell that a project is later created which makes the absolute path within a project - but it seems an unlikely case, and probably won't surprise the user that they need to relaunch the shell or reload the capsystem to see the change. |
||||
|
||||
#adhoc and currentproject* pathtypes are relative to cwd - so no base information can be stored at registration time. |
||||
#module pathtype base is resolved by the providing package itself at load time using 'info script' |
||||
|
||||
#not all template item types will need base information - as the item data may be self-contained within the template structure - |
||||
#but project_layout will need it - or at least need to know if there is no project - because project_layout data is never stored in the template folder structure directly. |
||||
switch -- $pathtype { |
||||
adhoc { |
||||
if {[file pathtype $path] ne "relative"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be a relative path" |
||||
return 0 |
||||
} |
||||
set extended_capdict $capdict |
||||
dict set extended_capdict vendor $vendor |
||||
} |
||||
module { |
||||
if {[file pathtype $path] ne "relative"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be a relative path" |
||||
} |
||||
#The package should have provided a base folder (by using 'info script') when it was loaded |
||||
#'package ifneeded' for a module gives initial path information for a package - but it might redirect to sourcing from a different location such as being mounted elsewhere in a vfs, |
||||
#in which case we wouldn't get the correct path. |
||||
if {![dict exists $capdict base]} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing the 'base' key (required when pathtype is 'module')" |
||||
return 0 |
||||
} |
||||
|
||||
set extended_capdict $capdict |
||||
set base [dict get $capdict base] |
||||
set resolved_path [file join $base $path] |
||||
dict set extended_capdict resolved_path $resolved_path |
||||
dict set extended_capdict base $base |
||||
} |
||||
currentproject_multivendor { |
||||
#currently only intended for punk::mix::templates - review if 3rd party _multivendor trees even make sense |
||||
if {$pkg ni $multivendor_package_whitelist} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but package is not in whitelist $multivendor_package_whitelist - 3rd party _multivendor tree not supported" |
||||
return 0 |
||||
} |
||||
if {[file pathtype $path] ne "relative"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be a relative path" |
||||
return 0 |
||||
} |
||||
|
||||
set extended_capdict $capdict |
||||
dict set extended_capdict vendor $vendor ;#vendor key still required.. controlling vendor? |
||||
} |
||||
currentproject { |
||||
if {[file pathtype $path] ne "relative"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be a relative path" |
||||
return 0 |
||||
} |
||||
#verify that the relative path is within the relative path of a currentproject_multivendor tree |
||||
#todo - api for the _multivendor tree controlling package to validate |
||||
|
||||
|
||||
set extended_capdict $capdict |
||||
dict set extended_capdict vendor $vendor |
||||
} |
||||
shellproject { |
||||
if {[file pathtype $path] ne "relative"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be a relative path" |
||||
return 0 |
||||
} |
||||
#set shellbase [file dirname [file dirname [file normalize [set ::argv0]/__]]] ;#review |
||||
set shellbase [file dirname [file dirname [file normalize [info nameofexecutable]/___]]] |
||||
|
||||
#set projectinfo [punk::repo::find_repos $shellbase] |
||||
#set base [dict get $projectinfo closest] |
||||
|
||||
#may result in empty base for no project found |
||||
set base [punk::repo::find_project $shellbase] |
||||
|
||||
set extended_capdict $capdict |
||||
dict set extended_capdict vendor $vendor |
||||
dict set extended_capdict base $base |
||||
} |
||||
shellproject_multivendor { |
||||
#currently only intended for punk::templates - review if 3rd party _multivendor trees even make sense |
||||
if {$pkg ni $multivendor_package_whitelist} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but package is not in whitelist $multivendor_package_whitelist - 3rd party _multivendor tree not supported" |
||||
return 0 |
||||
} |
||||
if {[file pathtype $path] ne "relative"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be a relative path" |
||||
return 0 |
||||
} |
||||
#set shellbase [file dirname [file dirname [file normalize [set ::argv0]/__]]] ;#review |
||||
set shellbase [file dirname [file dirname [file normalize [info nameofexecutable]/___]]] |
||||
#set projectinfo [punk::repo::find_repos $shellbase] |
||||
#set base [dict get $projectinfo closest] |
||||
set base [punk::repo::find_project $shellbase] |
||||
|
||||
set extended_capdict $capdict |
||||
dict set extended_capdict vendor $vendor |
||||
dict set extended_capdict base $base |
||||
} |
||||
absolute { |
||||
if {[file pathtype $path] ne "absolute"} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' of type $pathtype which doesn't seem to be absolute" |
||||
return 0 |
||||
} |
||||
set normpath [file normalize $path] |
||||
if {![file exists $normpath]} { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' which doesn't seem to exist" |
||||
return 0 |
||||
} |
||||
|
||||
#todo - verify no other provider has registered same absolute path - if sharing a project-external location is needed - they need their own subfolder |
||||
set extended_capdict $capdict |
||||
dict set extended_capdict resolved_path $normpath |
||||
dict set extended_capdict vendor $vendor |
||||
dict set extended_capdict base "" |
||||
} |
||||
default { |
||||
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability but provided a path '$path' with unrecognised type $pathtype" |
||||
return 0 |
||||
} |
||||
} |
||||
|
||||
# -- --- --- --- --- --- --- ---- --- |
||||
# update package internal data |
||||
# -- --- --- --- --- --- --- ---- --- |
||||
upvar ::punk::cap::handlers::templates::provider_info_$cname provider_info |
||||
|
||||
if {$capname ni $::punk::cap::handlers::templates::handled_caps} { |
||||
lappend ::punk::cap::handlers::templates::handled_caps $capname |
||||
} |
||||
if {![info exists provider_info] || ![dict exists $provider_info $pkg] || $extended_capdict ni [dict get $provider_info $pkg]} { |
||||
#this checks for duplicates from the same provider - but not if other providers already added the path |
||||
#review - |
||||
dict lappend provider_info $pkg $extended_capdict |
||||
} |
||||
|
||||
|
||||
# -- --- --- --- --- --- --- ---- --- |
||||
# instantiation of api at punk::cap::handlers::templates::api_$capname |
||||
# -- --- --- --- --- --- --- ---- --- |
||||
set apicmd "::punk::cap::handlers::templates::api_$capname" |
||||
if {[info commands $apicmd] eq ""} { |
||||
punk::cap::handlers::templates::class::api create $apicmd $capname |
||||
} |
||||
|
||||
return 1 |
||||
} |
||||
method pkg_unregister {pkg} { |
||||
upvar ::punk::cap::handlers::templates::handled_caps hcaps |
||||
foreach capname $hcaps { |
||||
set cname [string map {. _} $capname] |
||||
upvar ::punk::cap::handlers::templates::provider_info_$cname my_provider_info |
||||
dict unset my_provider_info $pkg |
||||
#destroy api objects? |
||||
} |
||||
} |
||||
} |
||||
} |
||||
} |
||||
|
||||
variable handled_caps [list] |
||||
#variable pkg_folders [dict create] |
||||
|
||||
# -- --- --- --- --- --- --- |
||||
#handler api for clients of this capability - called via punk::cap::call_handler <capname> <method> ?args? |
||||
# -- --- --- --- --- --- --- |
||||
namespace export * |
||||
namespace eval class { |
||||
variable PUNKARGS |
||||
#lappend PUNKARGS [list { |
||||
# @id -id "::punk::cap::handlers::templates::class::api folders" |
||||
# -startdir -default "" |
||||
# @values -max 0 |
||||
#}] |
||||
|
||||
oo::class create api { |
||||
#return a dict keyed on folder with source pkg as value |
||||
constructor {capname} { |
||||
variable capabilityname |
||||
variable cname |
||||
set cname [string map {. _} $capname] |
||||
set capabilityname $capname |
||||
} |
||||
set class_ns [uplevel 1 [list namespace current]] |
||||
|
||||
lappend ${class_ns}::PUNKARGS [list { |
||||
@id -id "::punk::cap::handlers::templates::class::api folders" |
||||
@cmd -name "punk::cap::handlers::templates::class::api folders" |
||||
-startdir -default "" -help\ |
||||
"Defaults to CWD if not supplied" |
||||
@values -max 0 |
||||
}] |
||||
method folders {args} { |
||||
#puts "--folders $args" |
||||
set argd [punk::args::parse $args withid "[self class] folders"] |
||||
set opts [dict get $argd opts] |
||||
|
||||
set opt_startdir [dict get $opts -startdir] |
||||
if {$opt_startdir eq ""} { |
||||
set startdir [pwd] |
||||
} else { |
||||
if {[file pathtype $opt_startdir] eq "relative"} { |
||||
set startdir [file join [pwd] $opt_startdir] |
||||
} else { |
||||
set startdir $opt_startdir |
||||
} |
||||
} |
||||
set searchbase $startdir |
||||
#set pathinfo [punk::repo::find_repos $searchbase] ;#relatively slow! REVIEW - pass as arg? cache? |
||||
#set pwd_projectroot [dict get $pathinfo closest] |
||||
set pwd_projectroot [punk::repo::find_project $searchbase] |
||||
|
||||
|
||||
variable capabilityname |
||||
variable cname |
||||
upvar ::punk::cap::handlers::templates::provider_info_$cname my_provider_info |
||||
package require punk::cap |
||||
set capinfo [punk::cap::capability $capabilityname] |
||||
# e.g {punk.templates {handler punk::mix::templates providers ::somepkg}} |
||||
|
||||
#use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package |
||||
set providerpkg [dict get $capinfo providers] |
||||
set folderdict [dict create] |
||||
|
||||
#maintain separate paths for different override levels - all keyed on vendor (or pseudo-vendor '_project') |
||||
set found_paths_adhoc [dict create] |
||||
set found_paths_module [dict create] |
||||
set found_paths_currentproject_multivendor [dict create] |
||||
set found_paths_currentproject [dict create] |
||||
set found_paths_shellproject_multivendor [dict create] |
||||
set found_paths_shellproject [dict create] |
||||
set found_paths_absolute [list] |
||||
|
||||
|
||||
foreach pkg $providerpkg { |
||||
set found_paths [list] |
||||
#set acceptedlist [dict get [punk::cap::pkgcap $pkg $capabilityname] accepted] |
||||
|
||||
foreach capdecl_extended [dict get $my_provider_info $pkg] { |
||||
#basic validation and extension was done when accepted - so we can trust the capdecl_extended dictionary has the right entries |
||||
|
||||
set path [dict get $capdecl_extended path] |
||||
set pathtype [dict get $capdecl_extended pathtype] |
||||
set vendor [dict get $capdecl_extended vendor] |
||||
# base not present in capdecl_extended for all template pathtypes ? |
||||
if {$pathtype eq "adhoc"} { |
||||
#e.g (cwd)/templates |
||||
set targetpath [file join $startdir [dict get $capdecl_extended path]] |
||||
if {[file isdirectory $targetpath]} { |
||||
dict lappend found_paths_adhoc $vendor [list pkg $pkg path $targetpath pathtype $pathtype base $startdir] |
||||
} |
||||
} elseif {$pathtype eq "module"} { |
||||
set mbase [dict get $capdecl_extended base] |
||||
dict lappend found_paths_module $vendor [list pkg $pkg path [dict get $capdecl_extended resolved_path] pathtype $pathtype base $mbase] |
||||
} elseif {$pathtype eq "currentproject_multivendor"} { |
||||
#set searchbase $startdir |
||||
#set pathinfo [punk::repo::find_repos $searchbase] |
||||
#set pwd_projectroot [dict get $pathinfo closest] |
||||
if {$pwd_projectroot ne ""} { |
||||
set deckbase [file join $pwd_projectroot $path] |
||||
if {![file exists $deckbase]} { |
||||
continue |
||||
} |
||||
#add vendor/x folders first - earlier in list is lower priority |
||||
set vendorbase [file join $deckbase vendor] |
||||
if {[file isdirectory $vendorbase]} { |
||||
set vendorfolders [glob -nocomplain -dir $vendorbase -type d -tails *] |
||||
foreach vf $vendorfolders { |
||||
if {$vf ne "_project"} { |
||||
dict lappend found_paths_currentproject_multivendor $vf [list pkg $pkg path [file join $vendorbase $vf] pathtype $pathtype base $pwd_projectroot] |
||||
} |
||||
} |
||||
if {[file isdirectory [file join $vendorbase _project]]} { |
||||
dict lappend found_paths_currentproject_multivendor _project [list pkg $pkg path [file join $vendorbase _project] pathtype $pathtype base $pwd_projectroot] |
||||
} |
||||
} |
||||
set custombase [file join $deckbase custom] |
||||
if {[file isdirectory $custombase]} { |
||||
set customfolders [glob -nocomplain -dir $custombase -type d -tails *] |
||||
foreach cf $customfolders { |
||||
if {$cf ne "_project"} { |
||||
dict lappend found_paths_currentproject_multivendor $cf [list pkg $pkg path [file join $custombase $cf] pathtype $pathtype base $pwd_projectroot] |
||||
} |
||||
} |
||||
if {[file isdirectory [file join $custombase _project]]} { |
||||
dict lappend found_paths_currentproject_multivendor _project [list pkg $pkg path [file join $custombase _project] pathtype $pathtype base $pwd_projectroot] |
||||
} |
||||
} |
||||
} |
||||
} elseif {$pathtype eq "currentproject"} { |
||||
#set searchbase $startdir |
||||
#set pathinfo [punk::repo::find_repos $searchbase] |
||||
#set pwd_projectroot [dict get $pathinfo closest] |
||||
if {$pwd_projectroot ne ""} { |
||||
#path relative to projectroot already validated by handler as being within a currentproject_multivendor tree |
||||
set targetfolder [file join $pwd_projectroot $path] |
||||
if {[file isdirectory $targetfolder]} { |
||||
dict lappend found_paths_currentproject $vendor [list pkg $pkg path $targetfolder pathtype $pathtype base $pwd_projectroot] |
||||
} |
||||
} |
||||
} elseif {$pathtype eq "shellproject_multivendor"} { |
||||
#review - consider also [info script] - but it can be empty if we just start a tclsh, load packages and start a repl |
||||
#set shellbase [file dirname [file dirname [file normalize [set ::argv0]/__]]] ;#review |
||||
#set pathinfo [punk::repo::find_repos $shellbase] |
||||
#set pwd_projectroot [dict get $pathinfo closest] |
||||
|
||||
set shell_projectroot [dict get $capdecl_extended base] |
||||
if {$shell_projectroot ne ""} { |
||||
set deckbase [file join $shell_projectroot $path] |
||||
if {![file exists $deckbase]} { |
||||
continue |
||||
} |
||||
#add vendor/x folders first - earlier in list is lower priority |
||||
set vendorbase [file join $deckbase vendor] |
||||
if {[file isdirectory $vendorbase]} { |
||||
set vendorfolders [glob -nocomplain -dir $vendorbase -type d -tails *] |
||||
foreach vf $vendorfolders { |
||||
if {$vf ne "_project"} { |
||||
dict lappend found_paths_shellproject_multivendor $vf [list pkg $pkg path [file join $vendorbase $vf] pathtype $pathtype base $shell_projectroot] |
||||
} |
||||
} |
||||
if {[file isdirectory [file join $vendorbase _project]]} { |
||||
dict lappend found_paths_shellproject_multivendor _project [list pkg $pkg path [file join $vendorbase _project] pathtype $pathtype base $shell_projectroot] |
||||
} |
||||
} |
||||
set custombase [file join $deckbase custom] |
||||
if {[file isdirectory $custombase]} { |
||||
set customfolders [glob -nocomplain -dir $custombase -type d -tails *] |
||||
foreach cf $customfolders { |
||||
if {$cf ne "_project"} { |
||||
dict lappend found_paths_shellproject_multivendor $cf [list pkg $pkg path [file join $custombase $cf] pathtype $pathtype base $shell_projectroot] |
||||
} |
||||
} |
||||
if {[file isdirectory [file join $custombase _project]]} { |
||||
dict lappend found_paths_shellproject_multivendor _project [list pkg $pkg path [file join $custombase _project] pathtype $pathtype base $shell_projectroot] |
||||
} |
||||
} |
||||
|
||||
} |
||||
|
||||
} elseif {$pathtype eq "shellproject"} { |
||||
#review - consider also [info script] - but it can be empty if we just start a tclsh, load packages and start a repl |
||||
#set shellbase [file dirname [file dirname [file normalize [set ::argv0]/__]]] ;#review |
||||
#set pathinfo [punk::repo::find_repos $shellbase] |
||||
#set pwd_projectroot [dict get $pathinfo closest] |
||||
|
||||
set shell_projectroot [dict get $capdecl_extended base] |
||||
if {$shell_projectroot ne ""} { |
||||
set targetfolder [file join $shell_projectroot $path] |
||||
if {[file isdirectory $targetfolder]} { |
||||
dict lappend found_paths_shellproject $vendor [list pkg $pkg path $targetfolder pathtype $pathtype base $shell_projectroot] |
||||
} |
||||
} |
||||
} elseif {$pathtype eq "absolute"} { |
||||
#lappend found_paths [dict get $capdecl_extended resolved_path] |
||||
set abs_projectroot [dict get $capdecl_extended base] |
||||
dict lappend found_paths_absolute $vendor [list pkg $pkg path [dict get $capdecl_extended resolved_path] pathtype $pathtype base $abs_projectroot] |
||||
} |
||||
|
||||
} |
||||
|
||||
#todo - ensure vendor pkg capdict elements such source and allowupdates override any existing entry from a _multivendor pkg? |
||||
#currently relying on order in which loaded? review |
||||
#foreach pfolder $found_paths { |
||||
# dict set folderdict $pfolder [list source $pkg sourcetype package] |
||||
#} |
||||
} |
||||
|
||||
#add in order of preference low priority to high |
||||
|
||||
dict for {vendor pathinfolist} $found_paths_module { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] base [dict get $pathinfo base] vendor $vendor] |
||||
} |
||||
} |
||||
|
||||
#Templates within project of shell we launched with has lower priority than 'currentproject' (which depends on our CWD) |
||||
dict for {vendor pathinfolist} $found_paths_shellproject_multivendor { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] base [dict get $pathinfo base] vendor $vendor] |
||||
} |
||||
} |
||||
dict for {vendor pathinfolist} $found_paths_shellproject { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] base [dict get $pathinfo base] vendor $vendor] |
||||
} |
||||
} |
||||
|
||||
dict for {vendor pathinfolist} $found_paths_currentproject_multivendor { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] vendor $vendor] |
||||
} |
||||
} |
||||
dict for {vendor pathinfolist} $found_paths_currentproject { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] vendor $vendor] |
||||
} |
||||
} |
||||
dict for {vendor pathinfolist} $found_paths_absolute { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] base [dict get $pathinfo base] vendor $vendor] |
||||
} |
||||
} |
||||
#adhoc paths relative to cwd (or specified -startdir) can override any |
||||
dict for {vendor pathinfolist} $found_paths_adhoc { |
||||
foreach pathinfo $pathinfolist { |
||||
dict set folderdict [dict get $pathinfo path] [list source [dict get $pathinfo pkg] sourcetype package pathtype [dict get $pathinfo pathtype] vendor $vendor] |
||||
} |
||||
} |
||||
return $folderdict |
||||
} |
||||
lappend ${class_ns}::PUNKARGS [list { |
||||
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts" |
||||
@cmd -name "punk::cap::handlers::templates::class::api get_itemdict_projectlayouts " -help\ |
||||
"" |
||||
@opts -any true |
||||
#peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here |
||||
-startdir -default "" |
||||
@values -maxvalues -1 -unnamed true |
||||
}] |
||||
method get_itemdict_projectlayouts {args} { |
||||
|
||||
set argd [punk::args::parse $args withid "[self class] get_itemdict_projectlayouts"] |
||||
|
||||
set opt_startdir [dict get $argd opts -startdir] |
||||
|
||||
if {$opt_startdir eq ""} { |
||||
set searchbase [pwd] |
||||
} else { |
||||
set searchbase $opt_startdir |
||||
} |
||||
|
||||
set refdict [my get_itemdict_projectlayoutrefs {*}$args] |
||||
set layoutdict [dict create] |
||||
|
||||
#set projectinfo [punk::repo::find_repos $searchbase] |
||||
#set projectroot [dict get $projectinfo closest] |
||||
set projectroot [punk::repo::find_project $searchbase] |
||||
|
||||
dict for {layoutname refinfo} $refdict { |
||||
set templatepathtype [dict get $refinfo sourceinfo pathtype] |
||||
set sourceinfo [dict get $refinfo sourceinfo] |
||||
set path [dict get $refinfo path] |
||||
set reftail [file tail $path] |
||||
#layout refs are fauxlink files: <alias>#<encodedtarget>.fauxlink|.fxlnk |
||||
#target is relative to <projectroot>/src/project_layouts |
||||
# e.g project#vendor+punk+project-0.1.fauxlink |
||||
#an @ within a target segment is literal fauxlink content (derived-layout folder names such as othersample@sample-0.1) |
||||
#unresolvable refs were already skipped (with a warning) by get_itemdict_projectlayoutrefs |
||||
set targetpath [dict get [fauxlink::resolve $reftail] targetpath] |
||||
if {[dict exists $refinfo sourceinfo base]} { |
||||
#some template pathtypes refer to the projectroot from the template - not the cwd |
||||
set ref_projectroot [dict get $refinfo sourceinfo base] |
||||
} else { |
||||
set ref_projectroot $projectroot |
||||
} |
||||
|
||||
if {$ref_projectroot ne ""} { |
||||
set layoutroot [file join $ref_projectroot src/project_layouts] |
||||
set layoutfolder [file join $layoutroot $targetpath] |
||||
if {[file isdirectory $layoutfolder]} { |
||||
#todo - check if layoutname already in layoutdict append .ref path to list of refs that linked to this layout? |
||||
set layoutinfo [list path $layoutfolder basefolder $layoutroot sourceinfo $sourceinfo] |
||||
dict set layoutdict $layoutname $layoutinfo |
||||
} |
||||
} |
||||
} |
||||
return $layoutdict |
||||
} |
||||
lappend ${class_ns}::PUNKARGS [list { |
||||
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayoutrefs" |
||||
@cmd -name "punk::cap::handlers::templates::class::api get_itemdict_projectlayoutrefs " -help\ |
||||
"" |
||||
@opts -arbitrary true |
||||
@values -maxvalues -1 -unnamed 1 |
||||
}] |
||||
method get_itemdict_projectlayoutrefs {args} { |
||||
#layout refs are fauxlink files: <alias>#<encodedtarget>.fauxlink|.fxlnk (target relative to <projectroot>/src/project_layouts) |
||||
set config { |
||||
-templatefolder_subdir "layout_refs"\ |
||||
-command_get_items_from_base {apply {{base} { |
||||
set matched_files [glob -nocomplain -dir $base -type f {*#*.fauxlink} {*#*.fxlnk}] |
||||
set items [list] |
||||
foreach rf $matched_files { |
||||
set ftail [file tail $rf] |
||||
if {[string match ignore* $ftail]} { |
||||
continue |
||||
} |
||||
if {[string index $ftail 0] eq "#"} { |
||||
#alias-less ref: punkcheck-based tooling treats leading-# filenames as hidden/aside, |
||||
#so such a ref would silently vanish from punkcheck-driven installs of the containing tree. |
||||
puts stderr "punk::cap::handlers::templates get_itemdict_projectlayoutrefs WARNING - skipping layout ref '$rf' - layout refs must carry a non-empty nominal name (leading-# filenames are excluded by punkcheck-based tooling)" |
||||
continue |
||||
} |
||||
#only accept refs whose encoded target is rooted at vendor or custom (within src/project_layouts) |
||||
if {!([string match {*#vendor+*} $ftail] || [string match {*#custom+*} $ftail])} { |
||||
continue |
||||
} |
||||
if {[catch {fauxlink::resolve $ftail} resolve_result]} { |
||||
puts stderr "punk::cap::handlers::templates get_itemdict_projectlayoutrefs WARNING - skipping unresolvable layout ref '$rf' ($resolve_result)" |
||||
continue |
||||
} |
||||
lappend items $rf |
||||
} |
||||
return $items |
||||
}}}\ |
||||
-command_get_item_name {apply {{vendor basefolder itempath} { |
||||
set itemname [dict get [fauxlink::resolve [file tail $itempath]] name] |
||||
if {$vendor ne "_project"} { |
||||
set itemname $vendor.$itemname |
||||
} |
||||
return $itemname |
||||
}}} |
||||
} |
||||
set arglist [concat $config $args] |
||||
my _get_itemdict {*}$arglist |
||||
} |
||||
method get_itemdict_scriptappwrappers {args} { |
||||
set config { |
||||
-templatefolder_subdir "utility/scriptappwrappers"\ |
||||
-command_get_items_from_base {apply {{base} { |
||||
|
||||
set matched_files [punk::path::treefilenames -dir $base *] |
||||
set wrappers [list] |
||||
foreach tf $matched_files { |
||||
if {[string match ignore* $tf]} { |
||||
continue |
||||
} |
||||
set ext [file extension $tf] |
||||
if {[string tolower $ext] in [list "" ".bat" ".cmd" ".sh" ".bash" ".pl" ".ps1" ".tcl"]} { |
||||
lappend wrappers $tf |
||||
} |
||||
} |
||||
return $wrappers |
||||
}}}\ |
||||
-command_get_item_name {apply {{vendor basefolder itempath} { |
||||
|
||||
set relativepath [punk::path::relative $basefolder $itempath] |
||||
set ftail [file tail $itempath] |
||||
set tname $relativepath |
||||
if {$vendor ne "_project"} { |
||||
set tname ${vendor}.$tname |
||||
} |
||||
return $tname |
||||
}}} |
||||
} |
||||
set arglist [concat $config $args] |
||||
my _get_itemdict {*}$arglist |
||||
} |
||||
method get_itemdict_moduletemplates {args} { |
||||
set config { |
||||
-templatefolder_subdir "modules"\ |
||||
-command_get_items_from_base {apply {{base} { |
||||
|
||||
set matched_files [punk::path::treefilenames -dir $base template_*.tm] |
||||
set tfiles [list] |
||||
foreach tf $matched_files { |
||||
if {[string match ignore* $tf]} { |
||||
continue |
||||
} |
||||
set ext [file extension $tf] |
||||
if {[string tolower $ext] in [list ".tm"]} { |
||||
#we will ignore any .tm files that don't have versions that tcl understands - but warn |
||||
#this reduces the cases we have to test later |
||||
set fname [file tail $tf] |
||||
lassign [split [punk::mix::util::split_modulename_version $fname]] mname ver |
||||
if {[catch {punk::mix::cli::lib::validate_modulename $mname} errM]} { |
||||
puts stderr "Invalid module name/version $tf - please rename with standard Tcl .tm module name and version (or leave out version)" |
||||
if {[string match *-* $mname]} { |
||||
puts stderr "Tcl module name cannot contain dash character - except between name and version" |
||||
} |
||||
} else { |
||||
lappend tfiles $tf |
||||
} |
||||
} |
||||
} |
||||
return $tfiles |
||||
|
||||
}}}\ |
||||
-command_get_item_name {apply {{vendor basefolder itempath} { |
||||
|
||||
set relativepath [punk::path::relative $basefolder $itempath] |
||||
set dirs [file dirname $relativepath] |
||||
if {$dirs eq "."} { |
||||
set dirs "" |
||||
} |
||||
set moduleprefix [join $dirs ::] |
||||
set ftail [file rootname [file tail $itempath]] |
||||
set tname [string range $ftail [string length template_] end] |
||||
if {$moduleprefix ne ""} { |
||||
set tname ${moduleprefix}::$tname |
||||
} |
||||
if {$vendor ne "_project"} { |
||||
set tname ${vendor}.$tname |
||||
} |
||||
return $tname |
||||
}}} |
||||
} |
||||
set arglist [concat $config $args] |
||||
my _get_itemdict {*}$arglist |
||||
} |
||||
|
||||
lappend ${class_ns}::PUNKARGS [list { |
||||
@id -id "::punk::cap::handlers::templates::class::api _get_itemdict" |
||||
@cmd -name _get_itemdict |
||||
@opts -anyopts 0 |
||||
-startdir -default "" |
||||
-templatefolder_subdir -optional 0 |
||||
-command_get_items_from_base -optional 0 |
||||
-command_get_item_name -optional 0 |
||||
-not -default "" -multiple 1 |
||||
@values -maxvalues -1 |
||||
globsearches -default * -multiple 1 |
||||
}] |
||||
|
||||
#shared algorithm for get_itemdict_* methods |
||||
#requires a -templatefolder_subdir indicating a directory within each template base folder in which to search |
||||
#and a file selection mechanism command -command_get_items_from_base |
||||
#and a name determining command -command_get_item_name |
||||
method _get_itemdict {args} { |
||||
set argd [punk::args::parse $args withid "[self class] _get_itemdict"] |
||||
|
||||
set opts [dict get $argd opts] |
||||
set globsearches [dict get $argd values globsearches]; #note that in this case our globsearch won't reduce the machine's effort in scannning the filesystem - as we need to search on the renamed results |
||||
#puts stderr "=-=============>globsearches:$globsearches" |
||||
# -- --- --- --- --- --- --- --- --- |
||||
set opt_startdir [dict get $opts -startdir] |
||||
set opt_templatefolder_subdir [dict get $opts -templatefolder_subdir] |
||||
if {[file pathtype $opt_templatefolder_subdir] ne "relative"} { |
||||
error templates::_get_itemdict |
||||
} |
||||
# -- --- --- --- --- --- --- --- --- |
||||
set opt_command_get_items_from_base [dict get $opts -command_get_items_from_base] |
||||
set opt_command_get_item_name [dict get $opts -command_get_item_name] |
||||
set opt_not [dict get $opts -not] |
||||
# -- --- --- --- --- --- --- --- --- |
||||
set itembases [list] |
||||
#set tbasedict [punk::mix::base::lib::get_template_basefolders $opt_startdir] |
||||
set tbasedict [my folders -startdir $opt_startdir ] |
||||
#turn the dict into a list we can temporarily reverse sort while we expand the items from within each path |
||||
dict for {tbase folderinfo} $tbasedict { |
||||
lappend itembases [list basefolder [file join $tbase $opt_templatefolder_subdir] sourceinfo $folderinfo] |
||||
} |
||||
|
||||
set items [list] |
||||
set itemdict [dict create] |
||||
set seen_dict [dict create] |
||||
|
||||
#flip the priority order for layout folders encountered so we can set the trailing #<int> dup/overridden indicators |
||||
foreach baseinfo [lreverse $itembases] { |
||||
set basefolder [dict get $baseinfo basefolder] |
||||
set sourceinfo [dict get $baseinfo sourceinfo] |
||||
set vendor [dict get $sourceinfo vendor] |
||||
#call the custom script from our caller which determines resultset of files we are interested in |
||||
set matches [{*}$opt_command_get_items_from_base $basefolder] |
||||
set items_here [dict create] ;#maintain a list keyed on name for sorting within this base only |
||||
foreach itempath $matches { |
||||
set itemname [{*}$opt_command_get_item_name $vendor $basefolder $itempath] |
||||
dict set items_here $itemname [list item $itempath baseinfo $baseinfo] |
||||
#lappend items [list item $itempath baseinfo $baseinfo] |
||||
} |
||||
set ordered_names [lsort [dict keys $items_here]] |
||||
#add to the outer items list |
||||
foreach nm $ordered_names { |
||||
set iteminfo [dict get $items_here $nm] |
||||
lappend items [list originalname $nm iteminfo $iteminfo] |
||||
} |
||||
} |
||||
|
||||
#append #n instance/duplicate name indicators based on cyling through entire list of found items |
||||
foreach itemrecord $items { |
||||
set oname [dict get $itemrecord originalname] |
||||
set iteminfo [dict get $itemrecord iteminfo] |
||||
set itempath [dict get $iteminfo item] |
||||
set baseinfo [dict get $iteminfo baseinfo] |
||||
if {![dict exists $seen_dict $oname]} { |
||||
dict set seen_dict $oname 1 |
||||
dict set itemdict $oname [list path $itempath {*}$baseinfo] ; #first seen of oname gets no number |
||||
} else { |
||||
set n [dict get $seen_dict $oname] |
||||
incr n |
||||
dict incr seen_dict $oname |
||||
dict set itemdict ${oname}#$n [list path $itempath {*}$baseinfo] |
||||
} |
||||
} |
||||
|
||||
#assertion path is first key of itemdict {callers are allowed to rely on it being first} |
||||
#assertion itemdict has keys path,basefolder,sourceinfo |
||||
set result [dict create] |
||||
set keys [lreverse [dict keys $itemdict]] |
||||
foreach k $keys { |
||||
set maybe "" |
||||
foreach g $globsearches { |
||||
if {[string match $g $k]} { |
||||
set maybe $k |
||||
break |
||||
} |
||||
} |
||||
set not "" |
||||
if {$maybe ne ""} { |
||||
foreach n $opt_not { |
||||
if {[string match $n $k]} { |
||||
set not $k |
||||
break |
||||
} |
||||
} |
||||
} |
||||
if {$maybe ne "" && $not eq ""} { |
||||
dict set result $k [dict get $itemdict $k] |
||||
} |
||||
|
||||
} |
||||
return $result |
||||
} |
||||
} |
||||
} |
||||
|
||||
|
||||
|
||||
} |
||||
|
||||
namespace eval ::punk::args::register { |
||||
#use fully qualified so 8.6 doesn't find existing var in global namespace |
||||
lappend ::punk::args::register::NAMESPACES ::punk::cap::handlers::templates ::punk::cap::handlers::templates::class |
||||
} |
||||
|
||||
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
||||
## Ready |
||||
package provide punk::cap::handlers::templates [namespace eval punk::cap::handlers::templates { |
||||
variable pkg punk::cap::handlers::templates |
||||
variable version |
||||
set version 0.2.0 |
||||
}] |
||||
return |
||||
Loading…
Reference in new issue