# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck 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::mix::commandset::module 999999.0a1.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
package require punk::repo
# depends on punk,punk::mix::base,punk::mix::cli
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::commandset::module {
namespace export *
proc paths {} {
set roots [punk::repo::find_repos ""]
set project [lindex [dict get $roots project] 0]
if {$project ne ""} {
set is_project 1
set searchbase $project
} else {
set is_project 0
set searchbase [pwd]
}
if {[catch {
set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $searchbase]
} errMsg]} {
set source_module_folderlist [list]
}
set tm_folders [tcl::tm::list]
package require overtype
set result ""
if {$is_project} {
append result "Project module source paths:" \n
foreach f $source_module_folderlist {
append result "$f" \n
}
}
append result \n
append result "tcl::tm::list" \n
foreach f $tm_folders {
if {$is_project} {
if {[punk::mix::cli::lib::path_a_aboveorat_b $project $f]} {
set pinfo "(within project)"
} else {
set pinfo ""
}
} else {
set pinfo ""
}
set warning ""
if {![file isdirectory $f]} {
set warning "(PATH NOT FOUND)"
}
append result "$f $pinfo $warning" \n
}
return $result
}
#require current dir when calling to be the projectdir, or
proc templates {args} {
set tdict_low_to_high [templates_dict {*}$args]
#convert to screen order - with higher priority at the top
set tdict [dict create]
foreach k [lreverse [dict keys $tdict_low_to_high]] {
dict set tdict $k [dict get $tdict_low_to_high $k]
}
package require overtype
package require textblock
#set pathinfolist [dict values $tdict]
#set paths [lsearch -all -inline -index 1 -subindices $pathinfolist *] ;#relies on first key of templates_dict being path
set names [dict keys $tdict]
set paths [list]
set pathtypes [list]
dict for {nm tinfo} $tdict {
lappend paths [dict get $tinfo path]
lappend pathtypes [dict get $tinfo sourceinfo pathtype]
}
set title(path) "Path"
set widest(path) [tcl::mathfunc::max {*}[lmap v [concat [list $title(path)] $paths] {punk::strlen $v}]]
set col(path) [string repeat " " $widest(path)]
set title(pathtype) "[a+ green]Path Type[a]"
set widest(pathtype) [tcl::mathfunc::max {*}[lmap v [concat [list $title(pathtype)] $pathtypes] {string length $v}]]
set col(pathtype) [string repeat " " $widest(pathtype)]
set title(name) "Template Name"
set widest(name) [tcl::mathfunc::max {*}[lmap v [concat [list $title(name)] $names] {string length $v}]]
set col(name) [string repeat " " $widest(name)]
set tablewidth [expr {$widest(name) + 1 + $widest(pathtype) + 1 + $widest(name)}]
set table ""
append table [string repeat - $tablewidth] \n
append table "[textblock::join [overtype::left $col(name) $title(name)] " " [overtype::left $col(pathtype) $title(pathtype)] " " [overtype::left $col(path) $title(path)]]" \n
append table [string repeat - $tablewidth] \n
foreach n $names pt $pathtypes p $paths {
append table "[overtype::left $col(name) $n] [overtype::left $col(pathtype) $pt] [overtype::left $col(path) $p]" \n
}
return $table
}
#return all module templates with repeated ones suffixed with .2 .3 etc
proc templates_dict {args} {
set argspec {
*proc -name templates_dict -help "Templates from module and project paths"
-startdir -default "" -help "Project folder used in addition to module paths"
-not -default "" -multiple 1
*values
globsearches -default * -multiple 1
}
set argd [punk::args::get_dict $argspec $args]
package require punk::cap
if {[punk::cap::capability_has_handler punk.templates]} {
set template_folder_dict [punk::cap::call_handler punk.templates get_itemdict_moduletemplates {*}$args]
} else {
put stderr "get_template_basefolders WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations"
}
}
proc new {args} {
set year [clock format [clock seconds] -format %Y]
set moduletypes [punk::mix::cli::lib::module_types]
# use \uFFFD because unicode replacement char should consistently render as 1 wide
set argspecs [subst {
-project -default \uFFFD
-version -default \uFFFD
-license -default <unspecified>
-template -default punk.module
-type -default \uFFFD -choices {$moduletypes}
-force -default 0 -type boolean
-quiet -default 0 -type boolean
*values -min 1 -max 1
module -type string
}]
set argd [punk::args::get_dict $argspecs $args]
lassign [dict values $argd] opts values
set module [dict get $values module]
#set opts [dict merge $defaults $args]
#todo - review compatibility between -template and -type
#-type is the wrapping technology e.g 'plain' for none or tarjar/zipkit etc (consider also snappy/snappy-tcl)
#-template may be a folder - but only if the selected -type suports it
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
# option -version
# we need this value before looking at the named argument
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_version_supplied [dict get $opts -version]
if {$opt_version_supplied eq "\uFFFD"} {
set opt_version "0.1.0"
} else {
set opt_version $opt_version_supplied
if {![util::is_valid_tm_version $opt_version]} {
error "deck module.new error - supplied -version $opt_version doesn't appear to be a valid Tcl module version"
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#named argument
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set mversion_supplied "" ;#version supplied directly in module argument
if {[string first - $module]> 0} {
#if it has a dash then version is required to be valid
lassign [punk::mix::cli::lib::split_modulename_version $module] modulename mversion
if {![util::is_valid_tm_version $mversion]} {
error "deck module.new error - unable to determine modulename-version from supplied value '$module'"
}
set mversion_supplied $mversion ;#record as may need to compare to version from templatefile name
set vcompare_is_mversion_bigger [package vcompare $mversion $opt_version]
if {$vcompare_is_mversion_bigger > 0} {
set opt_version $mversion; #module parameter has higher value than -version
set vmsg "from module argument: $module"
} else {
set vmsg "from -version option: $opt_version_supplied"
}
if {$opt_version_supplied ne "\uFFFD"} {
if {$vcompare_is_mversion_bigger != 0} {
#is bigger or smaller
puts stderr "module.new WARNING: version supplied in module argument as well as -version option. Using the higher version number $vmsg"
}
}
} else {
set modulename $module
}
punk::mix::cli::lib::validate_modulename $modulename -errorprefix "punk::mix::commandset::module::new"
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
#options
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_project [dict get $opts -project]
set testdir [pwd]
if {![string length [set projectdir [punk::repo::find_project $testdir]]]} {
if {![string length [set projectdir [punk::repo::find_candidate $testdir]]]} {
set msg [punk::repo::is_candidate_root_requirements_msg]
error "module.new unable to create module in projectdir:$projectdir - directory doesn't appear to meet basic standards $msg"
}
}
if {$opt_project == "\uFFFF"} {
set projectname [file tail $projectdir]
} else {
set projectname $opt_project
if {$projectname ne [file tail $projectdir]} {
error "module.new -project '$opt_project' doesn't match detected projectname '$projectname' at path: $projectdir"
}
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_license [dict get $opts -license]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_template [dict get $opts -template]
if {[regexp {.*[?*].*} $opt_template]} {
error "module.new -template does not support glob chars. Use an exact full name including version (and optionally .tm) - or use just the name without version or .tm, and the latest version will be selected"
}
set templates_dict [templates_dict] ;#keys are possibly prefixed with <vendor>. and/or suffixed with #2 #3 etc if there are collisions - the remaining unsuffixed being the one with highest preference
#todo - allow versionless name - pick latest which isn't suffixed with #2 etc
#if the user wants to exactly match an unversioned template, in the presence of versioned ones - they may need to include the trailing .tm
if {[dict exists $templates_dict $opt_template]} {
#exact long name (possibly including version)
#Note - an unversioned .tm template will be matched here - even though versioned templates of the same name may exist.
set templatefile [dict get $templates_dict $opt_template path]
set templatefile_info [dict get $templates_dict $opt_template sourceinfo]
} else {
#if it wasn't an exact match for opt_template - then opt_template now shouldn't contain a version (we have also ruled out glob chars * & ? above)
#(if it does - then we just won't find anything - which is fine)
#module file name could contain dots - but only one dash - if it is versioned
set matches [lsearch -all -inline [dict keys $templates_dict] $opt_template-*] ;#the key is of form vendor.modulename-version(#suffix) (version optional, suffix if lower precedence with same name was found)
#only .tm (or .TM .Tm .tM) files make it into the templates_dict - they are allowed to be unversioned though.
set key_version_list [list]
foreach m $matches {
#vendorname could contain dashes or dots - so easiest way to split out is to examine the stored vendor value in sourceinfo
set vendor [dict get $templates_dict $m sourceinfo vendor]
if {$vendor ne "_project"} {
#_project special case - not included in module names
set module $m
} else {
set module [string range [string length $vendor.] end]
}
lassign [punk::mix::cli::lib::split_modulename_version $m] _tailmname mversion
lappend key_version_list [list $m $mversion]
}
if {[llength $matches]} {
set highest_m ""
set highest_v ""
foreach kv $key_version_list {
if {$highest_v eq ""} {
set highest_m [lindex $kv 0]
set highest_v [lindex $kv 1]
} else {
if {[package vcompare $highest_v [lindex $kv 1]] == -1} {
set highest_m [lindex $kv 0]
set highest_v [lindex $kv 1]
}
}
}
set templatefile [dict get $templates_dict $highest_m path]
set templatefile_info [dict get $templates_dict $highest_m sourceinfo]
} else {
error "module.new unable to find template '$opt_template'. [dict size $templates_dict] Known templates. Use deck module.templates to display"
}
}
set tpldir [file dirname $templatefile] ;#use same folder for modulename_buildversion.txt, modulename_description.txt if they exist
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_type [dict get $opts -type]
if {$opt_type eq "\uFFFD"} {
set opt_type [lindex [punk::mix::cli::lib::module_types] 0] ;#default to plain
}
if {$opt_type ni [punk::mix::cli::lib::module_types]} {
error "module.new - error - unknown -type '$opt_type' known-types: [punk::mix::cli::lib::module_types]"
}
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set opt_quiet [dict get $opts -quiet]
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- ---
set subpath [punk::mix::cli::lib::module_subpath $modulename] ;#commonly empty string for simple modulename e.g "mymodule" but x::mymodule has subpath 'x' and x::y::mymodule has subpath 'x/y'
if {![string length $subpath]} {
set modulefolder $projectdir/src/modules
} else {
set modulefolder $projectdir/src/modules/$subpath
}
file mkdir $modulefolder
set moduletail [namespace tail $modulename]
set magicversion [punk::mix::util::magic_tm_version] ;#deliberately large so given load-preference when testing
set template_tail [file tail $templatefile] ;#convert template_xxx-version.tm.x to {xxx version}
set template_tail [string range $template_tail [string length template_] end]
set ext [string tolower [file extension $template_tail]]
if {$ext eq ".tm"} {
set template_modulename_part [file rootname $template_tail]
} elseif {[string is integer -strict [string range $ext 1 end]]} {
#something like modulename-0.0.1.tm.2
#strip of last 2 dotted parts
set shortened [file rootname $template_tail]
if {![string equal -nocase [file extension $shortened] ".tm"]} {
error "module.new error: Unable to interpret filename components of template file '$templatefile' (expected .tm as second-last or last component)"
}
set template_modulename_part [file rootname $shortened]
} else {
error "module.new error: Unable to interpret filename components of template file '$templatefile'"
}
lassign [punk::mix::cli::lib::split_modulename_version $template_modulename_part] t_mname t_version
#t_version may be empty string if template is unversioned e.g template_whatever.tm
set fd [open $templatefile r]; set template_filedata [read $fd]; close $fd
if {[string match "*$magicversion*" $template_filedata]} {
set use_magic 1
set build_version $opt_version
set infile_version $magicversion
} else {
set use_magic 0
if {$opt_version_supplied ne "\uFFFF"} {
set build_version $opt_version
} else {
#
if {[util::is_valid_tm_version $t_version]} {
if {$mversion_supplied eq ""} {
set build_version $t_version
} else {
#we have a version from the named argument 'module'
if {[package vcompare $mversion_supplied $t_version] > 0} {
set build_version $mversion_supplied
} else {
set build_version $t_version
}
}
} else {
#probably an unversioned module template
#use opt_version default from above
set build_version $opt_version
}
}
set infile_version $build_version
}
set moduletemplate [file join $projectname [punk::path::relative $projectdir $templatefile]] ;#if templatfile is on another volume - just $templatefile will be returned.
#moduletemplate should usually be a relative path - but could be absolute, or contain info about the relative locations of projectdir vs templatefile if template comes from another project or a module outside the project
#This path info may be undesired in the template output (%moduletemplate%)
#it is nevertheless useful information - and not the only way developer-machine/build-machine paths can leak
#for now the user has the option to override any templates and remove %moduletemplate% if it is a security/privacy concern
#Don't put literal %x% in the code for the commandset::module itself - to stop them being seen by layout scanner as replacable tokens
set tagnames [list moduletemplate $moduletemplate project $projectname pkg $modulename year $year license $opt_license version $infile_version]
set strmap [list]
foreach {tag val} $tagnames {
lappend strmap %$tag% $val
}
set template_filedata [string map $strmap $template_filedata]
set modulefile $modulefolder/${moduletail}-$infile_version.tm
if {[file exists $modulefile]} {
set errmsg "module.new error: module file $modulefile already exists - aborting"
if {[string match "*$magicversion*" $modulefile]} {
append errmsg \n "If you are attempting to create a module file with a specific version in the source-file name - you will need to use a template that doesn't contain the string '$magicversion' e.g the provided template moduleexactversion-0.0.1.tm"
}
error $errmsg
}
if {[file exists $tpldir/modulename_buildversion.txt]} {
set fd [open $tpldir/modulename_buildversion.txt r]; set buildversion_filedata [read $fd]; close $fd
} else {
#mix_templates_dir warns of deprecation - review
set lib_tpldir [file join [punk::mix::cli::lib::mix_templates_dir] modules];#fallback for modulename_buildversion.txt, modulename_description.txt
set fd [open $lib_tpldir/modulename_buildversion.txt r]; set buildversion_filedata [read $fd]; close $fd
}
set buildversionfile [file join $modulefolder ${moduletail}-buildversion.txt]
set existing_build_version ""
if {[file exists $buildversionfile]} {
set buildversiondata [punk::mix::util::fcat $buildversionfile]
set lines [split $buildversiondata \n]
set existing_build_version [string trim [lindex $lines 0]]
if {[package vcompare $existing_build_version $build_version] >= 0} {
#existing version in -buildversion.txt file is lower than the module version we are creating
error "module.new error: there is an existing buildversion file $buildversionfile with version $existing_build_version equal to or higher than $build_version - unable to continue"
}
}
set existing_versions [glob -nocomplain -dir $modulefolder -tails ${moduletail}-*.tm]
#it shouldn't be possible to overmatch with the glob - because '-' is not valid in a Tcl module name
if {[llength $existing_versions]} {
set name_version_pairs [list]
lappend name_version_pairs [list $moduletail $infile_version]
foreach existing $existing_versions {
lappend name_version_pairs [punk::mix::cli::lib::split_modulename_version $existing] ;# .tm is stripped and ignored
}
set name_version_pairs [lsort -command {package vcompare} -index 1 $name_version_pairs] ;#while plain lsort will often work with versions - it can get order wrong with some - so use package vcompare
if {[lindex $name_version_pairs end] ne [list $moduletail $infile_version]} {
set thisposn [lsearch -index 1 $name_version_pairs $infile_version]
set name_version_pairs [lreplace $name_version_pairs $thisposn $thisposn]
set other_versions [lsearch -all -inline -index 1 -subindices $name_version_pairs *]
set errmsg "module.new error: There are existing modules in the target folder with higher versions than $infile_version."
append errmsg \n "Other versions found: $other_versions"
if {$magicversion in $other_versions} {
append errmsg \n "Existing build version for special source file name: '$magicversion' is: '$existing_build_version'"
append errmsg \n "If '$magicversion' file doesn't represent the latest source it should be removed or the filename and contents adjusted to be a specific version"
}
error $errmsg
} else {
puts stderr "module.new WARNING: There are existing modules in the target folder with lower versions than $infile_version - manual review recommended"
puts stderr "Other versions found: [lsearch -all -inline -index 1 -subindices [lrange $name_version_pairs 0 end-1] *]"
}
}
if {!$opt_quiet} {
puts stdout "Creating $modulefile from template $moduletemplate"
}
set fd [open $modulefile w]
fconfigure $fd -translation binary
puts -nonewline $fd $template_filedata
close $fd
set buildversion_filedata [string map [list %Major.Minor.Level% $build_version] $buildversion_filedata]
set fd [open $buildversionfile w]
fconfigure $fd -translation binary
puts -nonewline $fd $buildversion_filedata
close $fd
return [list file $modulefile version $build_version]
}
namespace eval lib {
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::mix::commandset::module [namespace eval punk::mix::commandset::module {
variable version
set version 999999.0a1.0
}]
return