You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
794 lines
48 KiB
794 lines
48 KiB
# -*- 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 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
##e.g package require frobz |
|
|
|
package require punk::repo |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#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 projectbase 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* paths are relative to cwd - so no projectbase information can be stored at registration time. |
|
#not all template item types will need projectbase 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 { |
|
set provide_statement [package ifneeded $pkg [package require $pkg]] |
|
set tmfile [lindex $provide_statement end] |
|
if {[interp issafe]} { |
|
#default safe interp can't use file exists/normalize etc.. but safe interp may have a policy/alias set allowing file access to certain paths - so test if file exists is usable |
|
if {[catch {file exists $tmfile} tm_exists]} { |
|
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING (expected in most safe interps) - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" |
|
flush stderr |
|
return 0 |
|
} |
|
} else { |
|
set tm_exists [file exists $tmfile] |
|
} |
|
if {!$tm_exists} { |
|
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability" |
|
flush stderr |
|
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" |
|
} |
|
set tmfolder [file dirname $tmfile] |
|
#todo - handle wrapped or unwrapped tarjar files - in which case we have to adjust tmfolder appropriately |
|
#set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder |
|
|
|
#set projectinfo [punk::repo::find_repos $tmfolder] ;#slow - REVIEW |
|
#set projectbase [dict get $projectinfo closest] |
|
set projectbase [punk::repo::find_project $tmfolder] |
|
|
|
#store the projectbase even if it's empty string |
|
set extended_capdict $capdict |
|
set resolved_path [file join $tmfolder $path] |
|
dict set extended_capdict resolved_path $resolved_path |
|
dict set extended_capdict projectbase $projectbase |
|
} |
|
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 projectinfo [punk::repo::find_repos $shellbase] |
|
#set projectbase [dict get $projectinfo closest] |
|
set projectbase [punk::repo::find_project $shellbase] |
|
|
|
set extended_capdict $capdict |
|
dict set extended_capdict vendor $vendor |
|
dict set extended_capdict projectbase $projectbase |
|
} |
|
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 projectinfo [punk::repo::find_repos $shellbase] |
|
#set projectbase [dict get $projectinfo closest] |
|
set projectbase [punk::repo::find_project $shellbase] |
|
|
|
set extended_capdict $capdict |
|
dict set extended_capdict vendor $vendor |
|
dict set extended_capdict projectbase $projectbase |
|
} |
|
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 |
|
} |
|
#set projectinfo [punk::repo::find_repos $normpath] |
|
#set projectbase [dict get $projectinfo closest] |
|
set projectbase [punk::repo::find_project $normpath] |
|
|
|
#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 projectbase $projectbase |
|
} |
|
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] || $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 |
|
#set argd [punk::args::get_dict { |
|
# @id -id "::punk::cap::handlers::templates::class::api folders" |
|
# -startdir -default "" |
|
# @values -max 0 |
|
#} $args] |
|
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 |
|
} |
|
method folders {args} { |
|
#puts "--folders $args" |
|
set argd [punk::args::parse $args withid "::punk::cap::handlers::templates::class::api 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] |
|
# projectbase 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] |
|
} |
|
} elseif {$pathtype eq "module"} { |
|
set module_projectroot [dict get $capdecl_extended projectbase] |
|
dict lappend found_paths_module $vendor [list pkg $pkg path [dict get $capdecl_extended resolved_path] pathtype $pathtype projectbase $module_projectroot] |
|
} 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] |
|
} |
|
} |
|
if {[file isdirectory [file join $vendorbase _project]]} { |
|
dict lappend found_paths_currentproject_multivendor _project [list pkg $pkg path [file join $vendorbase _project] pathtype $pathtype] |
|
} |
|
} |
|
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] |
|
} |
|
} |
|
if {[file isdirectory [file join $custombase _project]]} { |
|
dict lappend found_paths_currentproject_multivendor _project [list pkg $pkg path [file join $custombase _project] pathtype $pathtype] |
|
} |
|
} |
|
} |
|
} 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] |
|
} |
|
} |
|
} 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 projectbase] |
|
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 projectbase $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 projectbase $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 projectbase $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 projectbase $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 projectbase] |
|
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 projectbase $shell_projectroot] |
|
} |
|
} |
|
} elseif {$pathtype eq "absolute"} { |
|
#lappend found_paths [dict get $capdecl_extended resolved_path] |
|
set abs_projectroot [dict get $capdecl_extended projectbase] |
|
dict lappend found_paths_absolute $vendor [list pkg $pkg path [dict get $capdecl_extended resolved_path] pathtype $pathtype projectbase $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] projectbase [dict get $pathinfo projectbase] 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] projectbase [dict get $pathinfo projectbase] 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] projectbase [dict get $pathinfo projectbase] 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] projectbase [dict get $pathinfo projectbase] 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 |
|
} |
|
method get_itemdict_projectlayouts {args} { |
|
set argd [punk::args::get_dict { |
|
@id -id "::punk::cap::handlers::templates::class::api get_itemdict_projectlayouts" |
|
@opts -anyopts 1 |
|
#peek -startdir while allowing all other opts/vals to be verified down-the-line instead of here |
|
-startdir -default "" |
|
@values -maxvalues -1 |
|
} $args] |
|
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] |
|
set atparts [split [file rootname $reftail] @] |
|
#may be two @s if referencing a renamed layout override? |
|
# e.g ref may be @vendor+punks+othersample@sample-0.1 or layoutalias-1.1@vendor+punk+othersample@sample-0.1 |
|
#there must always be an @ before vendor or custom . There is either a template-name alias or empty string before this first @ |
|
#trim off first @ part |
|
set tailats [join [lrange $atparts 1 end] @] |
|
# @ parts after the first are part of the path within the project_layouts structure |
|
set subpathlist [split $tailats +] |
|
if {[dict exists $refinfo sourceinfo projectbase]} { |
|
#some template pathtypes refer to the projectroot from the template - not the cwd |
|
set ref_projectroot [dict get $refinfo sourceinfo projectbase] |
|
} else { |
|
set ref_projectroot $projectroot |
|
} |
|
|
|
if {$ref_projectroot ne ""} { |
|
set layoutroot [file join $ref_projectroot src/project_layouts] |
|
set layoutfolder [file join $layoutroot {*}$subpathlist] |
|
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 |
|
} |
|
method get_itemdict_projectlayoutrefs {args} { |
|
set config { |
|
-templatefolder_subdir "layout_refs"\ |
|
-command_get_items_from_base {apply {{base} { |
|
set matched_files [glob -nocomplain -dir $base -type f *@*.ref] |
|
set items [list] |
|
foreach rf $matched_files { |
|
#puts stderr "--> $rf" |
|
if {[string match ignore* $rf]} { |
|
continue |
|
} |
|
#we silently skip .ref files that don't match - todo - more verification - and warn of invalid .refs? |
|
if {[string match *@vendor+* $rf] || [string match *@custom+* $rf]} { |
|
lappend items $rf |
|
} |
|
} |
|
return $items |
|
}}}\ |
|
-command_get_item_name {apply {{vendor basefolder itempath} { |
|
set itemtail [file rootname [file tail $itempath]] |
|
set alias [lindex [split $itemtail @] 0] |
|
if {$alias eq ""} { |
|
set itemname [lindex [split $itemtail +] end] |
|
} else { |
|
set itemname $alias |
|
} |
|
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::cli::lib::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 |
|
} |
|
|
|
#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::get_dict { |
|
@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 |
|
} $args] |
|
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 999999.0a1.0 |
|
}] |
|
return |