# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -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 # @@ 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 {![file exists $tmfile]} { 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] set projectbase [dict get $projectinfo closest] #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 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 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] #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 ?args? # -- --- --- --- --- --- --- namespace export * namespace eval class { 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} { set argd [punk::args::get_dict { -startdir -default "" *values -max 0 } $args] 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 } } 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 { *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] 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 projectroot [dict get $refinfo sourceinfo projectbase] } if {$projectroot ne ""} { set layoutroot [file join $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 { *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 # -- --- --- --- --- --- --- --- --- 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 # 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 } } } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## 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