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.
415 lines
18 KiB
415 lines
18 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::mix::commandset::module 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
##e.g package require frobz |
|
|
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
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 [templates_dict {*}$args] |
|
|
|
package require overtype |
|
set paths [dict values $tdict] |
|
set names [dict keys $tdict] |
|
|
|
set title1 "Path" |
|
set widest1 [tcl::mathfunc::max {*}[lmap v [concat [list $title1] $paths] {punk::strlen $v}]] |
|
set col1 [string repeat " " $widest1] |
|
|
|
set title2 "Template Name" |
|
set widest2 [tcl::mathfunc::max {*}[lmap v [concat [list $title2] $names] {punk::strlen $v}]] |
|
set col2 [string repeat " " $widest2] |
|
|
|
set tablewidth [expr {$widest1 + 1 + $widest2}] |
|
set table "" |
|
append table [string repeat - $tablewidth] \n |
|
append table "[overtype::left $col1 $title1] [overtype::left $col2 $title2]" \n |
|
append table [string repeat - $tablewidth] \n |
|
|
|
foreach p $paths n $names { |
|
append table "[overtype::left $col1 $p] [overtype::left $col2 $n]" \n |
|
} |
|
|
|
return $table |
|
} |
|
proc templates_dict {args} { |
|
tailcall lib::templates_dict {*}$args |
|
} |
|
proc new {module args} { |
|
set year [clock format [clock seconds] -format %Y] |
|
set defaults [list\ |
|
-project \uFFFF\ |
|
-version \uFFFF\ |
|
-license <unspecified>\ |
|
-template module-0.0.1.tm\ |
|
-type \uFFFF\ |
|
-force 0\ |
|
] |
|
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 "\uFFFF"} { |
|
set opt_version "0.1.0" |
|
} else { |
|
set opt_version $opt_version_supplied |
|
if {![util::is_valid_tm_version $opt_version]} { |
|
error "pmix 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 "pmix 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 "\uFFFF"} { |
|
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 -name_description "mix module.new name" |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
#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 [punkc::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] |
|
set lib_tpldir [file join [punk::mix::cli::lib::mix_templates_dir] module];#fallback for modulename_buildversion.txt, modulename_description.txt |
|
set templates_dict [templates_dict] |
|
#todo - allow versionless name - pick latest which isn't suffixed with .2 etc |
|
if {![dict exists $templates_dict $opt_template]} { |
|
error "module.new unable to find template '$opt_template'. Known templates: [dict keys $templates_dict]" |
|
} |
|
set templatefile [dict get $templates_dict $opt_template] |
|
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 "\uFFFF"} { |
|
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 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 template_filedata [string map [list %pkg% $modulename %year% $year %license% $opt_license %version% $infile_version] $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 { |
|
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] *]" |
|
} |
|
} |
|
|
|
|
|
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 { |
|
proc templates_dict {args} { |
|
set defaults [list -scriptpath ""] |
|
set opts [dict merge $defaults $args] |
|
set opt_scriptpath [dict get $opts -scriptpath] |
|
|
|
set module_template_bases [list] |
|
set tbasedict [punk::mix::base::lib::get_template_basefolders $opt_scriptpath] |
|
dict for {tbase folderinfo} $tbasedict { |
|
lappend module_template_bases [file join $tbase modules] |
|
} |
|
|
|
|
|
|
|
set template_files [list] |
|
foreach basefld $module_template_bases { |
|
set matched_files [glob -nocomplain -dir $basefld -type f template_*] |
|
foreach tf $matched_files { |
|
if {[string match ignore* $tf]} { |
|
continue |
|
} |
|
set ext [file extension $tf] |
|
if {$ext in [list ".tm"]} { |
|
lappend template_files $tf |
|
} |
|
} |
|
} |
|
|
|
set tdict [dict create] |
|
set seen_dict [dict create] |
|
foreach fullpath $template_files { |
|
set ftail [file tail $fullpath] |
|
set tname [string range $ftail [string length template_] end] |
|
if {![dict exists $seen_dict $tname]} { |
|
dict set seen_dict $tname 1 |
|
dict set tdict $tname $fullpath ; #first seen of filename gets no number |
|
} else { |
|
set n [dict get $seen_dict $tname] |
|
incr n |
|
dict incr seen_dict $tname |
|
dict set tdict ${tname}.$n $fullpath |
|
} |
|
} |
|
return $tdict |
|
} |
|
} |
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punk::mix::commandset::module [namespace eval punk::mix::commandset::module { |
|
variable version |
|
set version 999999.0a1.0 |
|
}] |
|
return
|
|
|