From 345fd0907ba4a427755b6c76a19a36b14b986a77 Mon Sep 17 00:00:00 2001 From: Julian Noble Date: Sat, 4 Jul 2026 21:45:27 +1000 Subject: [PATCH] tidy old version of punk::mix::cli in punk.shell-0.1 project layout --- .../bootsupport/modules/punk/mix/cli-0.3.tm | 1128 ----------------- 1 file changed, 1128 deletions(-) delete mode 100644 src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.tm diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.tm deleted file mode 100644 index 263ccc96..00000000 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/cli-0.3.tm +++ /dev/null @@ -1,1128 +0,0 @@ -# -*- tcl -*- -# Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck 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::mix::cli 0.3 -# Meta platform tcl -# Meta license -# @@ 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 - - package require punk::overlay - 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 - } - - - 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\ - ] - if {[llength $args] %2 != 0} {error "validate_modulename args must be name-value pairs: received '$args'"} - foreach {k v} $args { - switch -- $k { - -errorprefix { - 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] - # -- --- --- --- --- --- --- --- --- --- --- --- --- --- - - 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 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\ - ] - # -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 had_error 0 - 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) - - if 0 { - #use -base $buildfolder so that -directory is included in the archive - the modpod stub relies on this - and extraction would be potentially messy otherwise - punk::zip::mkzip -base $buildfolder -directory $buildfolder/#modpod-$basename-$module_build_version -- $zipfile * - #punk::zip::mkzip stores permissions - (unix style) which confuses zipfs when reading - it misidentifies dirs as files - } - #zipfs mkzip does exactly what we need anyway in this case - set wd [pwd] - cd $buildfolder - puts "zipfs mkzip $zipfile #modpod-$basename-$module_build_version" - zipfs mkzip $zipfile #modpod-$basename-$module_build_version - cd $wd - - 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 - - $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 - file copy -force $modulefile $target_module_dir - 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 0.3 -}] -return