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.
1214 lines
60 KiB
1214 lines
60 KiB
# -*- 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::cli 999999.0a1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
##e.g package require frobz |
|
package require punk::repo |
|
package require punk::ansi |
|
package require punkcheck ;#checksum and/or timestamp records |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#review |
|
#deck - rename to dev |
|
namespace eval punk::mix::cli { |
|
namespace eval temp_import { |
|
} |
|
namespace ensemble create |
|
variable initialised 0 |
|
|
|
#lazy _init - called by punk::mix::base::_cli when ensemble used |
|
proc _init {args} { |
|
variable initialised |
|
if {$initialised} { |
|
return |
|
} |
|
puts stderr "punk::mix::cli::init $args" |
|
package require punk::overlay |
|
namespace eval ::punk::mix::cli { |
|
catch { |
|
punk::overlay::import_commandset module . ::punk::mix::commandset::module |
|
} |
|
punk::overlay::import_commandset debug . ::punk::mix::commandset::debug |
|
punk::overlay::import_commandset repo . ::punk::mix::commandset::repo |
|
punk::overlay::import_commandset lib . ::punk::mix::commandset::loadedlib |
|
|
|
catch { |
|
package require punk::mix::commandset::project |
|
punk::overlay::import_commandset project . ::punk::mix::commandset::project |
|
punk::overlay::import_commandset projects . ::punk::mix::commandset::project::collection |
|
} |
|
if {[catch { |
|
package require punk::mix::commandset::layout |
|
punk::overlay::import_commandset project.layout . ::punk::mix::commandset::layout |
|
punk::overlay::import_commandset project.layouts . ::punk::mix::commandset::layout::collection |
|
} errM]} { |
|
puts stderr "error loading punk::mix::commandset::layout" |
|
puts stderr $errM |
|
} |
|
if {[catch { |
|
package require punk::mix::commandset::buildsuite |
|
punk::overlay::import_commandset buildsuite . ::punk::mix::commandset::buildsuite |
|
punk::overlay::import_commandset buildsuites . ::punk::mix::commandset::buildsuite::collection |
|
} errM]} { |
|
puts stderr "error loading punk::mix::commandset::buildsuite" |
|
puts stderr $errM |
|
} |
|
punk::overlay::import_commandset scriptwrap . ::punk::mix::commandset::scriptwrap |
|
if {[catch { |
|
package require punk::mix::commandset::doc |
|
punk::overlay::import_commandset doc . ::punk::mix::commandset::doc |
|
punk::overlay::import_commandset "" "" ::punk::mix::commandset::doc::collection |
|
} errM]} { |
|
puts stderr "error loading punk::mix::commandset::doc" |
|
puts stderr $errM |
|
} |
|
} |
|
set initialised 1 |
|
} |
|
|
|
proc help {args} { |
|
#set basehelp [punk::mix::base::help -extension [namespace current] {*}$args] |
|
set basehelp [punk::mix::base help {*}$args] |
|
#puts stdout "punk::mix help" |
|
return $basehelp |
|
} |
|
|
|
proc stat {{workingdir ""} args} { |
|
dict set args -v 0 |
|
punk::mix::cli::lib::get_status $workingdir {*}$args |
|
} |
|
proc status {{workingdir ""} args} { |
|
dict set args -v 1 |
|
punk::mix::cli::lib::get_status $workingdir {*}$args |
|
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
namespace eval punk::mix::cli { |
|
|
|
|
|
#interp alias {} ::punk::mix::cli::project.new {} ::punk::mix::cli::new |
|
|
|
|
|
proc make {args} { |
|
set startdir [pwd] |
|
set project_base "" ;#empty for unknown |
|
if {[punk::repo::is_git $startdir]} { |
|
set project_base [punk::repo::find_git] |
|
set sourcefolder $project_base/src |
|
} elseif {[punk::repo::is_fossil $startdir]} { |
|
set project_base [punk::repo::find_fossil] |
|
set sourcefolder $project_base/src |
|
} else { |
|
if {[punk::repo::is_candidate $startdir]} { |
|
set project_base [punk::repo::find_candidate] |
|
set sourcefolder $project_base/src |
|
puts stderr "WARNING - project not under git or fossil control" |
|
puts stderr "Using base folder $project_base" |
|
} else { |
|
set sourcefolder $startdir |
|
} |
|
} |
|
|
|
#review - why can't we be anywhere in the project? |
|
#also - if no make.tcl - can we use the running shell's make.tcl ? (after prompting user?) |
|
if {([file tail $sourcefolder] ne "src") || (![file exists $sourcefolder/make.tcl])} { |
|
puts stderr "dev make must be run from src folder containing make.tcl - unable to proceed (cwd: [pwd])" |
|
if {[string length $project_base]} { |
|
if {[file exists $project_base/src] && [string tolower [pwd]] ne [string tolower $project_base/src]} { |
|
puts stderr "Try cd to $project_base/src" |
|
} |
|
} else { |
|
if {[file exists $startdir/Makefile]} { |
|
puts stdout "A Makefile exists at $startdir/Makefile." |
|
if {"windows" eq $::tcl_platform(platform)} { |
|
puts stdout "Try running: msys2 -ucrt64 -here -c \"make build\" or bash -c \"make build\"" |
|
} else { |
|
puts stdout "Try runing: make build" |
|
} |
|
} |
|
} |
|
return false |
|
} |
|
|
|
if {![string length $project_base]} { |
|
puts stderr "WARNING no git or fossil repository detected." |
|
puts stderr "Using base folder $startdir" |
|
set project_base $startdir |
|
} |
|
|
|
set lc_this_exe [string tolower [info nameofexecutable]] |
|
set lc_proj_bin [string tolower $project_base/bin] |
|
set lc_build_bin [string tolower $project_base/src/_build] |
|
|
|
if {"project" in $args} { |
|
set is_own_exe 0 |
|
if {[string match "${lc_proj_bin}*" $lc_this_exe] || [string match "${lc_build_bin}" $lc_this_exe]} { |
|
set is_own_exe 1 |
|
puts stderr "WARNING - running make using executable that may be created by the project being built" |
|
set answer [util::askuser "Do you want to proceed using this executable? (build will probably stop when it is unable to update the executable) Y|N"] |
|
if {[string tolower $answer] ne "y"} { |
|
puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompts." |
|
return |
|
} |
|
} |
|
} |
|
cd $sourcefolder |
|
#use run so that stdout visible as it goes |
|
if {![catch {run --timeout=55000 -debug [info nameofexecutable] $sourcefolder/make.tcl {*}$args} exitinfo]} { |
|
#todo - notify if exit because of timeout! |
|
puts stderr "exitinfo: $exitinfo" |
|
set exitcode [dict get $exitinfo exitcode] |
|
} else { |
|
puts stderr "Error unable to determine exitcode. err: $exitinfo" |
|
cd $startdir |
|
return false |
|
} |
|
|
|
cd $startdir |
|
if {$exitcode != 0} { |
|
puts stderr "FAILED with exitcode $exitcode" |
|
return false |
|
} else { |
|
puts stdout "OK make finished " |
|
return true |
|
} |
|
} |
|
|
|
proc Kettle {args} { |
|
tailcall lib::kettle_call lib {*}$args |
|
} |
|
proc KettleShell {args} { |
|
tailcall lib::kettle_call shell {*}$args |
|
} |
|
|
|
|
|
|
|
namespace eval lib { |
|
namespace path ::punk::mix::util |
|
|
|
|
|
proc module_types {} { |
|
#first in list is default for unspecified -type when creating new module |
|
#return [list plain tarjar zipkit] |
|
return [list plain tarjar zip] |
|
} |
|
|
|
proc validate_modulename {modulename args} { |
|
set opts [list\ |
|
-errorprefix validate_modulename\ |
|
-strict 0\ |
|
] |
|
if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} |
|
foreach {k v} $args { |
|
switch -- $k { |
|
-errorprefix - -strict { |
|
dict set opts $k $v |
|
} |
|
default { |
|
error "validate_modulename error: unknown option '$k'. known options: [dict keys $opts]" |
|
} |
|
} |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_errorprefix [dict get $opts -errorprefix] |
|
set opt_strict [dict get $opts -strict] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
if {$opt_strict} { |
|
if {[regexp {[A-Z]} $modulename]} { |
|
error "$opt_errorprefix '$modulename' contains uppercase which is not recommended as per tip 590, and option -strict is set to 1" |
|
} |
|
} |
|
|
|
validate_name_not_empty_or_spaced $modulename -errorprefix $opt_errorprefix |
|
set testname [string map {:: {}} $modulename] |
|
if {[string first : $testname] >=0} { |
|
error "$opt_errorprefix '$modulename' can only contain paired colons" |
|
} |
|
set badchars [list - "$" "?" "*"] |
|
foreach bc $badchars { |
|
if {[string first $bc $modulename] >= 0} { |
|
error "$opt_errorprefix '$modulename' can not contain character '$bc'" |
|
} |
|
} |
|
return $modulename |
|
} |
|
proc confirm_modulename {modulename} { |
|
set finalised 0 |
|
set aborted 0 |
|
while {!$finalised && !$aborted} { |
|
#first validate with -strict 0 to confirm acceptable while ignoring case issues. |
|
#uppercase is generally valid but not recommended - so has separate prompting. |
|
if {[catch {validate_modulename $modulename -strict 0} errM]} { |
|
set msg "Chosen name didn't pass validation\n" |
|
append msg "reason: $errM\n" |
|
append msg "Please retype the modulename. You will be given a further prompt to confirm or abort." |
|
set modulename [util::askuser $msg] |
|
} elseif {[regexp {[A-Z]} $modulename]} { |
|
set msg "module names containing uppercase are not recommended (see tip 590).\n" |
|
append msg "Please retype the module name '$modulename' to proceed.\n" |
|
append msg "If you type it exactly as it was you will be allowed to proceed with uppercase anyway\n" |
|
append msg "Retype it all in lowercase to use recommended naming" |
|
set answer [util::askuser $msg] |
|
if {[regexp {[A-Z]} $answer]} { |
|
if {$answer eq $modulename} { |
|
#ok - user insists |
|
set finalised 1 |
|
} else { |
|
#user supplied a different uppercase name - don't set finalised so we bug them again to type it two times the same way to proceed |
|
puts stdout "A different uppercase name was supplied - reconfirmation required." |
|
} |
|
set modulename $answer |
|
} else { |
|
#user has resupplied modulename all as lowercase |
|
if {$answer eq [string tolower $modulename]} { |
|
set finalised 1 |
|
} else { |
|
#.. but it doesn't match original - require rerun |
|
} |
|
set modulename $answer |
|
} |
|
} else { |
|
set answer [util::askuser "Proceed with the module name '$modulename'? Y to continue N to abort"] |
|
if {[string tolower $answer] eq "y"} { |
|
set finalised 1 |
|
} else { |
|
set aborted 1 |
|
} |
|
} |
|
} |
|
if {$aborted} { |
|
return [dict create status error reason errmsg] |
|
} else { |
|
return [dict create status ok modulename $modulename] |
|
} |
|
} |
|
|
|
proc validate_projectname {projectname args} { |
|
set defaults [list\ |
|
-errorprefix projectname\ |
|
] |
|
if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} |
|
set known_opts [dict keys $defaults] |
|
foreach k [dict keys $args] { |
|
if {$k ni $known_opts} { |
|
error "validate_modulename error: unknown option $k. known options: $known_opts" |
|
} |
|
} |
|
set opts [dict merge $defaults $args] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_errorprefix [dict get $opts -errorprefix] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
validate_name_not_empty_or_spaced $projectname -errorprefix $opt_errorprefix |
|
set reserved_words [list etc lib bin modules src doc vendorlib vendormodules embedded runtime _aside _build] |
|
if {$projectname in $reserved_words } { |
|
error "$opt_errorprefix '$projectname' cannot be one of reserved_words: $reserved_words" |
|
} |
|
if {[string first "::" $projectname] >= 0} { |
|
error "$opt_errorprefix '$projectname' cannot contain namespace separator '::'" |
|
} |
|
return $projectname |
|
} |
|
proc validate_name_not_empty_or_spaced {name args} { |
|
set opts [list\ |
|
-errorprefix projectname\ |
|
] |
|
if {[llength $args] %2 != 0} {error "validate_name_not_empty_or_spaced args must be name-value pairs: received '$args'"} |
|
foreach {k v} $args { |
|
switch -- $k { |
|
-errorprefix { |
|
dict set opts $k $v |
|
} |
|
default { |
|
error "validate_name_not_empty_or_spaced error: unknown option $k. known options: [dict keys $opts]" |
|
} |
|
} |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_errorprefix [dict get $opts -errorprefix] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
if {![string length $name]} { |
|
error "$opt_errorprefix cannot be empty" |
|
} |
|
if {[string length [string map [list " " "" \n "" \r "" \t ""] $name]] != [string length $name]} { |
|
error "$opt_errorprefix cannot contain whitespace" |
|
} |
|
return $name |
|
} |
|
|
|
#split modulename (as present in a filename or namespaced name) into name/version ignoring leading namespace path |
|
#ignore trailing .tm .TM if present |
|
#if version doesn't pass validation - treat it as part of the modulename and return empty version string without error |
|
#Up to caller to validate. |
|
proc split_modulename_version {modulename} { |
|
set lastpart [namespace tail $modulename] |
|
set lastpart [file tail $lastpart] ;# should be ok to use file tail now that we've ensured no namespace components |
|
if {[string equal -nocase [file extension $modulename] ".tm"]} { |
|
set fileparts [split [file rootname $lastpart] -] |
|
} else { |
|
set fileparts [split $lastpart -] |
|
} |
|
if {[punk::mix::util::is_valid_tm_version [lindex $fileparts end]]} { |
|
set versionsegment [lindex $fileparts end] |
|
set namesegment [join [lrange $fileparts 0 end-1] -];#re-stitch |
|
} else { |
|
# |
|
set namesegment [join $fileparts -] |
|
set versionsegment "" |
|
} |
|
return [list $namesegment $versionsegment] |
|
} |
|
|
|
proc get_status {{workingdir ""} args} { |
|
set result "" |
|
if {$workingdir ne ""} { |
|
if {[file pathtype $workingdir] ne "absolute"} { |
|
set workingdir [file normalize $workingdir] |
|
} |
|
set active_dir $workingdir |
|
} else { |
|
set active_dir [pwd] |
|
} |
|
set defaults [dict create\ |
|
-v 1\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
# -- --- --- --- --- --- --- --- --- |
|
set opt_v [dict get $opts -v] |
|
# -- --- --- --- --- --- --- --- --- |
|
|
|
|
|
set repopaths [punk::repo::find_repos [pwd]] |
|
set repos [dict get $repopaths repos] |
|
if {![llength $repos]} { |
|
append result [dict get $repopaths warnings] |
|
} else { |
|
append result [dict get $repopaths warnings] |
|
lassign [lindex $repos 0] repopath repotypes |
|
if {"fossil" in $repotypes} { |
|
#review - multiple process launches to fossil a bit slow on windows.. |
|
#could we query global db in one go instead? |
|
# |
|
set fossil_prog [auto_execok fossil] |
|
append result "FOSSIL project based at $repopath with revision: [punk::repo::fossil_revision $repopath]" \n |
|
set fosinfo [exec {*}$fossil_prog info] |
|
append result [join [punk::repo::grep {repository:*} $fosinfo] \n] \n |
|
|
|
set fosrem [exec {*}$fossil_prog remote ls] |
|
if {[string length $fosrem]} { |
|
append result "Remotes:\n" |
|
append result " " $fosrem \n |
|
} |
|
|
|
|
|
append result [join [punk::repo::grep {tags:*} $fosinfo] \n] \n |
|
|
|
set dbinfo [exec {*}$fossil_prog dbstat] |
|
append result [join [punk::repo::grep {project-name:*} $dbinfo] \n] \n |
|
append result [join [punk::repo::grep {tickets:*} $dbinfo] \n] \n |
|
append result [join [punk::repo::grep {project-age:*} $dbinfo] \n] \n |
|
append result [join [punk::repo::grep {latest-change:*} $dbinfo] \n] \n |
|
append result [join [punk::repo::grep {files:*} $dbinfo] \n] \n |
|
append result [join [punk::repo::grep {check-ins:*} $dbinfo] \n] \n |
|
if {"project" in $repotypes} { |
|
#punk project |
|
if {![catch {package require textblock; package require patternpunk}]} { |
|
set result [textblock::join -- [>punk . logo] " " $result] |
|
append result \n |
|
} |
|
} |
|
|
|
set timeline [exec fossil timeline -n 5 -t ci] |
|
set timeline [string map {\r\n \n} $timeline] |
|
append result $timeline |
|
if {$opt_v} { |
|
set repostate [punk::repo::workingdir_state $repopath -repopaths $repopaths -repotypes fossil] |
|
append result \n [punk::repo::workingdir_state_summary $repostate] |
|
} |
|
|
|
} |
|
#repotypes *could* be both git and fossil - so report both if so |
|
if {"git" in $repotypes} { |
|
append result "GIT project based at $repopath with revision: [punk::repo::git_revision $repopath]" \n |
|
if {[string length [set git_prog [auto_execok git]]]} { |
|
set git_remotes [exec {*}$git_prog remote -v] |
|
append result $git_remotes |
|
if {$opt_v} { |
|
set repostate [punk::repo::workingdir_state $repopath -repopaths $repopaths -repotypes git] |
|
append result \n [punk::repo::workingdir_state_summary $repostate] |
|
} |
|
} |
|
} |
|
|
|
} |
|
|
|
return $result |
|
} |
|
|
|
|
|
proc build_modules_from_source_to_base {srcdir basedir args} { |
|
set antidir [list "#*" "_build" "_aside" ".git" ".fossil*"] ;#exact or glob patterns for folders (at any level) we don't want to search in or copy. |
|
set defaults [list\ |
|
-installer punk::mix::cli::build_modules_from_source_to_base\ |
|
-call-depth-internal 0\ |
|
-max_depth 1000\ |
|
-subdirlist {}\ |
|
-punkcheck_eventobj "\uFFFF"\ |
|
-glob *.tm\ |
|
-podglob #modpod-*\ |
|
] |
|
set opts [dict merge $defaults $args] |
|
|
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set installername [dict get $opts -installer] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set CALLDEPTH [dict get $opts -call-depth-internal] |
|
set max_depth [dict get $opts -max_depth] |
|
set subdirlist [dict get $opts -subdirlist] |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set fileglob [dict get $opts -glob] |
|
set podglob [dict get $opts -podglob] |
|
if {![string match "*.tm" $fileglob]} { |
|
error "build_modules_from_source_to_base -glob '$fileglob' doesn't seem to target tcl modules." |
|
} |
|
# -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- |
|
set opt_punkcheck_eventobj [dict get $opts -punkcheck_eventobj] |
|
|
|
set magicversion [punk::mix::util::magic_tm_version] ;#deliberately large so given load-preference when testing |
|
set module_list [list] |
|
|
|
if {[file tail [file dirname $srcdir]] ne "src"} { |
|
puts stderr "ERROR build_modules_from_source_to_base can only be called with a srcdir that is a subfolder of your 'src' directory" |
|
puts stderr "The .tm modules are namespaced based on their directory depth - so we need to start at the root" |
|
puts stderr "To build a subtree of your modules - use an appropriate src/modules folder and pass in the -subdirlist." |
|
puts stderr "e.g if your modules are based at /x/src/modules2 and you wish to build only the .tm files at /x/src/modules2/skunkworks/lib" |
|
puts stderr "Use: >build_modules_from_source_to_base /x/src/modules2 /x/modules2 -subdirlist {skunkworks lib}" |
|
exit 2 |
|
} |
|
set srcdirname [file tail $srcdir] |
|
|
|
set build [file dirname $srcdir]/_build/$srcdirname ;#relative to *original* srcdir - not current_source_dir |
|
if {[llength $subdirlist] == 0} { |
|
set target_module_dir $basedir |
|
set current_source_dir $srcdir |
|
} else { |
|
set target_module_dir $basedir/[file join {*}$subdirlist] |
|
set current_source_dir $srcdir/[file join {*}$subdirlist] |
|
} |
|
if {![file exists $target_module_dir]} { |
|
error "build_modules_from_source_to_base from current source dir: '$current_source_dir'. Basedir:'$current_module_dir' doesn't exist or is empty" |
|
} |
|
if {![file exists $current_source_dir]} { |
|
error "build_modules_from_source_to_base from current source dir:'$current_source_dir' doesn't exist or is empty" |
|
} |
|
|
|
#---------------------------------------- |
|
set punkcheck_file [file join $basedir/.punkcheck] |
|
if {$CALLDEPTH == 0} { |
|
|
|
set config [dict create\ |
|
-glob $fileglob\ |
|
-max_depth 0\ |
|
] |
|
#lassign [punkcheck::start_installer_event $punkcheck_file $installername $srcdir $basedir $config] _eventid punkcheck_eventid _recordset record_list |
|
# -- --- |
|
set installer [punkcheck::installtrack new $installername $punkcheck_file] |
|
$installer set_source_target $srcdir $basedir |
|
set event [$installer start_event $config] |
|
# -- --- |
|
|
|
} else { |
|
set event $opt_punkcheck_eventobj |
|
} |
|
#---------------------------------------- |
|
|
|
|
|
set process_modules [dict create] |
|
#put pods first in processing order |
|
set src_pods [glob -nocomplain -dir $current_source_dir -type d -tail $podglob] |
|
foreach podpath $src_pods { |
|
dict set process_modules $podpath [dict create -type pod] |
|
} |
|
set src_modules [glob -nocomplain -dir $current_source_dir -type f -tail $fileglob] |
|
foreach modulepath $src_modules { |
|
dict set process_modules $modulepath [dict create -type file] |
|
} |
|
|
|
set did_skip 0 ;#flag for stdout/stderr formatting only |
|
dict for {modpath modinfo} $process_modules { |
|
set modtype [dict get $modinfo -type] |
|
|
|
set is_interesting 0 |
|
if {[string match "foobar" $current_source_dir]} { |
|
set is_interesting 1 |
|
} |
|
if {$is_interesting} { |
|
puts "build_modules_from_source_to_base >>> module $current_source_dir/$modpath" |
|
} |
|
set fileparts [split [file rootname $modpath] -] |
|
#set tmfile_versionsegment [lindex $fileparts end] |
|
lassign [split_modulename_version $modpath] basename tmfile_versionsegment |
|
if {$tmfile_versionsegment eq ""} { |
|
#split_modulename_version version part will be empty if not valid tcl version |
|
#last segment doesn't look even slightly versiony - fail. |
|
puts stderr "ERROR: Unable to confirm file $current_source_dir/$modpath is a reasonably versioned .tm module - ABORTING." |
|
exit 1 |
|
} |
|
switch -- $modtype { |
|
pod { |
|
#basename still contains leading #modpod- |
|
if {[string match #modpod-* $basename]} { |
|
set basename [string range $basename 8 end] |
|
} else { |
|
error "build_modules_from_source_to_base, pod, unexpected basename $basename" ;#shouldn't be possible with default podglob - review - why is podglob configurable? |
|
} |
|
set versionfile $current_source_dir/$basename-buildversion.txt ;#needs to be added in targetset_addsource to trigger rebuild if changed (only when magicversion in use) |
|
if {$tmfile_versionsegment eq $magicversion} { |
|
set versionfiledata "" |
|
if {![file exists $versionfile]} { |
|
puts stderr "\nWARNING: Missing buildversion text file: $versionfile" |
|
puts stderr "Using version 0.1 - create $versionfile containing the desired version number as the top line to avoid this warning\n" |
|
set module_build_version "0.1" |
|
} else { |
|
set fd [open $versionfile r] |
|
set versionfiledata [read $fd]; close $fd |
|
set ln0 [lindex [split $versionfiledata \n] 0] |
|
set ln0 [string trim $ln0]; set ln0 [string trim $ln0 \r] |
|
if {![util::is_valid_tm_version $ln0]} { |
|
puts stderr "ERROR: build version '$ln0' specified in $versionfile is not suitable. Please ensure a proper version number is at first line of file" |
|
exit 3 |
|
} |
|
set module_build_version $ln0 |
|
} |
|
} else { |
|
set module_build_version $tmfile_versionsegment |
|
} |
|
|
|
set buildfolder $current_source_dir/_build |
|
file mkdir $buildfolder |
|
# -- --- |
|
set config [dict create\ |
|
-glob *\ |
|
-max_depth 100\ |
|
] |
|
set had_error 0 |
|
|
|
# -max_depth -1 for no limit |
|
set build_installername pods_in_$current_source_dir |
|
set build_installer [punkcheck::installtrack new $build_installername $buildfolder/.punkcheck] |
|
$build_installer set_source_target $current_source_dir/$modpath $buildfolder |
|
set build_event [$build_installer start_event $config] |
|
# -- --- |
|
set podtree_copy $buildfolder/#modpod-$basename-$module_build_version |
|
set modulefile $buildfolder/$basename-$module_build_version.tm |
|
|
|
|
|
$build_event targetset_init INSTALL $podtree_copy |
|
$build_event targetset_addsource $current_source_dir/$modpath |
|
if {$tmfile_versionsegment eq $magicversion} { |
|
$build_event targetset_addsource $versionfile |
|
} |
|
if {\ |
|
[llength [dict get [$build_event targetset_source_changes] changed]]\ |
|
|| [llength [$build_event get_targets_exist]] < [llength [$build_event get_targets]]\ |
|
} { |
|
$build_event targetset_started |
|
if {$did_skip} {set did_skip 0; puts -nonewline stdout \n} |
|
|
|
set delete_failed 0 |
|
if {[file exists $buildfolder/]} { |
|
puts stderr "deleting existing _build copy at $podtree_copy" |
|
if {[catch { |
|
file delete -force $podtree_copy |
|
} errMsg]} { |
|
puts stderr "[punk::ansi::a+ red]deletion of _build copy at $podtree_copy failed: $errMsg[punk::ansi::a]" |
|
set delete_failed 1 |
|
} |
|
} |
|
if {!$delete_failed} { |
|
puts stdout "copying.." |
|
puts stdout "$current_source_dir/$modpath" |
|
puts stdout "to:" |
|
puts stdout "$podtree_copy" |
|
file copy $current_source_dir/$modpath $podtree_copy |
|
if {$tmfile_versionsegment eq $magicversion} { |
|
set tmfile $buildfolder/#modpod-$basename-$module_build_version/$basename-$magicversion.tm |
|
if {[file exists $tmfile]} { |
|
set newname $buildfolder/#modpod-$basename-$module_build_version/$basename-$module_build_version.tm |
|
file rename $tmfile $newname |
|
set tmfile $newname |
|
} |
|
set fd [open $tmfile r]; fconfigure $fd -translation binary; set data [read $fd]; close $fd |
|
set data [string map [list $magicversion $module_build_version] $data] |
|
set fdout [open $tmfile w] |
|
fconfigure $fdout -translation binary |
|
puts -nonewline $fdout $data |
|
close $fdout |
|
} |
|
#delete and regenerate zip and modpod stubbed zip |
|
set notes [list] |
|
if {[catch { |
|
file delete $buildfolder/$basename-$module_build_version.zip |
|
} err] } { |
|
set had_error 1 |
|
lappend notes "zip_delete_failed" |
|
} |
|
if {[catch { |
|
file delete $buildfolder/$basename-$module_build_version.tm |
|
} err]} { |
|
set had_error 1 |
|
lappend notes "tm_delete_failed" |
|
} |
|
#create ordinary zip file without using external executable |
|
package require punk::zip |
|
set zipfile $buildfolder/$basename-$module_build_version.zip ;#ordinary zip file (deflate) |
|
|
|
#zipfs mkzip does exactly what we need anyway in this case |
|
#unfortunately it's not available in all Tclsh versions we might be running.. |
|
if {[llength [info commands zipfs]]} { |
|
#zipfs mkzip (2025) doesn't add entries for folders. |
|
#(Therefore no timestamps) |
|
#zip reading utils generally intuit their existence and display them - but often an editor can't add comments to them |
|
set wd [pwd] |
|
cd $buildfolder |
|
puts "zipfs mkzip $zipfile #modpod-$basename-$module_build_version" |
|
zipfs mkzip $zipfile #modpod-$basename-$module_build_version |
|
cd $wd |
|
|
|
} else { |
|
#use -base $buildfolder so that -directory is included in the archive - the modpod stub relies on this - and extraction would be potentially messy otherwise |
|
#put in an archive-level comment to aid in debugging |
|
#punk |
|
punk::zip::mkzip -base $buildfolder -directory $buildfolder/#modpod-$basename-$module_build_version -- $zipfile * |
|
#punk::zip::mkzip stores permissions - (unix style) - which zipfs mkzip doesn't |
|
#Directory ident in zipfs relies on folders ending with trailing slash - if missing, it misidentifies dirs as files. |
|
#(ie it can't use permissions/attributes alone to determine directory vs file) |
|
#TODO - review punk::zip::mkzip and/or external zip to provide a fallback? |
|
#JMN25 |
|
|
|
#set had_error 1 |
|
#lappend notes "zipfs_unavailable" |
|
#puts stderr "WARNING: zipfs unavailable can't build $modulefile" |
|
} |
|
if {!$had_error && [file exists $zipfile]} { |
|
package require modpod |
|
modpod::lib::make_zip_modpod $zipfile $modulefile |
|
} |
|
|
|
|
|
if {$had_error} { |
|
$build_event targetset_end FAILED -note [join $notes ,] |
|
} else { |
|
# -- ---------- |
|
$build_event targetset_end OK |
|
# -- ---------- |
|
} |
|
} else { |
|
$build_event targetset_end FAILED -note "could not delete $podtree_copy" |
|
} |
|
|
|
} else { |
|
puts -nonewline stderr "." |
|
set did_skip 1 |
|
#set file_record [punkcheck::installfile_skipped_install $basedir $file_record] |
|
$build_event targetset_end SKIPPED |
|
} |
|
$build_event destroy |
|
$build_installer destroy |
|
|
|
#JMN - review |
|
if {!$had_error} { |
|
$event targetset_init INSTALL $target_module_dir/$basename-$module_build_version.tm |
|
$event targetset_addsource $modulefile |
|
if {\ |
|
[llength [dict get [$event targetset_source_changes] changed]]\ |
|
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]]\ |
|
} { |
|
|
|
$event targetset_started |
|
# -- --- --- --- --- --- |
|
if {$did_skip} {set did_skip 0; puts -nonewline stdout \n} |
|
lappend module_list $modulefile |
|
if {[catch { |
|
file copy -force $modulefile $target_module_dir |
|
} errMsg]} { |
|
puts stderr "FAILED to copy zip modpod module $modulefile to $target_module_dir" |
|
$event targetset_end FAILED -note "could not copy $modulefile" |
|
} else { |
|
puts stderr "Copied zip modpod module $modulefile to $target_module_dir" |
|
# -- --- --- --- --- --- |
|
$event targetset_end OK -note "zip modpod" |
|
} |
|
} else { |
|
puts -nonewline stderr "." |
|
set did_skip 1 |
|
if {$is_interesting} { |
|
puts stderr "$modulefile [$event targetset_source_changes]" |
|
} |
|
$event targetset_end SKIPPED |
|
} |
|
} |
|
} |
|
tarjar { |
|
#basename may still contain #tarjar- |
|
#to be obsoleted - update modpod to (optionally) use vfs::tar |
|
} |
|
file { |
|
set m $modpath |
|
if {$tmfile_versionsegment eq $magicversion} { |
|
#set basename [join [lrange $fileparts 0 end-1] -] |
|
set versionfile $current_source_dir/$basename-buildversion.txt |
|
set versionfiledata "" |
|
if {![file exists $versionfile]} { |
|
puts stderr "\nWARNING: Missing buildversion text file: $versionfile" |
|
puts stderr "Using version 0.1 - create $versionfile containing the desired version number as the top line to avoid this warning\n" |
|
set module_build_version "0.1" |
|
} else { |
|
set fd [open $versionfile r] |
|
set versionfiledata [read $fd]; close $fd |
|
set ln0 [lindex [split $versionfiledata \n] 0] |
|
set ln0 [string trim $ln0]; set ln0 [string trim $ln0 \r] |
|
if {![util::is_valid_tm_version $ln0]} { |
|
puts stderr "ERROR: build version '$ln0' specified in $versionfile is not suitable. Please ensure a proper version number is at first line of file" |
|
exit 3 |
|
} |
|
set module_build_version $ln0 |
|
} |
|
|
|
|
|
if {[file exists $current_source_dir/#tarjar-$basename-$magicversion]} { |
|
#rebuild the .tm from the #tarjar |
|
|
|
if {[file exists $current_source_dir/#tarjar-$basename-$magicversion/DESCRIPTION.txt]} { |
|
|
|
} else { |
|
|
|
} |
|
#REVIEW - should be in same structure/depth as $target_module_dir in _build? |
|
|
|
#TODO |
|
set buildfolder $current_sourcedir/_build |
|
file mkdir $buildfolder |
|
|
|
set tmfile $buildfolder/$basename-$module_build_version.tm |
|
file delete -force $buildfolder/#tarjar-$basename-$module_build_version |
|
file delete -force $tmfile |
|
|
|
|
|
file copy -force $current_source_dir/#tarjar-$basename-$magicversion $buildfolder/#tarjar-$basename-$module_build_version |
|
# |
|
#bsdtar doesn't seem to work.. or I haven't worked out the right options? |
|
#exec tar -cvf $buildfolder/$basename-$module_build_version.tm $buildfolder/#tarjar-$basename-$module_build_version |
|
package require tar |
|
tar::create $tmfile $buildfolder/#tarjar-$basename-$module_build_version |
|
if {![file exists $tmfile]} { |
|
puts stdout "ERROR: failed to build tarjar file $tmfile" |
|
exit 4 |
|
} |
|
#copy the file? |
|
#set target $target_module_dir/$basename-$module_build_version.tm |
|
#file copy -force $tmfile $target |
|
|
|
lappend module_list $tmfile |
|
} else { |
|
#assume that either the .tm is not a tarjar - or the tarjar dir is capped (trailing #) and the .tm has been manually tarred. |
|
if {[file exists $current_source_dir/#tarjar-$basename-${magicversion}#]} { |
|
puts stderr "\nWarning: found 'capped' folder #tarjar-$basename-${magicversion}# - No attempt being made to update version in description.txt" |
|
} |
|
|
|
#------------------------------ |
|
# |
|
#set target_relpath [punkcheck::lib::path_relative $basedir $target_module_dir/$basename-$module_build_version.tm] |
|
#set file_record [punkcheck::installfile_begin $basedir $target_relpath $installername -eventid $punkcheck_eventid] |
|
$event targetset_init INSTALL $target_module_dir/$basename-$module_build_version.tm |
|
$event targetset_addsource $versionfile |
|
$event targetset_addsource $current_source_dir/$m |
|
|
|
#set changed_list [list] |
|
## -- --- --- --- --- --- |
|
#set source_relpath [punkcheck::lib::path_relative $basedir $versionfile] |
|
#set file_record [punkcheck::installfile_add_source_and_fetch_metadata $basedir $source_relpath $file_record] |
|
## -- --- --- --- --- --- |
|
#set source_relpath [punkcheck::lib::path_relative $basedir $current_source_dir/$m] |
|
#set file_record [punkcheck::installfile_add_source_and_fetch_metadata $basedir $source_relpath $file_record] |
|
## -- --- --- --- --- --- |
|
#set changed_unchanged [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $file_record body] end]] |
|
#set changed_list [dict get $changed_unchanged changed] |
|
|
|
|
|
if {\ |
|
[llength [dict get [$event targetset_source_changes] changed]]\ |
|
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]]\ |
|
} { |
|
|
|
#set file_record [punkcheck::installfile_started_install $basedir $file_record] |
|
$event targetset_started |
|
# -- --- --- --- --- --- |
|
set target $target_module_dir/$basename-$module_build_version.tm |
|
if {$did_skip} {set did_skip 0; puts -nonewline stdout \n} |
|
puts stdout "copying module $current_source_dir/$m to $target as version: $module_build_version ([file tail $target])" |
|
set fd [open $current_source_dir/$m r]; fconfigure $fd -translation binary; set data [read $fd]; close $fd |
|
set data [string map [list $magicversion $module_build_version] $data] |
|
set fdout [open $target w] |
|
fconfigure $fdout -translation binary |
|
puts -nonewline $fdout $data |
|
close $fdout |
|
#file copy -force $srcdir/$m $target |
|
lappend module_list $target |
|
# -- --- --- --- --- --- |
|
#set file_record [punkcheck::installfile_finished_install $basedir $file_record] |
|
$event targetset_end OK |
|
} else { |
|
if {$is_interesting} { |
|
puts stdout "skipping module $current_source_dir/$m - no change in sources detected" |
|
} |
|
puts -nonewline stderr "." |
|
set did_skip 1 |
|
#set file_record [punkcheck::installfile_skipped_install $basedir $file_record] |
|
$event targetset_end SKIPPED |
|
} |
|
|
|
#------------------------------ |
|
|
|
} |
|
|
|
continue |
|
} |
|
##------------------------------ |
|
## |
|
#set target_relpath [punkcheck::lib::path_relative $basedir $target_module_dir/$m] |
|
#set file_record [punkcheck::installfile_begin $basedir $target_relpath $installername -eventid $punkcheck_eventid] |
|
#set changed_list [list] |
|
## -- --- --- --- --- --- |
|
#set source_relpath [punkcheck::lib::path_relative $basedir $current_source_dir/$m] |
|
#set file_record [punkcheck::installfile_add_source_and_fetch_metadata $basedir $source_relpath $file_record] |
|
## -- --- --- --- --- --- |
|
#set changed_unchanged [punkcheck::recordlist::file_install_record_source_changes [lindex [dict get $file_record body] end]] |
|
#set changed_list [dict get $changed_unchanged changed] |
|
#---------- |
|
$event targetset_init INSTALL $target_module_dir/$m |
|
$event targetset_addsource $current_source_dir/$m |
|
if {\ |
|
[llength [dict get [$event targetset_source_changes] changed]]\ |
|
|| [llength [$event get_targets_exist]] < [llength [$event get_targets]]\ |
|
} { |
|
|
|
#set file_record [punkcheck::installfile_started_install $basedir $file_record] |
|
$event targetset_started |
|
# -- --- --- --- --- --- |
|
if {$did_skip} {set did_skip 0; puts -nonewline stdout \n} |
|
lappend module_list $current_source_dir/$m |
|
file copy -force $current_source_dir/$m $target_module_dir |
|
puts stderr "Copied already versioned module $current_source_dir/$m to $target_module_dir" |
|
# -- --- --- --- --- --- |
|
#set file_record [punkcheck::installfile_finished_install $basedir $file_record] |
|
$event targetset_end OK -note "already versioned module" |
|
} else { |
|
puts -nonewline stderr "." |
|
set did_skip 1 |
|
if {$is_interesting} { |
|
puts stderr "$current_source_dir/$m [$event targetset_source_changes]" |
|
} |
|
#set file_record [punkcheck::installfile_skipped_install $basedir $file_record] |
|
$event targetset_end SKIPPED |
|
} |
|
} |
|
} |
|
} ;#end dict for {modpath modinfo} $process_modules |
|
|
|
|
|
if {$CALLDEPTH >= $max_depth} { |
|
set subdirs [list] |
|
} else { |
|
set subdirs [glob -nocomplain -dir $current_source_dir -type d -tail *] |
|
} |
|
#puts stderr "subdirs: $subdirs" |
|
foreach d $subdirs { |
|
set skipdir 0 |
|
foreach dg $antidir { |
|
if {[string match $dg $d]} { |
|
set skipdir 1 |
|
continue |
|
} |
|
} |
|
if {$skipdir} { |
|
continue |
|
} |
|
if {![file exists $target_module_dir/$d]} { |
|
file mkdir $target_module_dir/$d |
|
} |
|
lappend module_list {*}[build_modules_from_source_to_base $srcdir $basedir\ |
|
-call-depth-internal [expr {$CALLDEPTH +1}]\ |
|
-subdirlist [list {*}$subdirlist $d]\ |
|
-punkcheck_eventobj $event\ |
|
-glob $fileglob\ |
|
-podglob $podglob\ |
|
] |
|
} |
|
if {$did_skip} { |
|
puts -nonewline stdout \n |
|
} |
|
if {$CALLDEPTH == 0} { |
|
$event destroy |
|
$installer destroy |
|
} |
|
return $module_list |
|
} |
|
|
|
variable kettle_reset_bodies [dict create] |
|
variable kettle_reset_args [dict create] |
|
#We are abusing kettle to run in-process. |
|
# when we change to another project we need recipes to be reloaded. |
|
# Kettle rewrites some of it's own procs - stopping reloading of recipes when we change folders |
|
#kettle_init stores the original proc bodies & args |
|
proc kettle_init {} { |
|
variable kettle_reset_bodies ;#dict |
|
variable kettle_reset_args |
|
set reset_procs [list\ |
|
::kettle::benchmarks\ |
|
::kettle::doc\ |
|
::kettle::figures\ |
|
::kettle::meta::scan\ |
|
::kettle::testsuite\ |
|
] |
|
foreach p $reset_procs { |
|
set b [info body $p] |
|
if {[string match "*Overwrite self*" $b]} { |
|
dict set kettle_reset_bodies $p $b |
|
set argnames [info args $p] |
|
set arglist [list] |
|
foreach a $argnames { |
|
if {[info default $p $a dval]} { |
|
lappend arglist [list $a $dval] |
|
} else { |
|
lappend arglist $a |
|
} |
|
} |
|
dict set kettle_reset_args $p $arglist |
|
} |
|
} |
|
|
|
} |
|
#call kettle_reinit to ensure recipes point to current project |
|
proc kettle_reinit {} { |
|
variable kettle_reset_bodies |
|
variable kettle_reset_args |
|
dict for {p b} $kettle_reset_bodies { |
|
#set b [dict get $kettle_reset_bodies $p] |
|
set argl [dict get $kettle_reset_args $p] |
|
uplevel 1 [list ::proc $p $argl $b] |
|
} |
|
#todo - determine standard recipes by examining standard.tcl instead of hard coding? |
|
set standard_recipes [list\ |
|
null\ |
|
forever\ |
|
list-recipes\ |
|
help-recipes\ |
|
help-dump\ |
|
help-recipes\ |
|
help\ |
|
list\ |
|
list-options\ |
|
help-options\ |
|
show-configuration\ |
|
show-state\ |
|
show\ |
|
meta-status\ |
|
gui\ |
|
] |
|
#set ::kettle::recipe::recipe [dict create] |
|
dict for {r -} $::kettle::recipe::recipe { |
|
if {$r ni $standard_recipes} { |
|
dict unset ::kettle::recipe::recipe $r |
|
} |
|
} |
|
} |
|
proc kettle_call {calltype args} { |
|
variable kettle_reset_bodies |
|
switch -- $calltype { |
|
lib {} |
|
shell { |
|
set kettleappfile [file dirname [info nameofexecutable]]/kettle |
|
set kettlebatfile [file dirname [info nameofexecutable]]/kettle.bat |
|
|
|
if {(![file exists $kettleappfile]) && (![file exists $kettlebatfile])} { |
|
error "deck kettle_call unable to find installed kettle application file '$kettleappfile' (or '$kettlebatfile' if on windows)" |
|
} |
|
if {[file exists $kettleappfile]} { |
|
set kettlescript $kettleappfile |
|
} |
|
if {$::tcl_platform(platform) eq "windows"} { |
|
if {[file exists $kettlebatfile]} { |
|
set kettlescript $kettlebatfile |
|
} |
|
} |
|
} |
|
default { |
|
error "deck kettle_call 1st argument must be one of: 'lib' for direct use of kettle module or 'shell' to call as separate process" |
|
} |
|
} |
|
set startdir [pwd] |
|
if {![file exists $startdir/build.tcl]} { |
|
error "deck kettle must be run from a folder containing build.tcl (cwd: [pwd])" |
|
} |
|
if {[package provide kettle] eq ""} { |
|
puts stdout "Loading kettle package - may be delay on first load ..." |
|
package require kettle |
|
kettle_init ;#store original procs for those kettle procs that rewrite themselves |
|
} else { |
|
if {[dict size $kettle_reset_bodies] == 0} { |
|
#presumably package require kettle was called without calling our kettle_init hack. |
|
kettle_init |
|
} else { |
|
#undo proc rewrites |
|
kettle_reinit |
|
} |
|
} |
|
set first [lindex $args 0] |
|
if {[string match @* $first]} { |
|
error "deck kettle doesn't support special operations - try calling tclsh kettle directly" |
|
} |
|
if {$first eq "-f"} { |
|
set args [lassign $args __ path] |
|
} else { |
|
set path $startdir/build.tcl |
|
} |
|
set opts [list] |
|
|
|
if {[lindex $args 0] eq "-trace"} { |
|
set args [lrange $args 1 end] |
|
lappend opts --verbose on |
|
} |
|
set goals [list] |
|
|
|
if {$calltype eq "lib"} { |
|
file mkdir ~/.kettle |
|
set dotfile ~/.kettle/config |
|
if {[file exists $dotfile] && |
|
[file isfile $dotfile] && |
|
[file readable $dotfile]} { |
|
::kettle io trace {Loading dotfile $dotfile ...} |
|
set args [list {*}[::kettle path cat $dotfile] {*}$args] |
|
} |
|
} |
|
|
|
#hardcoded kettle option names (::kettle option names) - retrieved using kettle::option names |
|
#This is done so we don't have to load kettle lib for shell call (both loading as module and running shell are annoyingly SLOW) |
|
#REVIEW - needs to be updated to keep in sync with kettle. |
|
set knownopts [list\ |
|
--exec-prefix --bin-dir --lib-dir --prefix --man-dir --html-dir --markdown-dir --include-dir \ |
|
--ignore-glob --dry --verbose --machine --color --state --config --with-shell --log \ |
|
--log-append --log-mode --with-dia --constraints --file --limitconstraints --tmatch --notfile --single --valgrind --tskip --repeats \ |
|
--iters --collate --match --rmatch --with-doc-destination --with-git --target --test-include \ |
|
] |
|
|
|
while {[llength $args]} { |
|
set o [lindex $args 0] |
|
switch -glob -- $o { |
|
--* { |
|
#instead of using: kettle option known |
|
if {$o ni $knownopts} { |
|
error "Unable to process unknown option $o." {} [list KETTLE (deck)] |
|
} |
|
lappend opts $o [lindex $args 1] |
|
#::kettle::option set $o [lindex $args 1] |
|
set args [lrange $args 2 end] |
|
} |
|
default { |
|
lappend goals $o |
|
set args [lrange $args 1 end] |
|
} |
|
} |
|
} |
|
|
|
if {![llength $goals]} { |
|
lappend goals help |
|
} |
|
if {"--prefix" ni [dict keys $opts]} { |
|
dict set opts --prefix [file dirname $startdir] |
|
} |
|
if {$calltype eq "lib"} { |
|
::kettle status clear |
|
::kettle::option::set @kettle $startdir |
|
foreach {o v} $opts { |
|
::kettle option set $o $v |
|
} |
|
::kettle option set @srcscript $path |
|
::kettle option set @srcdir [file dirname $path] |
|
::kettle option set @goals $goals |
|
#load standard recipes as listed in build.tcl |
|
::source $path |
|
puts stderr "recipes: [::kettle recipe names]" |
|
::kettle recipe run {*}[::kettle option get @goals] |
|
|
|
set state [::kettle option get --state] |
|
if {$state ne {}} { |
|
puts stderr "saving kettle state: $state" |
|
::kettle status save $state |
|
} |
|
|
|
} else { |
|
#shell |
|
puts stdout "Running external kettle process with args: $opts $goals" |
|
run -n tclsh $kettlescript -f $path {*}$opts {*}$goals |
|
} |
|
|
|
} |
|
proc kettle_punk_recipes {} { |
|
set txtdst ... |
|
} |
|
|
|
} |
|
} |
|
|
|
|
|
namespace eval punk::mix::cli { |
|
proc _cli {args} { |
|
#don't use tailcall - base uses info level to determine caller |
|
::punk::mix::base::_cli {*}$args |
|
} |
|
variable default_command help |
|
package require punk::mix::base |
|
package require punk::overlay |
|
if {[catch { |
|
punk::overlay::custom_from_base [namespace current] ::punk::mix::base |
|
} errM]} { |
|
puts stderr "punk::mix::cli load error: Failed to overlay punk::mix::base $errM" |
|
error "punk::mix::cli error: $errM" |
|
} |
|
} |
|
|
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punk::mix::cli [namespace eval punk::mix::cli { |
|
variable version |
|
set version 999999.0a1.0 |
|
}] |
|
return
|
|
|