diff --git a/src/bin/sdx.kit b/src/bin/sdx.kit new file mode 100644 index 00000000..4c70d7e7 Binary files /dev/null and b/src/bin/sdx.kit differ diff --git a/src/bootsupport/modules/punk/libunknown-0.1.tm b/src/bootsupport/modules/punk/libunknown-0.1.tm index a4f56010..1b15d45a 100644 --- a/src/bootsupport/modules/punk/libunknown-0.1.tm +++ b/src/bootsupport/modules/punk/libunknown-0.1.tm @@ -890,10 +890,10 @@ tcl::namespace::eval punk::libunknown { set prev_e [dict get $epoch pkg current] set current_e [expr {$prev_e + 1}] # ------------- - puts stderr "--> pkg epoch $prev_e -> $current_e" - puts stderr "args: $args" - puts stderr "last_auto: $last_auto_path" - puts stderr "auto_path: $auto_path" + #puts stderr "--> pkg epoch $prev_e -> $current_e" + #puts stderr "args: $args" + #puts stderr "last_auto: $last_auto_path" + #puts stderr "auto_path: $auto_path" # ------------- if {[llength $auto_path] > [llength $last_auto_path] && [punk::libunknown::lib::is_list_all_in_list $last_auto_path $auto_path]} { #The auto_path changed, and is a pure addition of entry/entries diff --git a/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm b/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm index 8ef36e27..06b145de 100644 --- a/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm +++ b/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm @@ -20,7 +20,7 @@ #[manpage_begin punkshell_module_scriptwrap 0 0.1.0] #[copyright "2024"] #[titledesc {scriptwrap polyglot tool}] [comment {-- Name section and table of contents description --}] -#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] +#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] #[require punk::mix::commandset::scriptwrap] #[keywords module commandset launcher scriptwrap] #[description] @@ -30,7 +30,7 @@ #*** !doctools #[section Overview] -#[para] overview of scriptwrap +#[para] overview of scriptwrap #[subsection Concepts] #[para] - @@ -74,7 +74,7 @@ package require punk::fileline namespace eval punk::mix::commandset::scriptwrap { #*** !doctools #[subsection {Namespace punk::mix::commandset::scriptwrap}] - #[para] Core API functions for punk::mix::commandset::scriptwrap + #[para] Core API functions for punk::mix::commandset::scriptwrap #[list_begin definitions] namespace export * @@ -93,7 +93,7 @@ namespace eval punk::mix::commandset::scriptwrap { foreach k [lreverse [dict keys $tdict_low_to_high]] { dict set tdict $k [dict get $tdict_low_to_high $k] } - + #set pathinfolist [dict values $tdict] set names [dict keys $tdict] @@ -142,9 +142,9 @@ namespace eval punk::mix::commandset::scriptwrap { put stderr "commandset::scriptwrap::templates_dict WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } return - } - - + } + + #A batch file with unix line-endings is sensitive to label positioning. #batch file with windows crlf line endings can exhibit this problem - but probably only if specifically crafted with long lines deliberately designed to trigger it. #see: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 (Call and goto may fail when the batch file has Unix line endings) @@ -808,176 +808,317 @@ namespace eval punk::mix::commandset::scriptwrap { return $result } #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site - #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf - proc multishell {filepath_or_scriptset args} { - set opts [dict create\ - -askme 1\ - -outputfolder "\uFFFF"\ - -template "\uFFFF"\ - -returnextra 0\ - -force 0\ - ] - #set known_opts [dict keys $defaults] - foreach {k v} $args { - switch -- $k { - -askme - -outputfolder - -template - -returnextra - -force { - dict set opts $k $v - } - default { - error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" - } + #scriptset name to substitute multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf + #set usage "" + #append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n + #append usage "The scriptset name will be used to search for .sh|.tcl|.ps1 or names as you specify in yourname.wrapconfig if it exists" \n + #append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n + #if {![string length $filepath_or_scriptset]} { + # puts stderr "No filepath_or_scriptset specified" + # puts stderr $usage + # return false + #} + proc _read_scriptset_wrap_tomlfile {fname} { + set resultd [dict create] + package require tomlish + set tomldata [readFile $fname] + #todo - fix tomlish to provide line number in ERROR structure during from_toml call. + if {[catch {tomlish::to_dict [tomlish::from_toml $tomldata]} tomldict]} { + puts stderr "Failed to parse $fname" + puts stderr "error: $tomldict" + } + if {[tomlish::dict::path::exists $tomldict {.application.template}]} { + dict set resultd template [tomlish::dict::path::get $tomldict {.application.template.value}] + } + set scripts [list] + if {[tomlish::dict::path::exists $tomldict {.application.scripts.value}]} { + set arrvalues [tomlish::dict::path::get $tomldict {.application.scripts.value}] + foreach tvdict $arrvalues { + lappend scripts [dict get $tvdict value] } } + dict set resultd scripts $scripts - set usage "" - append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n - append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n - append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n - if {![string length $filepath_or_scriptset]} { - puts stderr "No filepath_or_scriptset specified" - puts stderr $usage - return false + set ftail [file rootname [file tail $fname]] ;#e.g example_wrap.toml + set scriptset [lindex [split $ftail _] 0] + set fallback_outputfile $scriptset.cmd + set fallback_nextshellpath "/usr/bin/env tclsh" + set fallback_nextshelltype "tcl" + + if {[tomlish::dict::path::exists $tomldict {.application.default_outputfile.value}]} { + dict set resultd default_outputfile [tomlish::dict::path::get $tomldict {.application.default_outputfile.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshellpath.value}]} { + dict set resultd default_nextshellpath [tomlish::dict::path::get $tomldict {.application.default_nextshellpath.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshelltype.value}]} { + dict set resultd default_nextshelltype [tomlish::dict::path::get $tomldict {.application.default_nextshelltype.value}] + } + foreach platform {win32 dragonflybsd freebsd netbsd linux macosx other} { + set d [dict create] + foreach field {outputfile nextshellpath nextshelltype} { + if {[tomlish::dict::path::exists $tomldict ".application.$platform.$field.value"]} { + dict set d $field [tomlish::dict::path::get $tomldict ".application.$platform.$field.value"] + } else { + if {[dict exists $resultd default_$field]} { + dict set d $field [dict get $resultd default_$field] + } else { + dict set d $field [set fallback_$field] + } + } + } + dict set resultd $platform $d } + + return $resultd + } + punk::args::define { + @id -id ::punk::mix::commandset::scriptwrap::multishell + @cmd -name punk::mix::commandset::scriptwrap::multishell\ + -summary\ + "Wrap script(s) into a polyglot cross-platform executable script."\ + -help\ + "Create a polyglot executable script that wraps constituent scripts written in + various scripting languages such as perl, tcl, shell script, powershell. + The resulting polyglot file should run cross platform on windows and various + types of unix-like OS. For use on windows the output file should be named with + a .bat or .cmd extension - but the same file with extension removed should also + be capable of running on FreeBSD, Linux etc. + Note that a polyglot script such as this may be somewhat brittle over the long + term with regards to default shells and scripting languages across platforms." + @leaders -min 1 -max 1 + filepath_or_scriptset -type string -minsize 1 -help\ + "Supply the path to a single script file to wrap, or the name of a scriptset. + The scriptset name will be used to search for .sh|.bash|.tcl|.ps1|.pl + or alternatively, names as specified in a configuration file named _wrap.toml + if it exists in the current folder, or is specified with a full path name. + If no template name/path is specified in a _wrap.toml file and no + -template argument is supplied the default punk.multishell.cmd will be used. + If the template is specified explicitly in -template as well as in the .toml + file - the supplied -template argument will override that specified in the + .toml file." + @opts + -template -type string -default "punk.multishell.cmd" -help\ + "Templates are provided from modules or paths in the current project, + so available templates will vary based on whether the multishell + command is being run from within a project directory or not. + To see available templates use punk::mix::commandset::scriptwrap::templates." + -outputfolder -type directory -default "" -help\ + "Folder to which to write resulting polyglot script. + If empty, the output will go to the /bin folder or + to the current working directory if there is no projectroot." + -askme -type boolean -default 1 -help\ + "Prompt user at console (stdin) for confirmation of operations such as + overwrite." + -force -type boolean -default 0 + -returnextra -type boolean -default 0 + @values -minvalues 0 -maxvalues 0 + } + #: + #@SET "nextshellpath[win32___________]=tclsh___________________________" + #@SET "nextshelltype[win32___________]=tcl_____________" + #@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[dragonflybsd____]=tcl_____________" + #@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[freebsd_________]=tcl_____________" + #@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[netbsd__________]=tcl_____________" + #@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[linux___________]=tcl_____________" + #@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[macosx__________]=tcl_____________" + #@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[other___________]=tcl_____________" + #: + proc multishell {args} { + set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::multishell] + lassign [dict values $argd] leaders opts values received + # -- --- --- --- --- --- --- --- --- --- --- --- - set opt_askme [dict get $opts -askme] - set opt_template [dict get $opts -template] - set opt_outputfolder [dict get $opts -outputfolder] - set opt_returnextra [dict get $opts -returnextra] - set opt_force [dict get $opts -force] + set filepath_or_scriptset [dict get $leaders filepath_or_scriptset] + set opt_askme [dict get $opts -askme] + set opt_template [dict get $opts -template] ;#use dict exists $received -template to see if overridable in .toml + set opt_outputfolder [dict get $opts -outputfolder] + set opt_returnextra [dict get $opts -returnextra] + set opt_force [dict get $opts -force] # -- --- --- --- --- --- --- --- --- --- --- --- - set ext [file extension $filepath_or_scriptset] set startdir [pwd] + set allowed_extensions [list tcl ps1 sh bash pl] + #TODO - distinct sections for sh vs bash? needs experiments.. + #for now we use shell-pre-launch-subprocess etc + #set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] + set extension_langs [list tcl tcl ps1 powershell sh shell bash shell pl perl] + + if {[file pathtype $filepath_or_scriptset] ni {absolute relative}} { + error "bad pathtype for '$filepath_or_scriptset' (expected absolute or relative path, or name of scriptset)" + } - - - #first check if relative or absolute path matches a file + #first check if absolute path matches a file or relative path from cwd matches a file if {[file pathtype $filepath_or_scriptset] eq "absolute"} { - set specified_path $filepath_or_scriptset + set specified_path $filepath_or_scriptset } else { set specified_path [file join $startdir $filepath_or_scriptset] } + set scriptdir [file dirname $specified_path] + set ext [string trim [file extension $filepath_or_scriptset] .] - set allowed_extensions [list wrapconfig tcl ps1 sh bash pl] - set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] - #set allowed_extensions [list tcl] - set found_script 0 - if {[file exists $specified_path]} { - set found_script 1 + set scriptset "" + if {$ext eq ""} { + set scriptset [file rootname [file tail $specified_path]] + } elseif {$ext eq "toml"} { + set tomltail [file tail $specified_path] + if {[string match *_wrap.toml $tomltail]} { + set scriptset [lindex [split $tomltail _] 0] + #if .toml was specified - the config file must exist + if {![file exists $specified_path]} { + if {[file pathtype $filepath_or_scriptset] eq "relative"} { + puts stderr "unable to locate '$specified_path' - will continue search in src/scriptapps folder" + } else { + #caller was specific about path - no fallback to src/scriptapps + error "unable to locate '$specified_path'" + } + } + } else { + error "supplied toml file must be of form _wrap.toml" + } } else { - foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { - if {[file exists $filepath_or_scriptset.$e]} { - set found_script 1 - break + if {$ext ni $allowed_extensions} { + error "supplied filepath_or_scriptset must be the name of a scriptset without extension, a file named _wrap.toml, or a script with one of the extensions: $allowed_extensions" + } + } + + set list_input_files [list] + set configd [dict create] + if {$scriptset ne ""} { + puts stdout "Attempting to process all scripts belonging to scriptset '$scriptset'" + #.toml file may or may not exist + if {[file exists ${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptdir/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptdir/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptdir $s] + } + } + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" + return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptdir" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptdir/$scriptset.$e]} { + lappend list_input_files $scriptdir/$scriptset.$e + } } } + } else { + #expect a single script + if {[file exists $specified_path]} { + lappend list_input_files $specified_path + } } + set found_script [expr {[llength $list_input_files] > 0}] #TODO! - use get_wrapper_folders - multishell should use same available templates as the 'templates' function - set scriptset [file rootname [file tail $specified_path]] if {$found_script} { - if {[file type $specified_path] eq "file"} { - set specified_root [file dirname $specified_path] - set pathinfo [punk::repo::find_repos [file dirname $specified_path]] - set projectroot [dict get $pathinfo closest] + #found scripts at absolute path - or path relative to cwd + set scriptroot $scriptdir + set pathinfo [punk::repo::find_repos $scriptroot] + set projectroot [dict get $pathinfo closest] + if {[file exists $scriptroot/wrappers]} { + set customwrapper_folder $scriptroot/wrappers + } else { + #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder if {[string length $projectroot]} { - #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - set customwrapper_folder $projectroot/src/scriptapps/wrappers - } + set customwrapper_folder $projectroot/src/scriptapps/wrappers } else { #outside of any project - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - #no customwrapper folder available - set customwrapper_folder "" - } + set customwrapper_folder "" } - } else { - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false } } else { + if {[file pathtype $filepath_or_scriptset] eq "absolute"} { + return false + } set pathinfo [punk::repo::find_repos $startdir] set projectroot [dict get $pathinfo closest] - if {[string length $projectroot]} { - if {[llength [file split $filepath_or_scriptset]] > 1} { - puts stderr "filepath_or_scriptset looks like a path - but doesn't seem to point to a file" - puts stderr "Ensure you are within a project and use just the name of the scriptset, or pass in the full correct path or relative path to current directory" - puts stderr $usage - return false - } else { - #we've already ruled out empty string - so must have a single element representing scriptset - possibly with file extension - set scriptroot $projectroot/src/scriptapps - set customwrapper_folder $projectroot/src/scriptapps/wrappers - #check something matches the scriptset.. - set something_found "" - if {[file exists $scriptroot/$scriptset]} { - set found_script 1 - set something_found $scriptroot/$scriptset ;#extensionless file - that's ok too - } else { - foreach e $allowed_extensions { - if {[file exists $scriptroot/$scriptset.$e]} { - set found_script 1 - set something_found $scriptroot/$scriptset.$e - break - } + if {![string length $projectroot]} { + puts stderr "No matching scripts or config found for $filepath_or_scriptset, and you are not within a directory where projectroot and src/scriptapps can be determined" + return false + } + + set scriptroot $projectroot/src/scriptapps + set customwrapper_folder $projectroot/src/scriptapps/wrappers + #check something matches the scriptset.. + if {$scriptset ne ""} { + #.toml file may or may not exist + if {[file exists $scriptroot/${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptroot/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptroot/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptroot $s] } } - if {!$found_script} { - puts stderr "Searched within $scriptroot" - puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" - puts stderr $usage + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" return false - } else { - if {[file type $something_found] ne "file"} { - puts stderr "Found '$something_found'" - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptroot" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptroot/$scriptset.$e]} { + lappend list_input_files $scriptroot/$scriptset.$e } } } - } else { - puts stderr "filepath_or_scriptset parameter doesn't seem to refer to a file, and you are not within a directory where projectroot and src/scriptapps/wrappers can be determined" - puts stderr $usage - return false + #expect a single script + if {[file exists $scriptroot/$filepath_or_scriptset]} { + if {[file type $scriptroot/$filepath_or_scriptset] ne "file"} { + puts stderr "wrap_in_multishell doesn't currently support a directory as the path. path: $scriptroot/$filepath_or_scriptset" + return false + } + lappend list_input_files $scriptroot/$filepath_or_scriptset + } } - } - #assertion - customwrapper_folder var exists - but might be empty + set found_script [expr {[llength $list_input_files] > 0}] - - if {[string length $ext]} { - #If there was an explicitly supplied extension - then that file should exist - if {![file exists $scriptroot/$scriptset.$ext]} { - puts stderr "Explicit extension .$ext was supplied - but matching file not found." - puts stderr $usage - return false - } else { - if {$ext eq "wrapconfig"} { - set process_extensions ALLFOUNDORCONFIGURED + #---------------------- + if {!$found_script} { + puts stderr "Searched within $scriptdir and $scriptroot" + if {$scriptset ne ""} { + puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" } else { - set process_extensions $ext + puts stderr "Unable to find file $filepath_or_scriptset" } + return false } - } else { - #no explicit extension - process all for scriptset - set process_extensions ALLFOUNDORCONFIGURED + } - #process_extensions - either a single one - or all found or as per .wrapconfig + #assertion - customwrapper_folder var exists - but might be empty - if {$opt_template eq "\uFFFF"} { - set templatename punk.multishell.cmd + if {[dict exists $configd template]} { + set templatename [dict get $configd template] } else { - set templatename $opt_template + if {$opt_template eq "\uFFFF"} { + set templatename punk.multishell.cmd + } else { + set templatename $opt_template + } } set templatename_root [file rootname [file tail $templatename]] @@ -995,7 +1136,7 @@ namespace eval punk::mix::commandset::scriptwrap { set template_base_dict [punk::mix::base::lib::get_template_basefolders] set tpldirs [list] dict for {tdir tsourceinfo} $template_base_dict { - set vendor [dict get $tsourceinfo vendor] + set vendor [dict get $tsourceinfo vendor] if {[file exists $tdir/utility/scriptappwrappers/$templatename]} { lappend tpldirs $tdir } elseif {[file exists $tdir/utility/scriptappwrappers/${templatename_fileroot}[file extension $templatename]]} { @@ -1032,7 +1173,7 @@ namespace eval punk::mix::commandset::scriptwrap { } - if {$opt_outputfolder eq "\uFFFF"} { + if {$opt_outputfolder eq ""} { #outputfolder not explicitly specified by caller if {[string length $projectroot]} { set output_folder [file join $projectroot/bin] @@ -1056,13 +1197,36 @@ namespace eval punk::mix::commandset::scriptwrap { #todo - #output_file extension may also depend on the template being used.. and/or the .wrapconfig - if {$::tcl_platform(platform) eq "windows"} { - set output_extension cmd + #output_file extension may also depend on the template being used.. and/or the _wrap.toml config + + if {[dict size $configd]} { + package require platform + set thisplatform [string tolower [platform::identify]] + set ptype [lindex [split $thisplatform -] 0] + switch -- $ptype { + win32 - dragonflybsd - freebsd - netbsd - linux - macosx {} + default { + set ptype other + } + } + set out [dict get $configd $ptype outputfile] + set output_file [file join $output_folder $out] } else { - set output_extension sh + #no _wrap.toml file available + if {$::tcl_platform(platform) eq "windows"} { + set output_extension .cmd + } else { + set output_extension .sh + } + if {$scriptset ne ""} { + set output_file [file join $output_folder $scriptset$output_extension] + } else { + set infile [lindex $list_input_files 0] + set output_file [file join $output_folder [file rootname [file tail $infile]]$output_extension] + } } - set output_file [file join $output_folder $scriptset.$output_extension] + + if {[file exists $output_file]} { set fdexisting [open $output_file r] fconfigure $fdexisting -translation binary @@ -1103,13 +1267,10 @@ namespace eval punk::mix::commandset::scriptwrap { #foreach ln $template_lines { #} - set list_input_files [list] - if {$process_extensions eq "ALLFOUNDORCONFIGURED"} { - #todo - look for .wrapconfig or all extensions for the scriptset - puts stderr "Sorry - only single input file supported. Supply a file extension or use a .wrapconfig with a single input file for now - implementation incomplete" + if {[llength $list_input_files] > 1} { + #todo + puts stderr "Sorry - only single input file supported. Supply a file extension or use a _wrap.toml config with a single input file for now - implementation incomplete" return false - } else { - lappend list_input_files $scriptroot/$scriptset.$ext } #todo - split template at each etc marker and build a dict of parts @@ -1117,7 +1278,6 @@ namespace eval punk::mix::commandset::scriptwrap { #hack - process one input set filepath [lindex $list_input_files 0] - set fdscript [open $filepath r] fconfigure $fdscript -translation binary set script_data [read $fdscript] @@ -1131,7 +1291,8 @@ namespace eval punk::mix::commandset::scriptwrap { } puts stdout "-----------------------------------------------\n" puts stdout "Target for above script data is '$output_file'" - set lang [dict get $extension_langs [string tolower $ext]] + set script_ext [string trim [file extension $filepath] .] + set lang [dict get $extension_langs [string tolower $script_ext]] puts stdout "Language of script being wrapped is $lang" if {$opt_askme} { set answer [util::askuser "Does this look correct? Y|N"] diff --git a/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/bootsupport/modules/punk/ns-0.1.0.tm index 6bd826e2..f8e55b02 100644 --- a/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -444,9 +444,8 @@ tcl::namespace::eval punk::ns { set nspath [string map {:::: ::} $nspath] set mapped [string map {:: \u0FFF} $nspath] set parts [split $mapped \u0FFF] - if {[lindex $parts end] eq ""} { - - } + #if {[lindex $parts end] eq ""} { + #} return $parts } @@ -531,6 +530,21 @@ tcl::namespace::eval punk::ns { return [regexp [dict get $ns_re_cache $glob] $path] } + #namespace tree without globbing or weird ns consideration + proc nstree_raw {{location ::}} { + if {![string match ::* $location]} { + error "nstree_raw requires a fully qualified namespace" + } + nstree_rawlist $location + } + proc nstree_rawlist {location} { + set nslist [list $location] + foreach ch [::namespace children $location] { + lappend nslist {*}[nstree_rawlist $ch] + } + return $nslist + } + proc nstree {{location ""}} { if {![string match ::* $location]} { set nscaller [uplevel 1 {::namespace current}] @@ -3899,6 +3913,7 @@ tcl::namespace::eval punk::ns { } proc _pkguse_vars {varnames} { + #review - obsolete? while {"pkguse_vars_[incr n]" in $varnames} {} #return [concat $varnames pkguse_vars_$n] return [list {*}$varnames pkguse_vars_$n] @@ -3932,10 +3947,12 @@ tcl::namespace::eval punk::ns { #load package and move to namespace of same name if run interactively with only pkg/namespace argument. #if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock #if no newline or $args in the script - treat as one-liner and supply {*}$args automatically + variable pkguse_package_to_namespace [dict create] proc pkguse {args} { + variable pkguse_package_to_namespace set argd [punk::args::parse $args withid ::punk::ns::pkguse] lassign [dict values $argd] leaders opts values received - puts stderr "leaders:$leaders opts:$opts values:$values received:$received" + #puts stderr "leaders:$leaders opts:$opts values:$values received:$received" set pkg_or_existing_ns [dict get $leaders pkg_or_existing_ns] if {[dict exists $received script]} { @@ -3967,68 +3984,159 @@ tcl::namespace::eval punk::ns { set ver "";# tcl version? } default { - if {[string match ::* $pkg_or_existing_ns]} { - set pkg_unqualified [string range $pkg_or_existing_ns 2 end] - if {![tcl::namespace::exists $pkg_or_existing_ns]} { - set ver [package require $pkg_unqualified] - } else { - set ver "" - } + #- comparing namespaces_before vs namespaces_after only works if the package was not previously loaded + #we could either go to the somewhat expensive route of steaming up an interp with the same auto_path & tcl::tm::list each time.. + #or cache the result of the namespace we picked for later pkguse calls (pkguse_package_to_namespace dict) + #we are using the cache method - but this also doesn't help for packages previously loaded by normal package require + #our aim is for pkguse to be deterministic in what namespace it finds - even if it doesn't always get the ideal one (e.g cookiejar, see below) + #To determine appropriate namespace for already loaded packages where we have no cache entry - we may still need the helper interp mechanism + #The helper interp could be persistent - but only so long as the auto_path/tcl::tm::list values are in sync + #review. + + #also see img::png img::raw etc + #these don't directly load namespaces or direct commands.. just change behaviour of existing commands? + #but they can load things like tk (ttk namespace) first one creates ::tkimg? + + if {[string match ::* $pkg_or_existing_ns] && [tcl::namespace::exists $pkg_or_existing_ns]} { + #pkguse on an existing full qualified namespace does no package require set ns $pkg_or_existing_ns + set ver "" } else { - set pkg_unqualified $pkg_or_existing_ns - set ver [package require $pkg_unqualified] - set ns ::$pkg_unqualified - } - #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index - set previous_command_count 0 - if {[namespace exists $ns]} { - set previous_command_count [llength [info commands ${ns}::*]] - } + if {[string match ::* $pkg_or_existing_ns]} { + set pkg_unqualified [string range $pkg_or_existing_ns 2 end] + } else { + set pkg_unqualified $pkg_or_existing_ns + } + #foreach equiv of while 1 - just to allow early exit with break + foreach code_block single { + if {[dict exists $pkguse_package_to_namespace $pkg_unqualified]} { + set ns [dict get $pkguse_package_to_namespace $pkg_unqualified] + set ver [package provide $pkg_unqualified] + break + } + if {[package provide $pkg_unqualified] ne ""} { + #package has already been loaded + if {[namespace exists ::$pkg_unqualified]} { + set ns ::$pkg_unqualified + set ver [package provide $pkg_unqualified] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + break + } + #existing package but no matching namespace.. + #- load in throwaway interp and see what cmds/namespaces created + interp create nstest + try { + nstest eval {tcl::tm::remove {*}[tcl::tm::list]} + nstest eval [list tcl::tm::add {*}[lreverse [tcl::tm::list]]] + nstest eval [list set ::auto_path $::auto_path] + nstest eval {package require punk::ns} + set ns "" + if {![catch {nstest eval [list punk::ns::pkguse $pkg_unqualified]} errMsg]} { + set script [string map [list %p% $pkg_unqualified] {dict get $::punk::ns::pkguse_package_to_namespace %p%}] + set ns [nstest eval $script] + } else { + puts "couldn't test pkg $pkg_unqualified\n$errMsg" + } + } finally { + interp delete nstest + } - #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands - #for the purposes of pkguse - which most commonly interactive - we want the namespace populated - #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + set ver [package provide $pkg_unqualified] + break + } - if {!$ns_populated} { - #we will catch-run an auto_index entry if any - #auto_index entry may or may not be prefixed with :: - set keys [list] - #first look for exact pkg_unqualified and ::pkg_unqualified - #leave these at beginning of keys list - if {[array exists ::auto_index($pkg_unqualified)]} { - lappend keys $pkg_unqualified - } - if {[array exists ::auto_index(::$pkg_unqualified)]} { - lappend keys ::$pkg_unqualified - } - #as auto_index is an array - we could get keys in arbitrary order - set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] - lappend keys {*}$matches - set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] - lappend keys {*}$matches - set ns_populated 0 - set i 0 - set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing - set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] - while {!$ns_populated && $i < [llength $keys]} { - #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base - #e.g if we are loading ::x::y - #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc - set k [lindex $keys $i] - set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] - if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { - set auto_source [set ::auto_index($k)] - if {$auto_source ni $already_sourced} { - uplevel 1 $auto_source - lappend already_sourced $auto_source - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + #pkg not loaded + set namespaces_before [nstree_rawlist ::] ;#approx 1ms for 500 or so namespaces - not cheap but bearable + #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index + #gathering prior cmdcount for every ns in system is also a somewhat expensive operation.. review + #we don't know for sure that the namespace for the package require operation actually matches the package name + #e.g tcllib inifile package uses namespace ::ini + #e.g sqlite3 package adds commands to the global namespace + set dict_ns_commandcounts [dict create] + foreach nsb $namespaces_before { + dict set dict_ns_commandcounts $nsb [llength [info commands ${nsb}::*]] + } + + set ver [package require $pkg_unqualified] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + set namespaces_after [nstree_rawlist ::] + + if {[llength $namespaces_after] > [llength $namespaces_before]} { + set namespaces_new [struct::set difference $namespaces_after $namespaces_before] + if {$ns ni $namespaces_new} { + #todo - use shortest result? what if this is a namespace from a required sub package? + #e.g cookiejar loads sqlite3,http,tcl::idna which creates ::sqlite3 etc - but cookiejar just creates an object at ::http::cookiejar + #In this specific case we end up in oo::ObjXXX - but would be better placed in ::http, where the new cookiejar command resides + #review - todo? + set pkgs [package names] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + #find something new - that doesn't match another package name + foreach new $namespaces_new { + if {[lsearch $pkgs [string trimleft $new :]] == -1} { + set ns $new + break + } + } } } - incr i - } + if {[tcl::namespace::exists $ns]} { + #review - only cache if exists? + dict set pkguse_package_to_namespace $pkg_unqualified $ns; + } + set previous_command_count 0 + if {[dict exists $dict_ns_commandcounts $ns]} { + set previous_command_count [dict get $dict_ns_commandcounts $ns] + } + + #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands + #for the purposes of pkguse - which most commonly interactive - we want the namespace populated + #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + + if {!$ns_populated} { + #we will catch-run an auto_index entry if any + #auto_index entry may or may not be prefixed with :: + set keys [list] + #first look for exact pkg_unqualified and ::pkg_unqualified + #leave these at beginning of keys list + if {[array exists ::auto_index($pkg_unqualified)]} { + lappend keys $pkg_unqualified + } + if {[array exists ::auto_index(::$pkg_unqualified)]} { + lappend keys ::$pkg_unqualified + } + #as auto_index is an array - we could get keys in arbitrary order + set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] + lappend keys {*}$matches + set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] + lappend keys {*}$matches + set ns_populated 0 + set i 0 + set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing + set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] + while {!$ns_populated && $i < [llength $keys]} { + #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base + #e.g if we are loading ::x::y + #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc + set k [lindex $keys $i] + set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] + if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { + set auto_source [set ::auto_index($k)] + if {$auto_source ni $already_sourced} { + puts stderr "pkguse sourcing auto_index script $auto_source" + uplevel 1 $auto_source + lappend already_sourced $auto_source + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + } + } + incr i + } + + } + + }; # end foreach code_block single - scope for use of 'break' } } diff --git a/src/bootsupport/modules/punk/repl-0.1.2.tm b/src/bootsupport/modules/punk/repl-0.1.2.tm index a31e255e..fd84ec8d 100644 --- a/src/bootsupport/modules/punk/repl-0.1.2.tm +++ b/src/bootsupport/modules/punk/repl-0.1.2.tm @@ -3567,7 +3567,6 @@ namespace eval repl { if {[catch { package require punk::args - catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical package require punk::config package require punk::ns #puts stderr "loading natsort" @@ -3589,6 +3588,7 @@ namespace eval repl { }} [punk::config::configure running] package require textblock + catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical } errM]} { puts stderr "========================" puts stderr "code interp error:" diff --git a/src/bootsupport/modules/textblock-0.1.3.tm b/src/bootsupport/modules/textblock-0.1.3.tm index 472edc54..f2f4a3af 100644 --- a/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/bootsupport/modules/textblock-0.1.3.tm @@ -6007,7 +6007,7 @@ tcl::namespace::eval textblock { proc welcome_test {} { package require punk::ansi - set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/roy-welc.ans 80x8]] + set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/ROY-WELC.ANS 80x8]] # Ansi art courtesy of Carsten Cumbrowski aka Roy/SAC - roysac.com set table [[textblock::spantest] print] set punks [a+ web-lawngreen][>punk . lhs][a]\n\n[a+ rgb#FFFF00][>punk . rhs][a] diff --git a/src/lib/app-shellspy/shellspy.tcl b/src/lib/app-shellspy/shellspy.tcl index 95f057bb..0508bafe 100644 --- a/src/lib/app-shellspy/shellspy.tcl +++ b/src/lib/app-shellspy/shellspy.tcl @@ -88,11 +88,24 @@ namespace eval shellspy { return [expr {[clock millis]/1000.0}] } variable shellspy_status_log "shellspy-[clock micros]" - set debug_syslog_server 127.0.0.1:514 - #set debug_syslog_server 172.16.6.42:51500 - #set debug_syslog_server "" - set error_syslog_server 127.0.0.1:514 - set data_syslog_server 127.0.0.1:514 + + #todo - default to no logging not even to local syslog + #load a .toml config which can configure logging as desired + set do_log 0 + if {$do_log} { + set debug_syslog_server 127.0.0.1:514 + #set debug_syslog_server 172.16.6.42:51500 + #set debug_syslog_server "" + set error_syslog_server 127.0.0.1:514 + set data_syslog_server 127.0.0.1:514 + } else { + set debug_syslog_server "" + set error_syslog_server "" + set data_syslog_server "" + } + + + shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog $debug_syslog_server -file ""] shellfilter::log::write $shellspy_status_log "shellspy launch with args '$::argv'" @@ -570,8 +583,9 @@ namespace eval shellspy { proc do_script_process {scriptbin scriptname args} { variable shellspy_status_log shellfilter::log::write $shellspy_status_log "do_script_process got scriptname:'$scriptname' args:'$args'" - set args [do_callback script_process {*}$args] - set params [do_callback_parameters script_process] + #no script_process callbacks + #set args [do_callback script_process {*}$args] + #set params [do_callback_parameters script_process] dict set params -teehandle shellspy set params [dict merge $params [get_channel_config $::testconfig]] @@ -620,7 +634,7 @@ namespace eval shellspy { proc do_script {scriptname replwhen args} { #ideally we don't want to launch an external process to run the script variable shellspy_status_log - shellfilter::log::write $shellspy_status_log "do_script got scriptname:'$scriptname' replwhen:$replwhen args:'$args'" + #shellfilter::log::write $shellspy_status_log "do_script got scriptname:'$scriptname' replwhen:$replwhen args:'$args'" set exepath [file dirname [file join [info nameofexecutable] __dummy__]] set exedir [file dirname $exepath] @@ -651,7 +665,7 @@ namespace eval shellspy { set modulesdir $basedir/modules set script [string map [list %a% $args %s% $scriptpath %m% $modulesdir] { -::tcl::tm::add %m% +#::tcl::tm::add %m% set scriptname %s% set normscript [file normalize $scriptname] @@ -696,9 +710,10 @@ dict with prevglobal {} #just the script } + #no script callbacks + #set args [do_callback script {*}$args] + #set params [do_callback_parameters script] - set args [do_callback script {*}$args] - set params [do_callback_parameters script] dict set params -tclscript 1 ;#don't give callback a chance to omit/break this dict set params -teehandle shellspy #dict set params -teehandle punksh @@ -716,7 +731,8 @@ dict with prevglobal {} # shellfilter::log::write $shellspy_status_log "do_script returning $exitinfo" #} - shellfilter::log::write $shellspy_status_log "do_script raw exitinfo: $exitinfo" + #jjj + #shellfilter::log::write $shellspy_status_log "do_script raw exitinfo: $exitinfo" if {[dict exists $exitinfo errorInfo]} { #strip out the irrelevant info from the errorInfo - we don't want info beyond 'invoked from within' as this is just plumbing related to the script sourcing set stacktrace [string map [list \r\n \n] [dict get $exitinfo errorInfo]] @@ -730,7 +746,8 @@ dict with prevglobal {} } set output [string trimright $output \n] dict set exitinfo errorInfo $output - shellfilter::log::write $shellspy_status_log "do_script simplified exitinfo: $exitinfo" + #jjj + #shellfilter::log::write $shellspy_status_log "do_script simplified exitinfo: $exitinfo" } return $exitinfo } diff --git a/src/make.tcl b/src/make.tcl index 2de13afb..37f36a9a 100644 --- a/src/make.tcl +++ b/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] } @@ -1077,10 +1077,16 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - This help." \n \n append h " $scriptname project ?-k?" \n append h " - this is the literal word project - and confirms you want to run the project build - which includes src/vfs/* checks and builds" \n - append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n - append h " - built modules go into /modules /lib etc." \n \n + append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n + append h " - builds/copies .tm modules from src to /modules etc and pkgIndex.tcl based libraries from src to /lib etc." \n \n append h " $scriptname modules" \n - append h " - build modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " - build (or copy if build not required) .tm modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname libs" \n + append h " - build (or copy if build not required) pkgIndex.tcl based libraries from src/lib src/vendorlib etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname packages" \n + append h " - build (or copy if build not required) both .tm and pkgIndex.tcl based packages from src to their corresponding locations under " \n append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n append h " $scriptname bootsupport" \n append h " - update the src/bootsupport modules as well as the mixtemplates/layouts//src/bootsupport modules if the folder exists" \n @@ -1089,6 +1095,7 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - bootsupport modules are available to make.tcl" \n \n append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n + append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -1213,6 +1220,8 @@ if {![string length [set projectroot [punk::repo::find_project $scriptfolder]]]} } set sourcefolder $projectroot/src +set binfolder $projectroot/bin + if {$::punkboot::command eq "check"} { set sep [string repeat - 75] puts stdout $sep @@ -1348,8 +1357,8 @@ if {$::punkboot::command eq "info"} { puts stdout "- -- --- --- --- --- --- --- --- --- -- -" puts stdout "- projectroot : $projectroot" set sourcefolder $projectroot/src - set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib_tcl*] - set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules_tcl*] + set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] + set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] puts stdout "- vendorlib folders: ([llength $vendorlibfolders])" foreach fld $vendorlibfolders { puts stdout " src/$fld" @@ -1358,13 +1367,18 @@ if {$::punkboot::command eq "info"} { foreach fld $vendormodulefolders { puts stdout " src/$fld" } - set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] - puts stdout "- source module paths: [llength $source_module_folderlist]" - foreach fld $source_module_folderlist { + #set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] ;#returns only those containing .tm files + #foreach fld $source_module_folderlist { + # set relpath [punkcheck::lib::path_relative $projectroot $fld] + # puts stdout " $relpath" + #} + set projectmodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails modules_tcl* modules] + puts stdout "- source module paths: [llength $projectmodulefolders]" + #JJJ + foreach fld $projectmodulefolders { puts stdout " $fld" } - set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] - lappend projectlibfolders lib + set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl* lib] puts stdout "- source libary paths: [llength $projectlibfolders]" foreach fld $projectlibfolders { puts stdout " src/$fld" @@ -1759,7 +1773,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules vfs}} { +if {$::punkboot::command ni {project modules libs packages vfs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -1772,7 +1786,7 @@ if {$::punkboot::command ni {project modules vfs}} { #install src vendor contents (from version controlled src folder) to base of project (same target folders as our own src/modules etc ie to paths that go on the auto_path and in tcl::tm::list) -if {$::punkboot::command in {project modules}} { +if {$::punkboot::command in {project packages modules}} { set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] foreach vf $vendormodulefolders { lassign [split $vf _] _vm tclx @@ -1797,7 +1811,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendormodulefolders]} { puts stderr "VENDORMODULES: No src/vendormodules or src/vendormodules_tcl* folders found." } +} +if {$::punkboot::command in {project packages libs}} { set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] foreach lf $vendorlibfolders { lassign [split $lf _] _vm tclx @@ -1827,8 +1843,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendorlibfolders]} { puts stderr "VENDORLIB: No src/vendorlib or src/vendorlib_tcl* folder found." } +} - +if {$::punkboot::command in {project packages modules libs}} { ######################################################## #templates #e.g The default project layout is mainly folder structure and readme files - but has some scripts developed under the main src that we want to sync @@ -1896,6 +1913,9 @@ if {$::punkboot::command in {project modules}} { $tpl_installer destroy } } +} + +if {$::punkboot::command in {project packages libs}} { ######################################################## set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] lappend projectlibfolders lib @@ -1927,7 +1947,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $projectlibfolders]} { puts stderr "PROJECTLIB: No src/lib or src/lib_tcl* folder found." } +} +if {$::punkboot::command in {project packages modules}} { #consolidated /modules /modules_tclX folder used for target where X is tcl major version #the make process will process for any _tclX not just the major version of the current interpreter @@ -1964,9 +1986,10 @@ if {$::punkboot::command in {project modules}} { ] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } +} +if {$::punkboot::command in {project packages modules libs}} { set installername "make.tcl" - # ---------------------------------------- if {[punk::repo::is_fossil_root $projectroot]} { set config [dict create\ @@ -2013,7 +2036,7 @@ if {$::punkboot::command in {project modules}} { #review set installername "make.tcl" -if {$::punkboot::command ni {project vfs}} { +if {$::punkboot::command ni {project vfs bin}} { #command = modules puts stdout "vfs folders not checked" puts stdout " - use 'make.tcl vfscommonupdate' to copy built modules into base vfs folder" @@ -2033,6 +2056,17 @@ if {$buildfolder ne "$sourcefolder/_build"} { exit 2 } +if {$::punkboot::command eq "bin"} { + puts stdout "checking $sourcefolder/bin" + set resultdict [punkcheck::install $sourcefolder/bin $binfolder\ + -overwrite synced-targets\ + -installer "punkboot-bin"\ + -progresschannel stdout\ + ] + + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout +} #find runtimes set rtfolder $sourcefolder/runtime @@ -2056,11 +2090,32 @@ if {![llength $runtimes]} { } set has_sdx 1 -if {[catch {exec sdx help} errM]} { - puts stderr "FAILED to find usable sdx command - check that sdx executable is on path" - puts stderr "err: $errM" - #exit 1 - set has_sdx 0 +set sdxpath [auto_execok $binfolder/sdx] +if {$sdxpath eq ""} { + set sdxpath [auto_execok [file dirname [info nameofexecutable]]/sdx] + if {$sdxpath eq ""} { + #last resort - look on path + set sdxpath [auto_execok sdx] + } + if {$sdxpath eq ""} { + #last resort - a tclkit and sdx.kit fine + if {[file exists $binfolder/sdx.kit]} { + set tclkitpath [auto_execok $binfolder/tclkit] + if {$tclkitpath eq ""} { + set tclkitpath [auto_execok tclkit] + } + set sdxpath [list {*}$tclkitpath $binfolder/sdx.kit] + } + } + + if {$sdxpath eq "" || [catch {exec {*}$sdxpath help} errM]} { + puts stderr "FAILED to find usable sdx command or tclkit executable with sdx.bat" + puts stderr "If tclkit-based runtimes are required - check that sdx executable is in bin folder of project or in same folder as tcl/punk executable or on path" + puts stderr "This is not a problem if tcl8.7/tcl9+ kits using the preferred method 'zipfs' are to be used, or if cookfs based kits are to be used." + puts stderr "err: $errM" + #exit 1 + set has_sdx 0 + } } # -- --- --- --- --- --- --- --- --- --- @@ -2825,17 +2880,17 @@ foreach vfstail $vfs_tails { if {[catch { if {$rtname ne "-"} { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose } else { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose } } result]} { if {$rtname ne "-"} { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" } else { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" } - puts stderr "sdx wrap $targetkit failed" + puts stderr "$::sdxpath wrap $targetkit failed" lappend failed_kits [list kit $targetkit reason $sdxmsg] $vfs_event targetset_end FAILED $vfs_event destroy @@ -3022,6 +3077,7 @@ foreach vfstail $vfs_tails { } ;#end foreach rtname in runtimes # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } + cd $startdir if {[llength $installed_kits]} { puts stdout "INSTALLED KITS: ([llength $installed_kits])" diff --git a/src/modules/punk/libunknown-0.1.tm b/src/modules/punk/libunknown-0.1.tm index a4f56010..1b15d45a 100644 --- a/src/modules/punk/libunknown-0.1.tm +++ b/src/modules/punk/libunknown-0.1.tm @@ -890,10 +890,10 @@ tcl::namespace::eval punk::libunknown { set prev_e [dict get $epoch pkg current] set current_e [expr {$prev_e + 1}] # ------------- - puts stderr "--> pkg epoch $prev_e -> $current_e" - puts stderr "args: $args" - puts stderr "last_auto: $last_auto_path" - puts stderr "auto_path: $auto_path" + #puts stderr "--> pkg epoch $prev_e -> $current_e" + #puts stderr "args: $args" + #puts stderr "last_auto: $last_auto_path" + #puts stderr "auto_path: $auto_path" # ------------- if {[llength $auto_path] > [llength $last_auto_path] && [punk::libunknown::lib::is_list_all_in_list $last_auto_path $auto_path]} { #The auto_path changed, and is a pure addition of entry/entries diff --git a/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm b/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm index 5e1d19db..8a58f78e 100644 --- a/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm +++ b/src/modules/punk/mix/commandset/scriptwrap-999999.0a1.0.tm @@ -20,7 +20,7 @@ #[manpage_begin punkshell_module_scriptwrap 0 999999.0a1.0] #[copyright "2024"] #[titledesc {scriptwrap polyglot tool}] [comment {-- Name section and table of contents description --}] -#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] +#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] #[require punk::mix::commandset::scriptwrap] #[keywords module commandset launcher scriptwrap] #[description] @@ -30,7 +30,7 @@ #*** !doctools #[section Overview] -#[para] overview of scriptwrap +#[para] overview of scriptwrap #[subsection Concepts] #[para] - @@ -74,7 +74,7 @@ package require punk::fileline namespace eval punk::mix::commandset::scriptwrap { #*** !doctools #[subsection {Namespace punk::mix::commandset::scriptwrap}] - #[para] Core API functions for punk::mix::commandset::scriptwrap + #[para] Core API functions for punk::mix::commandset::scriptwrap #[list_begin definitions] namespace export * @@ -93,7 +93,7 @@ namespace eval punk::mix::commandset::scriptwrap { foreach k [lreverse [dict keys $tdict_low_to_high]] { dict set tdict $k [dict get $tdict_low_to_high $k] } - + #set pathinfolist [dict values $tdict] set names [dict keys $tdict] @@ -142,9 +142,9 @@ namespace eval punk::mix::commandset::scriptwrap { put stderr "commandset::scriptwrap::templates_dict WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } return - } - - + } + + #A batch file with unix line-endings is sensitive to label positioning. #batch file with windows crlf line endings can exhibit this problem - but probably only if specifically crafted with long lines deliberately designed to trigger it. #see: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 (Call and goto may fail when the batch file has Unix line endings) @@ -808,176 +808,317 @@ namespace eval punk::mix::commandset::scriptwrap { return $result } #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site - #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf - proc multishell {filepath_or_scriptset args} { - set opts [dict create\ - -askme 1\ - -outputfolder "\uFFFF"\ - -template "\uFFFF"\ - -returnextra 0\ - -force 0\ - ] - #set known_opts [dict keys $defaults] - foreach {k v} $args { - switch -- $k { - -askme - -outputfolder - -template - -returnextra - -force { - dict set opts $k $v - } - default { - error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" - } + #scriptset name to substitute multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf + #set usage "" + #append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n + #append usage "The scriptset name will be used to search for .sh|.tcl|.ps1 or names as you specify in yourname.wrapconfig if it exists" \n + #append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n + #if {![string length $filepath_or_scriptset]} { + # puts stderr "No filepath_or_scriptset specified" + # puts stderr $usage + # return false + #} + proc _read_scriptset_wrap_tomlfile {fname} { + set resultd [dict create] + package require tomlish + set tomldata [readFile $fname] + #todo - fix tomlish to provide line number in ERROR structure during from_toml call. + if {[catch {tomlish::to_dict [tomlish::from_toml $tomldata]} tomldict]} { + puts stderr "Failed to parse $fname" + puts stderr "error: $tomldict" + } + if {[tomlish::dict::path::exists $tomldict {.application.template}]} { + dict set resultd template [tomlish::dict::path::get $tomldict {.application.template.value}] + } + set scripts [list] + if {[tomlish::dict::path::exists $tomldict {.application.scripts.value}]} { + set arrvalues [tomlish::dict::path::get $tomldict {.application.scripts.value}] + foreach tvdict $arrvalues { + lappend scripts [dict get $tvdict value] } } + dict set resultd scripts $scripts - set usage "" - append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n - append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n - append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n - if {![string length $filepath_or_scriptset]} { - puts stderr "No filepath_or_scriptset specified" - puts stderr $usage - return false + set ftail [file rootname [file tail $fname]] ;#e.g example_wrap.toml + set scriptset [lindex [split $ftail _] 0] + set fallback_outputfile $scriptset.cmd + set fallback_nextshellpath "/usr/bin/env tclsh" + set fallback_nextshelltype "tcl" + + if {[tomlish::dict::path::exists $tomldict {.application.default_outputfile.value}]} { + dict set resultd default_outputfile [tomlish::dict::path::get $tomldict {.application.default_outputfile.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshellpath.value}]} { + dict set resultd default_nextshellpath [tomlish::dict::path::get $tomldict {.application.default_nextshellpath.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshelltype.value}]} { + dict set resultd default_nextshelltype [tomlish::dict::path::get $tomldict {.application.default_nextshelltype.value}] + } + foreach platform {win32 dragonflybsd freebsd netbsd linux macosx other} { + set d [dict create] + foreach field {outputfile nextshellpath nextshelltype} { + if {[tomlish::dict::path::exists $tomldict ".application.$platform.$field.value"]} { + dict set d $field [tomlish::dict::path::get $tomldict ".application.$platform.$field.value"] + } else { + if {[dict exists $resultd default_$field]} { + dict set d $field [dict get $resultd default_$field] + } else { + dict set d $field [set fallback_$field] + } + } + } + dict set resultd $platform $d } + + return $resultd + } + punk::args::define { + @id -id ::punk::mix::commandset::scriptwrap::multishell + @cmd -name punk::mix::commandset::scriptwrap::multishell\ + -summary\ + "Wrap script(s) into a polyglot cross-platform executable script."\ + -help\ + "Create a polyglot executable script that wraps constituent scripts written in + various scripting languages such as perl, tcl, shell script, powershell. + The resulting polyglot file should run cross platform on windows and various + types of unix-like OS. For use on windows the output file should be named with + a .bat or .cmd extension - but the same file with extension removed should also + be capable of running on FreeBSD, Linux etc. + Note that a polyglot script such as this may be somewhat brittle over the long + term with regards to default shells and scripting languages across platforms." + @leaders -min 1 -max 1 + filepath_or_scriptset -type string -minsize 1 -help\ + "Supply the path to a single script file to wrap, or the name of a scriptset. + The scriptset name will be used to search for .sh|.bash|.tcl|.ps1|.pl + or alternatively, names as specified in a configuration file named _wrap.toml + if it exists in the current folder, or is specified with a full path name. + If no template name/path is specified in a _wrap.toml file and no + -template argument is supplied the default punk.multishell.cmd will be used. + If the template is specified explicitly in -template as well as in the .toml + file - the supplied -template argument will override that specified in the + .toml file." + @opts + -template -type string -default "punk.multishell.cmd" -help\ + "Templates are provided from modules or paths in the current project, + so available templates will vary based on whether the multishell + command is being run from within a project directory or not. + To see available templates use punk::mix::commandset::scriptwrap::templates." + -outputfolder -type directory -default "" -help\ + "Folder to which to write resulting polyglot script. + If empty, the output will go to the /bin folder or + to the current working directory if there is no projectroot." + -askme -type boolean -default 1 -help\ + "Prompt user at console (stdin) for confirmation of operations such as + overwrite." + -force -type boolean -default 0 + -returnextra -type boolean -default 0 + @values -minvalues 0 -maxvalues 0 + } + #: + #@SET "nextshellpath[win32___________]=tclsh___________________________" + #@SET "nextshelltype[win32___________]=tcl_____________" + #@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[dragonflybsd____]=tcl_____________" + #@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[freebsd_________]=tcl_____________" + #@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[netbsd__________]=tcl_____________" + #@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[linux___________]=tcl_____________" + #@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[macosx__________]=tcl_____________" + #@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[other___________]=tcl_____________" + #: + proc multishell {args} { + set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::multishell] + lassign [dict values $argd] leaders opts values received + # -- --- --- --- --- --- --- --- --- --- --- --- - set opt_askme [dict get $opts -askme] - set opt_template [dict get $opts -template] - set opt_outputfolder [dict get $opts -outputfolder] - set opt_returnextra [dict get $opts -returnextra] - set opt_force [dict get $opts -force] + set filepath_or_scriptset [dict get $leaders filepath_or_scriptset] + set opt_askme [dict get $opts -askme] + set opt_template [dict get $opts -template] ;#use dict exists $received -template to see if overridable in .toml + set opt_outputfolder [dict get $opts -outputfolder] + set opt_returnextra [dict get $opts -returnextra] + set opt_force [dict get $opts -force] # -- --- --- --- --- --- --- --- --- --- --- --- - set ext [file extension $filepath_or_scriptset] set startdir [pwd] + set allowed_extensions [list tcl ps1 sh bash pl] + #TODO - distinct sections for sh vs bash? needs experiments.. + #for now we use shell-pre-launch-subprocess etc + #set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] + set extension_langs [list tcl tcl ps1 powershell sh shell bash shell pl perl] + + if {[file pathtype $filepath_or_scriptset] ni {absolute relative}} { + error "bad pathtype for '$filepath_or_scriptset' (expected absolute or relative path, or name of scriptset)" + } - - - #first check if relative or absolute path matches a file + #first check if absolute path matches a file or relative path from cwd matches a file if {[file pathtype $filepath_or_scriptset] eq "absolute"} { - set specified_path $filepath_or_scriptset + set specified_path $filepath_or_scriptset } else { set specified_path [file join $startdir $filepath_or_scriptset] } + set scriptdir [file dirname $specified_path] + set ext [string trim [file extension $filepath_or_scriptset] .] - set allowed_extensions [list wrapconfig tcl ps1 sh bash pl] - set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] - #set allowed_extensions [list tcl] - set found_script 0 - if {[file exists $specified_path]} { - set found_script 1 + set scriptset "" + if {$ext eq ""} { + set scriptset [file rootname [file tail $specified_path]] + } elseif {$ext eq "toml"} { + set tomltail [file tail $specified_path] + if {[string match *_wrap.toml $tomltail]} { + set scriptset [lindex [split $tomltail _] 0] + #if .toml was specified - the config file must exist + if {![file exists $specified_path]} { + if {[file pathtype $filepath_or_scriptset] eq "relative"} { + puts stderr "unable to locate '$specified_path' - will continue search in src/scriptapps folder" + } else { + #caller was specific about path - no fallback to src/scriptapps + error "unable to locate '$specified_path'" + } + } + } else { + error "supplied toml file must be of form _wrap.toml" + } } else { - foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { - if {[file exists $filepath_or_scriptset.$e]} { - set found_script 1 - break + if {$ext ni $allowed_extensions} { + error "supplied filepath_or_scriptset must be the name of a scriptset without extension, a file named _wrap.toml, or a script with one of the extensions: $allowed_extensions" + } + } + + set list_input_files [list] + set configd [dict create] + if {$scriptset ne ""} { + puts stdout "Attempting to process all scripts belonging to scriptset '$scriptset'" + #.toml file may or may not exist + if {[file exists ${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptdir/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptdir/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptdir $s] + } + } + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" + return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptdir" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptdir/$scriptset.$e]} { + lappend list_input_files $scriptdir/$scriptset.$e + } } } + } else { + #expect a single script + if {[file exists $specified_path]} { + lappend list_input_files $specified_path + } } + set found_script [expr {[llength $list_input_files] > 0}] #TODO! - use get_wrapper_folders - multishell should use same available templates as the 'templates' function - set scriptset [file rootname [file tail $specified_path]] if {$found_script} { - if {[file type $specified_path] eq "file"} { - set specified_root [file dirname $specified_path] - set pathinfo [punk::repo::find_repos [file dirname $specified_path]] - set projectroot [dict get $pathinfo closest] + #found scripts at absolute path - or path relative to cwd + set scriptroot $scriptdir + set pathinfo [punk::repo::find_repos $scriptroot] + set projectroot [dict get $pathinfo closest] + if {[file exists $scriptroot/wrappers]} { + set customwrapper_folder $scriptroot/wrappers + } else { + #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder if {[string length $projectroot]} { - #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - set customwrapper_folder $projectroot/src/scriptapps/wrappers - } + set customwrapper_folder $projectroot/src/scriptapps/wrappers } else { #outside of any project - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - #no customwrapper folder available - set customwrapper_folder "" - } + set customwrapper_folder "" } - } else { - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false } } else { + if {[file pathtype $filepath_or_scriptset] eq "absolute"} { + return false + } set pathinfo [punk::repo::find_repos $startdir] set projectroot [dict get $pathinfo closest] - if {[string length $projectroot]} { - if {[llength [file split $filepath_or_scriptset]] > 1} { - puts stderr "filepath_or_scriptset looks like a path - but doesn't seem to point to a file" - puts stderr "Ensure you are within a project and use just the name of the scriptset, or pass in the full correct path or relative path to current directory" - puts stderr $usage - return false - } else { - #we've already ruled out empty string - so must have a single element representing scriptset - possibly with file extension - set scriptroot $projectroot/src/scriptapps - set customwrapper_folder $projectroot/src/scriptapps/wrappers - #check something matches the scriptset.. - set something_found "" - if {[file exists $scriptroot/$scriptset]} { - set found_script 1 - set something_found $scriptroot/$scriptset ;#extensionless file - that's ok too - } else { - foreach e $allowed_extensions { - if {[file exists $scriptroot/$scriptset.$e]} { - set found_script 1 - set something_found $scriptroot/$scriptset.$e - break - } + if {![string length $projectroot]} { + puts stderr "No matching scripts or config found for $filepath_or_scriptset, and you are not within a directory where projectroot and src/scriptapps can be determined" + return false + } + + set scriptroot $projectroot/src/scriptapps + set customwrapper_folder $projectroot/src/scriptapps/wrappers + #check something matches the scriptset.. + if {$scriptset ne ""} { + #.toml file may or may not exist + if {[file exists $scriptroot/${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptroot/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptroot/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptroot $s] } } - if {!$found_script} { - puts stderr "Searched within $scriptroot" - puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" - puts stderr $usage + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" return false - } else { - if {[file type $something_found] ne "file"} { - puts stderr "Found '$something_found'" - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptroot" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptroot/$scriptset.$e]} { + lappend list_input_files $scriptroot/$scriptset.$e } } } - } else { - puts stderr "filepath_or_scriptset parameter doesn't seem to refer to a file, and you are not within a directory where projectroot and src/scriptapps/wrappers can be determined" - puts stderr $usage - return false + #expect a single script + if {[file exists $scriptroot/$filepath_or_scriptset]} { + if {[file type $scriptroot/$filepath_or_scriptset] ne "file"} { + puts stderr "wrap_in_multishell doesn't currently support a directory as the path. path: $scriptroot/$filepath_or_scriptset" + return false + } + lappend list_input_files $scriptroot/$filepath_or_scriptset + } } - } - #assertion - customwrapper_folder var exists - but might be empty + set found_script [expr {[llength $list_input_files] > 0}] - - if {[string length $ext]} { - #If there was an explicitly supplied extension - then that file should exist - if {![file exists $scriptroot/$scriptset.$ext]} { - puts stderr "Explicit extension .$ext was supplied - but matching file not found." - puts stderr $usage - return false - } else { - if {$ext eq "wrapconfig"} { - set process_extensions ALLFOUNDORCONFIGURED + #---------------------- + if {!$found_script} { + puts stderr "Searched within $scriptdir and $scriptroot" + if {$scriptset ne ""} { + puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" } else { - set process_extensions $ext + puts stderr "Unable to find file $filepath_or_scriptset" } + return false } - } else { - #no explicit extension - process all for scriptset - set process_extensions ALLFOUNDORCONFIGURED + } - #process_extensions - either a single one - or all found or as per .wrapconfig + #assertion - customwrapper_folder var exists - but might be empty - if {$opt_template eq "\uFFFF"} { - set templatename punk.multishell.cmd + if {[dict exists $configd template]} { + set templatename [dict get $configd template] } else { - set templatename $opt_template + if {$opt_template eq "\uFFFF"} { + set templatename punk.multishell.cmd + } else { + set templatename $opt_template + } } set templatename_root [file rootname [file tail $templatename]] @@ -995,7 +1136,7 @@ namespace eval punk::mix::commandset::scriptwrap { set template_base_dict [punk::mix::base::lib::get_template_basefolders] set tpldirs [list] dict for {tdir tsourceinfo} $template_base_dict { - set vendor [dict get $tsourceinfo vendor] + set vendor [dict get $tsourceinfo vendor] if {[file exists $tdir/utility/scriptappwrappers/$templatename]} { lappend tpldirs $tdir } elseif {[file exists $tdir/utility/scriptappwrappers/${templatename_fileroot}[file extension $templatename]]} { @@ -1032,7 +1173,7 @@ namespace eval punk::mix::commandset::scriptwrap { } - if {$opt_outputfolder eq "\uFFFF"} { + if {$opt_outputfolder eq ""} { #outputfolder not explicitly specified by caller if {[string length $projectroot]} { set output_folder [file join $projectroot/bin] @@ -1056,13 +1197,36 @@ namespace eval punk::mix::commandset::scriptwrap { #todo - #output_file extension may also depend on the template being used.. and/or the .wrapconfig - if {$::tcl_platform(platform) eq "windows"} { - set output_extension cmd + #output_file extension may also depend on the template being used.. and/or the _wrap.toml config + + if {[dict size $configd]} { + package require platform + set thisplatform [string tolower [platform::identify]] + set ptype [lindex [split $thisplatform -] 0] + switch -- $ptype { + win32 - dragonflybsd - freebsd - netbsd - linux - macosx {} + default { + set ptype other + } + } + set out [dict get $configd $ptype outputfile] + set output_file [file join $output_folder $out] } else { - set output_extension sh + #no _wrap.toml file available + if {$::tcl_platform(platform) eq "windows"} { + set output_extension .cmd + } else { + set output_extension .sh + } + if {$scriptset ne ""} { + set output_file [file join $output_folder $scriptset$output_extension] + } else { + set infile [lindex $list_input_files 0] + set output_file [file join $output_folder [file rootname [file tail $infile]]$output_extension] + } } - set output_file [file join $output_folder $scriptset.$output_extension] + + if {[file exists $output_file]} { set fdexisting [open $output_file r] fconfigure $fdexisting -translation binary @@ -1103,13 +1267,10 @@ namespace eval punk::mix::commandset::scriptwrap { #foreach ln $template_lines { #} - set list_input_files [list] - if {$process_extensions eq "ALLFOUNDORCONFIGURED"} { - #todo - look for .wrapconfig or all extensions for the scriptset - puts stderr "Sorry - only single input file supported. Supply a file extension or use a .wrapconfig with a single input file for now - implementation incomplete" + if {[llength $list_input_files] > 1} { + #todo + puts stderr "Sorry - only single input file supported. Supply a file extension or use a _wrap.toml config with a single input file for now - implementation incomplete" return false - } else { - lappend list_input_files $scriptroot/$scriptset.$ext } #todo - split template at each etc marker and build a dict of parts @@ -1117,7 +1278,6 @@ namespace eval punk::mix::commandset::scriptwrap { #hack - process one input set filepath [lindex $list_input_files 0] - set fdscript [open $filepath r] fconfigure $fdscript -translation binary set script_data [read $fdscript] @@ -1131,7 +1291,8 @@ namespace eval punk::mix::commandset::scriptwrap { } puts stdout "-----------------------------------------------\n" puts stdout "Target for above script data is '$output_file'" - set lang [dict get $extension_langs [string tolower $ext]] + set script_ext [string trim [file extension $filepath] .] + set lang [dict get $extension_langs [string tolower $script_ext]] puts stdout "Language of script being wrapped is $lang" if {$opt_askme} { set answer [util::askuser "Does this look correct? Y|N"] diff --git a/src/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd b/src/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd index 2975975d..9daf7ebf 100644 --- a/src/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd +++ b/src/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd @@ -209,6 +209,8 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' SET task_exitcode=66 @REM boundary padding @REM boundary padding + @REM boundary padding + @REM boundary padding GOTO :exit_multishell ) ) @@ -223,7 +225,9 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' @SET "name=%~nx1" @SET "drive=%~d1" @SET "rtrn=%~2" - @SET "result=/mnt/%drive:~0,1%%_path:\=/%%name%" + @REM Although drive letters on windows are normally upper case wslbash seems to expect lower case drive letters + @CALL :stringToLower %drive ldrive + @SET "result=/mnt/%ldrive:~0,1%%_path:\=/%%name%" @ENDLOCAL & ( @if "%~2" neq "" ( SET "%rtrn%=%result%" @@ -336,7 +340,8 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' ) ) @EXIT /B - +@REM boundary padding +@REM boundary padding :stringToUpper @SETLOCAL @SET "rtrn=%~2" @@ -354,6 +359,25 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' ) ) @EXIT /B +:stringToLower +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "retstring=%~1" + @FOR %%A in (a b c d e f g h i j k l m n o p q r s t u v w x y z) DO @( + @SET "retstring=!retstring:%%A=%%A!" + ) + @SET "result=!retstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringToLower %string% result: %result% + ) +) +@EXIT /B +@REM boundary padding +@REM boundary padding :stringTrimTrailingUnderscores @SETLOCAL @SET "rtrn=%~2" @@ -397,6 +421,7 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' :endlib : \ @REM padding +@REM padding @REM @SET taskexit_code=!errorlevel! & goto :exit_multishell @GOTO :exit_multishell # } diff --git a/src/modules/punk/ns-999999.0a1.0.tm b/src/modules/punk/ns-999999.0a1.0.tm index 0bbf4d5a..022a4a0f 100644 --- a/src/modules/punk/ns-999999.0a1.0.tm +++ b/src/modules/punk/ns-999999.0a1.0.tm @@ -444,9 +444,8 @@ tcl::namespace::eval punk::ns { set nspath [string map {:::: ::} $nspath] set mapped [string map {:: \u0FFF} $nspath] set parts [split $mapped \u0FFF] - if {[lindex $parts end] eq ""} { - - } + #if {[lindex $parts end] eq ""} { + #} return $parts } @@ -531,6 +530,21 @@ tcl::namespace::eval punk::ns { return [regexp [dict get $ns_re_cache $glob] $path] } + #namespace tree without globbing or weird ns consideration + proc nstree_raw {{location ::}} { + if {![string match ::* $location]} { + error "nstree_raw requires a fully qualified namespace" + } + nstree_rawlist $location + } + proc nstree_rawlist {location} { + set nslist [list $location] + foreach ch [::namespace children $location] { + lappend nslist {*}[nstree_rawlist $ch] + } + return $nslist + } + proc nstree {{location ""}} { if {![string match ::* $location]} { set nscaller [uplevel 1 {::namespace current}] @@ -3899,6 +3913,7 @@ tcl::namespace::eval punk::ns { } proc _pkguse_vars {varnames} { + #review - obsolete? while {"pkguse_vars_[incr n]" in $varnames} {} #return [concat $varnames pkguse_vars_$n] return [list {*}$varnames pkguse_vars_$n] @@ -3932,10 +3947,12 @@ tcl::namespace::eval punk::ns { #load package and move to namespace of same name if run interactively with only pkg/namespace argument. #if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock #if no newline or $args in the script - treat as one-liner and supply {*}$args automatically + variable pkguse_package_to_namespace [dict create] proc pkguse {args} { + variable pkguse_package_to_namespace set argd [punk::args::parse $args withid ::punk::ns::pkguse] lassign [dict values $argd] leaders opts values received - puts stderr "leaders:$leaders opts:$opts values:$values received:$received" + #puts stderr "leaders:$leaders opts:$opts values:$values received:$received" set pkg_or_existing_ns [dict get $leaders pkg_or_existing_ns] if {[dict exists $received script]} { @@ -3967,68 +3984,159 @@ tcl::namespace::eval punk::ns { set ver "";# tcl version? } default { - if {[string match ::* $pkg_or_existing_ns]} { - set pkg_unqualified [string range $pkg_or_existing_ns 2 end] - if {![tcl::namespace::exists $pkg_or_existing_ns]} { - set ver [package require $pkg_unqualified] - } else { - set ver "" - } + #- comparing namespaces_before vs namespaces_after only works if the package was not previously loaded + #we could either go to the somewhat expensive route of steaming up an interp with the same auto_path & tcl::tm::list each time.. + #or cache the result of the namespace we picked for later pkguse calls (pkguse_package_to_namespace dict) + #we are using the cache method - but this also doesn't help for packages previously loaded by normal package require + #our aim is for pkguse to be deterministic in what namespace it finds - even if it doesn't always get the ideal one (e.g cookiejar, see below) + #To determine appropriate namespace for already loaded packages where we have no cache entry - we may still need the helper interp mechanism + #The helper interp could be persistent - but only so long as the auto_path/tcl::tm::list values are in sync + #review. + + #also see img::png img::raw etc + #these don't directly load namespaces or direct commands.. just change behaviour of existing commands? + #but they can load things like tk (ttk namespace) first one creates ::tkimg? + + if {[string match ::* $pkg_or_existing_ns] && [tcl::namespace::exists $pkg_or_existing_ns]} { + #pkguse on an existing full qualified namespace does no package require set ns $pkg_or_existing_ns + set ver "" } else { - set pkg_unqualified $pkg_or_existing_ns - set ver [package require $pkg_unqualified] - set ns ::$pkg_unqualified - } - #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index - set previous_command_count 0 - if {[namespace exists $ns]} { - set previous_command_count [llength [info commands ${ns}::*]] - } + if {[string match ::* $pkg_or_existing_ns]} { + set pkg_unqualified [string range $pkg_or_existing_ns 2 end] + } else { + set pkg_unqualified $pkg_or_existing_ns + } + #foreach equiv of while 1 - just to allow early exit with break + foreach code_block single { + if {[dict exists $pkguse_package_to_namespace $pkg_unqualified]} { + set ns [dict get $pkguse_package_to_namespace $pkg_unqualified] + set ver [package provide $pkg_unqualified] + break + } + if {[package provide $pkg_unqualified] ne ""} { + #package has already been loaded + if {[namespace exists ::$pkg_unqualified]} { + set ns ::$pkg_unqualified + set ver [package provide $pkg_unqualified] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + break + } + #existing package but no matching namespace.. + #- load in throwaway interp and see what cmds/namespaces created + interp create nstest + try { + nstest eval {tcl::tm::remove {*}[tcl::tm::list]} + nstest eval [list tcl::tm::add {*}[lreverse [tcl::tm::list]]] + nstest eval [list set ::auto_path $::auto_path] + nstest eval {package require punk::ns} + set ns "" + if {![catch {nstest eval [list punk::ns::pkguse $pkg_unqualified]} errMsg]} { + set script [string map [list %p% $pkg_unqualified] {dict get $::punk::ns::pkguse_package_to_namespace %p%}] + set ns [nstest eval $script] + } else { + puts "couldn't test pkg $pkg_unqualified\n$errMsg" + } + } finally { + interp delete nstest + } - #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands - #for the purposes of pkguse - which most commonly interactive - we want the namespace populated - #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + set ver [package provide $pkg_unqualified] + break + } - if {!$ns_populated} { - #we will catch-run an auto_index entry if any - #auto_index entry may or may not be prefixed with :: - set keys [list] - #first look for exact pkg_unqualified and ::pkg_unqualified - #leave these at beginning of keys list - if {[array exists ::auto_index($pkg_unqualified)]} { - lappend keys $pkg_unqualified - } - if {[array exists ::auto_index(::$pkg_unqualified)]} { - lappend keys ::$pkg_unqualified - } - #as auto_index is an array - we could get keys in arbitrary order - set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] - lappend keys {*}$matches - set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] - lappend keys {*}$matches - set ns_populated 0 - set i 0 - set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing - set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] - while {!$ns_populated && $i < [llength $keys]} { - #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base - #e.g if we are loading ::x::y - #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc - set k [lindex $keys $i] - set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] - if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { - set auto_source [set ::auto_index($k)] - if {$auto_source ni $already_sourced} { - uplevel 1 $auto_source - lappend already_sourced $auto_source - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + #pkg not loaded + set namespaces_before [nstree_rawlist ::] ;#approx 1ms for 500 or so namespaces - not cheap but bearable + #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index + #gathering prior cmdcount for every ns in system is also a somewhat expensive operation.. review + #we don't know for sure that the namespace for the package require operation actually matches the package name + #e.g tcllib inifile package uses namespace ::ini + #e.g sqlite3 package adds commands to the global namespace + set dict_ns_commandcounts [dict create] + foreach nsb $namespaces_before { + dict set dict_ns_commandcounts $nsb [llength [info commands ${nsb}::*]] + } + + set ver [package require $pkg_unqualified] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + set namespaces_after [nstree_rawlist ::] + + if {[llength $namespaces_after] > [llength $namespaces_before]} { + set namespaces_new [struct::set difference $namespaces_after $namespaces_before] + if {$ns ni $namespaces_new} { + #todo - use shortest result? what if this is a namespace from a required sub package? + #e.g cookiejar loads sqlite3,http,tcl::idna which creates ::sqlite3 etc - but cookiejar just creates an object at ::http::cookiejar + #In this specific case we end up in oo::ObjXXX - but would be better placed in ::http, where the new cookiejar command resides + #review - todo? + set pkgs [package names] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + #find something new - that doesn't match another package name + foreach new $namespaces_new { + if {[lsearch $pkgs [string trimleft $new :]] == -1} { + set ns $new + break + } + } } } - incr i - } + if {[tcl::namespace::exists $ns]} { + #review - only cache if exists? + dict set pkguse_package_to_namespace $pkg_unqualified $ns; + } + set previous_command_count 0 + if {[dict exists $dict_ns_commandcounts $ns]} { + set previous_command_count [dict get $dict_ns_commandcounts $ns] + } + + #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands + #for the purposes of pkguse - which most commonly interactive - we want the namespace populated + #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + + if {!$ns_populated} { + #we will catch-run an auto_index entry if any + #auto_index entry may or may not be prefixed with :: + set keys [list] + #first look for exact pkg_unqualified and ::pkg_unqualified + #leave these at beginning of keys list + if {[array exists ::auto_index($pkg_unqualified)]} { + lappend keys $pkg_unqualified + } + if {[array exists ::auto_index(::$pkg_unqualified)]} { + lappend keys ::$pkg_unqualified + } + #as auto_index is an array - we could get keys in arbitrary order + set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] + lappend keys {*}$matches + set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] + lappend keys {*}$matches + set ns_populated 0 + set i 0 + set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing + set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] + while {!$ns_populated && $i < [llength $keys]} { + #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base + #e.g if we are loading ::x::y + #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc + set k [lindex $keys $i] + set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] + if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { + set auto_source [set ::auto_index($k)] + if {$auto_source ni $already_sourced} { + puts stderr "pkguse sourcing auto_index script $auto_source" + uplevel 1 $auto_source + lappend already_sourced $auto_source + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + } + } + incr i + } + + } + + }; # end foreach code_block single - scope for use of 'break' } } diff --git a/src/modules/punk/repl-999999.0a1.0.tm b/src/modules/punk/repl-999999.0a1.0.tm index 53dc3153..25ecd92a 100644 --- a/src/modules/punk/repl-999999.0a1.0.tm +++ b/src/modules/punk/repl-999999.0a1.0.tm @@ -3567,7 +3567,6 @@ namespace eval repl { if {[catch { package require punk::args - catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical package require punk::config package require punk::ns #puts stderr "loading natsort" @@ -3589,6 +3588,7 @@ namespace eval repl { }} [punk::config::configure running] package require textblock + catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical } errM]} { puts stderr "========================" puts stderr "code interp error:" diff --git a/src/modules/textblock-999999.0a1.0.tm b/src/modules/textblock-999999.0a1.0.tm index ae286f36..c7e44294 100644 --- a/src/modules/textblock-999999.0a1.0.tm +++ b/src/modules/textblock-999999.0a1.0.tm @@ -6007,7 +6007,7 @@ tcl::namespace::eval textblock { proc welcome_test {} { package require punk::ansi - set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/roy-welc.ans 80x8]] + set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/ROY-WELC.ANS 80x8]] # Ansi art courtesy of Carsten Cumbrowski aka Roy/SAC - roysac.com set table [[textblock::spantest] print] set punks [a+ web-lawngreen][>punk . lhs][a]\n\n[a+ rgb#FFFF00][>punk . rhs][a] diff --git a/src/project_layouts/custom/_project/punk.basic/src/make.tcl b/src/project_layouts/custom/_project/punk.basic/src/make.tcl index 2de13afb..37f36a9a 100644 --- a/src/project_layouts/custom/_project/punk.basic/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.basic/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] } @@ -1077,10 +1077,16 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - This help." \n \n append h " $scriptname project ?-k?" \n append h " - this is the literal word project - and confirms you want to run the project build - which includes src/vfs/* checks and builds" \n - append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n - append h " - built modules go into /modules /lib etc." \n \n + append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n + append h " - builds/copies .tm modules from src to /modules etc and pkgIndex.tcl based libraries from src to /lib etc." \n \n append h " $scriptname modules" \n - append h " - build modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " - build (or copy if build not required) .tm modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname libs" \n + append h " - build (or copy if build not required) pkgIndex.tcl based libraries from src/lib src/vendorlib etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname packages" \n + append h " - build (or copy if build not required) both .tm and pkgIndex.tcl based packages from src to their corresponding locations under " \n append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n append h " $scriptname bootsupport" \n append h " - update the src/bootsupport modules as well as the mixtemplates/layouts//src/bootsupport modules if the folder exists" \n @@ -1089,6 +1095,7 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - bootsupport modules are available to make.tcl" \n \n append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n + append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -1213,6 +1220,8 @@ if {![string length [set projectroot [punk::repo::find_project $scriptfolder]]]} } set sourcefolder $projectroot/src +set binfolder $projectroot/bin + if {$::punkboot::command eq "check"} { set sep [string repeat - 75] puts stdout $sep @@ -1348,8 +1357,8 @@ if {$::punkboot::command eq "info"} { puts stdout "- -- --- --- --- --- --- --- --- --- -- -" puts stdout "- projectroot : $projectroot" set sourcefolder $projectroot/src - set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib_tcl*] - set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules_tcl*] + set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] + set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] puts stdout "- vendorlib folders: ([llength $vendorlibfolders])" foreach fld $vendorlibfolders { puts stdout " src/$fld" @@ -1358,13 +1367,18 @@ if {$::punkboot::command eq "info"} { foreach fld $vendormodulefolders { puts stdout " src/$fld" } - set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] - puts stdout "- source module paths: [llength $source_module_folderlist]" - foreach fld $source_module_folderlist { + #set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] ;#returns only those containing .tm files + #foreach fld $source_module_folderlist { + # set relpath [punkcheck::lib::path_relative $projectroot $fld] + # puts stdout " $relpath" + #} + set projectmodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails modules_tcl* modules] + puts stdout "- source module paths: [llength $projectmodulefolders]" + #JJJ + foreach fld $projectmodulefolders { puts stdout " $fld" } - set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] - lappend projectlibfolders lib + set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl* lib] puts stdout "- source libary paths: [llength $projectlibfolders]" foreach fld $projectlibfolders { puts stdout " src/$fld" @@ -1759,7 +1773,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules vfs}} { +if {$::punkboot::command ni {project modules libs packages vfs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -1772,7 +1786,7 @@ if {$::punkboot::command ni {project modules vfs}} { #install src vendor contents (from version controlled src folder) to base of project (same target folders as our own src/modules etc ie to paths that go on the auto_path and in tcl::tm::list) -if {$::punkboot::command in {project modules}} { +if {$::punkboot::command in {project packages modules}} { set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] foreach vf $vendormodulefolders { lassign [split $vf _] _vm tclx @@ -1797,7 +1811,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendormodulefolders]} { puts stderr "VENDORMODULES: No src/vendormodules or src/vendormodules_tcl* folders found." } +} +if {$::punkboot::command in {project packages libs}} { set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] foreach lf $vendorlibfolders { lassign [split $lf _] _vm tclx @@ -1827,8 +1843,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendorlibfolders]} { puts stderr "VENDORLIB: No src/vendorlib or src/vendorlib_tcl* folder found." } +} - +if {$::punkboot::command in {project packages modules libs}} { ######################################################## #templates #e.g The default project layout is mainly folder structure and readme files - but has some scripts developed under the main src that we want to sync @@ -1896,6 +1913,9 @@ if {$::punkboot::command in {project modules}} { $tpl_installer destroy } } +} + +if {$::punkboot::command in {project packages libs}} { ######################################################## set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] lappend projectlibfolders lib @@ -1927,7 +1947,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $projectlibfolders]} { puts stderr "PROJECTLIB: No src/lib or src/lib_tcl* folder found." } +} +if {$::punkboot::command in {project packages modules}} { #consolidated /modules /modules_tclX folder used for target where X is tcl major version #the make process will process for any _tclX not just the major version of the current interpreter @@ -1964,9 +1986,10 @@ if {$::punkboot::command in {project modules}} { ] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } +} +if {$::punkboot::command in {project packages modules libs}} { set installername "make.tcl" - # ---------------------------------------- if {[punk::repo::is_fossil_root $projectroot]} { set config [dict create\ @@ -2013,7 +2036,7 @@ if {$::punkboot::command in {project modules}} { #review set installername "make.tcl" -if {$::punkboot::command ni {project vfs}} { +if {$::punkboot::command ni {project vfs bin}} { #command = modules puts stdout "vfs folders not checked" puts stdout " - use 'make.tcl vfscommonupdate' to copy built modules into base vfs folder" @@ -2033,6 +2056,17 @@ if {$buildfolder ne "$sourcefolder/_build"} { exit 2 } +if {$::punkboot::command eq "bin"} { + puts stdout "checking $sourcefolder/bin" + set resultdict [punkcheck::install $sourcefolder/bin $binfolder\ + -overwrite synced-targets\ + -installer "punkboot-bin"\ + -progresschannel stdout\ + ] + + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout +} #find runtimes set rtfolder $sourcefolder/runtime @@ -2056,11 +2090,32 @@ if {![llength $runtimes]} { } set has_sdx 1 -if {[catch {exec sdx help} errM]} { - puts stderr "FAILED to find usable sdx command - check that sdx executable is on path" - puts stderr "err: $errM" - #exit 1 - set has_sdx 0 +set sdxpath [auto_execok $binfolder/sdx] +if {$sdxpath eq ""} { + set sdxpath [auto_execok [file dirname [info nameofexecutable]]/sdx] + if {$sdxpath eq ""} { + #last resort - look on path + set sdxpath [auto_execok sdx] + } + if {$sdxpath eq ""} { + #last resort - a tclkit and sdx.kit fine + if {[file exists $binfolder/sdx.kit]} { + set tclkitpath [auto_execok $binfolder/tclkit] + if {$tclkitpath eq ""} { + set tclkitpath [auto_execok tclkit] + } + set sdxpath [list {*}$tclkitpath $binfolder/sdx.kit] + } + } + + if {$sdxpath eq "" || [catch {exec {*}$sdxpath help} errM]} { + puts stderr "FAILED to find usable sdx command or tclkit executable with sdx.bat" + puts stderr "If tclkit-based runtimes are required - check that sdx executable is in bin folder of project or in same folder as tcl/punk executable or on path" + puts stderr "This is not a problem if tcl8.7/tcl9+ kits using the preferred method 'zipfs' are to be used, or if cookfs based kits are to be used." + puts stderr "err: $errM" + #exit 1 + set has_sdx 0 + } } # -- --- --- --- --- --- --- --- --- --- @@ -2825,17 +2880,17 @@ foreach vfstail $vfs_tails { if {[catch { if {$rtname ne "-"} { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose } else { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose } } result]} { if {$rtname ne "-"} { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" } else { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" } - puts stderr "sdx wrap $targetkit failed" + puts stderr "$::sdxpath wrap $targetkit failed" lappend failed_kits [list kit $targetkit reason $sdxmsg] $vfs_event targetset_end FAILED $vfs_event destroy @@ -3022,6 +3077,7 @@ foreach vfstail $vfs_tails { } ;#end foreach rtname in runtimes # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } + cd $startdir if {[llength $installed_kits]} { puts stdout "INSTALLED KITS: ([llength $installed_kits])" diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm index a4f56010..1b15d45a 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm @@ -890,10 +890,10 @@ tcl::namespace::eval punk::libunknown { set prev_e [dict get $epoch pkg current] set current_e [expr {$prev_e + 1}] # ------------- - puts stderr "--> pkg epoch $prev_e -> $current_e" - puts stderr "args: $args" - puts stderr "last_auto: $last_auto_path" - puts stderr "auto_path: $auto_path" + #puts stderr "--> pkg epoch $prev_e -> $current_e" + #puts stderr "args: $args" + #puts stderr "last_auto: $last_auto_path" + #puts stderr "auto_path: $auto_path" # ------------- if {[llength $auto_path] > [llength $last_auto_path] && [punk::libunknown::lib::is_list_all_in_list $last_auto_path $auto_path]} { #The auto_path changed, and is a pure addition of entry/entries diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm index 8ef36e27..06b145de 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm @@ -20,7 +20,7 @@ #[manpage_begin punkshell_module_scriptwrap 0 0.1.0] #[copyright "2024"] #[titledesc {scriptwrap polyglot tool}] [comment {-- Name section and table of contents description --}] -#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] +#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] #[require punk::mix::commandset::scriptwrap] #[keywords module commandset launcher scriptwrap] #[description] @@ -30,7 +30,7 @@ #*** !doctools #[section Overview] -#[para] overview of scriptwrap +#[para] overview of scriptwrap #[subsection Concepts] #[para] - @@ -74,7 +74,7 @@ package require punk::fileline namespace eval punk::mix::commandset::scriptwrap { #*** !doctools #[subsection {Namespace punk::mix::commandset::scriptwrap}] - #[para] Core API functions for punk::mix::commandset::scriptwrap + #[para] Core API functions for punk::mix::commandset::scriptwrap #[list_begin definitions] namespace export * @@ -93,7 +93,7 @@ namespace eval punk::mix::commandset::scriptwrap { foreach k [lreverse [dict keys $tdict_low_to_high]] { dict set tdict $k [dict get $tdict_low_to_high $k] } - + #set pathinfolist [dict values $tdict] set names [dict keys $tdict] @@ -142,9 +142,9 @@ namespace eval punk::mix::commandset::scriptwrap { put stderr "commandset::scriptwrap::templates_dict WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } return - } - - + } + + #A batch file with unix line-endings is sensitive to label positioning. #batch file with windows crlf line endings can exhibit this problem - but probably only if specifically crafted with long lines deliberately designed to trigger it. #see: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 (Call and goto may fail when the batch file has Unix line endings) @@ -808,176 +808,317 @@ namespace eval punk::mix::commandset::scriptwrap { return $result } #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site - #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf - proc multishell {filepath_or_scriptset args} { - set opts [dict create\ - -askme 1\ - -outputfolder "\uFFFF"\ - -template "\uFFFF"\ - -returnextra 0\ - -force 0\ - ] - #set known_opts [dict keys $defaults] - foreach {k v} $args { - switch -- $k { - -askme - -outputfolder - -template - -returnextra - -force { - dict set opts $k $v - } - default { - error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" - } + #scriptset name to substitute multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf + #set usage "" + #append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n + #append usage "The scriptset name will be used to search for .sh|.tcl|.ps1 or names as you specify in yourname.wrapconfig if it exists" \n + #append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n + #if {![string length $filepath_or_scriptset]} { + # puts stderr "No filepath_or_scriptset specified" + # puts stderr $usage + # return false + #} + proc _read_scriptset_wrap_tomlfile {fname} { + set resultd [dict create] + package require tomlish + set tomldata [readFile $fname] + #todo - fix tomlish to provide line number in ERROR structure during from_toml call. + if {[catch {tomlish::to_dict [tomlish::from_toml $tomldata]} tomldict]} { + puts stderr "Failed to parse $fname" + puts stderr "error: $tomldict" + } + if {[tomlish::dict::path::exists $tomldict {.application.template}]} { + dict set resultd template [tomlish::dict::path::get $tomldict {.application.template.value}] + } + set scripts [list] + if {[tomlish::dict::path::exists $tomldict {.application.scripts.value}]} { + set arrvalues [tomlish::dict::path::get $tomldict {.application.scripts.value}] + foreach tvdict $arrvalues { + lappend scripts [dict get $tvdict value] } } + dict set resultd scripts $scripts - set usage "" - append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n - append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n - append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n - if {![string length $filepath_or_scriptset]} { - puts stderr "No filepath_or_scriptset specified" - puts stderr $usage - return false + set ftail [file rootname [file tail $fname]] ;#e.g example_wrap.toml + set scriptset [lindex [split $ftail _] 0] + set fallback_outputfile $scriptset.cmd + set fallback_nextshellpath "/usr/bin/env tclsh" + set fallback_nextshelltype "tcl" + + if {[tomlish::dict::path::exists $tomldict {.application.default_outputfile.value}]} { + dict set resultd default_outputfile [tomlish::dict::path::get $tomldict {.application.default_outputfile.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshellpath.value}]} { + dict set resultd default_nextshellpath [tomlish::dict::path::get $tomldict {.application.default_nextshellpath.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshelltype.value}]} { + dict set resultd default_nextshelltype [tomlish::dict::path::get $tomldict {.application.default_nextshelltype.value}] + } + foreach platform {win32 dragonflybsd freebsd netbsd linux macosx other} { + set d [dict create] + foreach field {outputfile nextshellpath nextshelltype} { + if {[tomlish::dict::path::exists $tomldict ".application.$platform.$field.value"]} { + dict set d $field [tomlish::dict::path::get $tomldict ".application.$platform.$field.value"] + } else { + if {[dict exists $resultd default_$field]} { + dict set d $field [dict get $resultd default_$field] + } else { + dict set d $field [set fallback_$field] + } + } + } + dict set resultd $platform $d } + + return $resultd + } + punk::args::define { + @id -id ::punk::mix::commandset::scriptwrap::multishell + @cmd -name punk::mix::commandset::scriptwrap::multishell\ + -summary\ + "Wrap script(s) into a polyglot cross-platform executable script."\ + -help\ + "Create a polyglot executable script that wraps constituent scripts written in + various scripting languages such as perl, tcl, shell script, powershell. + The resulting polyglot file should run cross platform on windows and various + types of unix-like OS. For use on windows the output file should be named with + a .bat or .cmd extension - but the same file with extension removed should also + be capable of running on FreeBSD, Linux etc. + Note that a polyglot script such as this may be somewhat brittle over the long + term with regards to default shells and scripting languages across platforms." + @leaders -min 1 -max 1 + filepath_or_scriptset -type string -minsize 1 -help\ + "Supply the path to a single script file to wrap, or the name of a scriptset. + The scriptset name will be used to search for .sh|.bash|.tcl|.ps1|.pl + or alternatively, names as specified in a configuration file named _wrap.toml + if it exists in the current folder, or is specified with a full path name. + If no template name/path is specified in a _wrap.toml file and no + -template argument is supplied the default punk.multishell.cmd will be used. + If the template is specified explicitly in -template as well as in the .toml + file - the supplied -template argument will override that specified in the + .toml file." + @opts + -template -type string -default "punk.multishell.cmd" -help\ + "Templates are provided from modules or paths in the current project, + so available templates will vary based on whether the multishell + command is being run from within a project directory or not. + To see available templates use punk::mix::commandset::scriptwrap::templates." + -outputfolder -type directory -default "" -help\ + "Folder to which to write resulting polyglot script. + If empty, the output will go to the /bin folder or + to the current working directory if there is no projectroot." + -askme -type boolean -default 1 -help\ + "Prompt user at console (stdin) for confirmation of operations such as + overwrite." + -force -type boolean -default 0 + -returnextra -type boolean -default 0 + @values -minvalues 0 -maxvalues 0 + } + #: + #@SET "nextshellpath[win32___________]=tclsh___________________________" + #@SET "nextshelltype[win32___________]=tcl_____________" + #@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[dragonflybsd____]=tcl_____________" + #@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[freebsd_________]=tcl_____________" + #@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[netbsd__________]=tcl_____________" + #@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[linux___________]=tcl_____________" + #@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[macosx__________]=tcl_____________" + #@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[other___________]=tcl_____________" + #: + proc multishell {args} { + set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::multishell] + lassign [dict values $argd] leaders opts values received + # -- --- --- --- --- --- --- --- --- --- --- --- - set opt_askme [dict get $opts -askme] - set opt_template [dict get $opts -template] - set opt_outputfolder [dict get $opts -outputfolder] - set opt_returnextra [dict get $opts -returnextra] - set opt_force [dict get $opts -force] + set filepath_or_scriptset [dict get $leaders filepath_or_scriptset] + set opt_askme [dict get $opts -askme] + set opt_template [dict get $opts -template] ;#use dict exists $received -template to see if overridable in .toml + set opt_outputfolder [dict get $opts -outputfolder] + set opt_returnextra [dict get $opts -returnextra] + set opt_force [dict get $opts -force] # -- --- --- --- --- --- --- --- --- --- --- --- - set ext [file extension $filepath_or_scriptset] set startdir [pwd] + set allowed_extensions [list tcl ps1 sh bash pl] + #TODO - distinct sections for sh vs bash? needs experiments.. + #for now we use shell-pre-launch-subprocess etc + #set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] + set extension_langs [list tcl tcl ps1 powershell sh shell bash shell pl perl] + + if {[file pathtype $filepath_or_scriptset] ni {absolute relative}} { + error "bad pathtype for '$filepath_or_scriptset' (expected absolute or relative path, or name of scriptset)" + } - - - #first check if relative or absolute path matches a file + #first check if absolute path matches a file or relative path from cwd matches a file if {[file pathtype $filepath_or_scriptset] eq "absolute"} { - set specified_path $filepath_or_scriptset + set specified_path $filepath_or_scriptset } else { set specified_path [file join $startdir $filepath_or_scriptset] } + set scriptdir [file dirname $specified_path] + set ext [string trim [file extension $filepath_or_scriptset] .] - set allowed_extensions [list wrapconfig tcl ps1 sh bash pl] - set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] - #set allowed_extensions [list tcl] - set found_script 0 - if {[file exists $specified_path]} { - set found_script 1 + set scriptset "" + if {$ext eq ""} { + set scriptset [file rootname [file tail $specified_path]] + } elseif {$ext eq "toml"} { + set tomltail [file tail $specified_path] + if {[string match *_wrap.toml $tomltail]} { + set scriptset [lindex [split $tomltail _] 0] + #if .toml was specified - the config file must exist + if {![file exists $specified_path]} { + if {[file pathtype $filepath_or_scriptset] eq "relative"} { + puts stderr "unable to locate '$specified_path' - will continue search in src/scriptapps folder" + } else { + #caller was specific about path - no fallback to src/scriptapps + error "unable to locate '$specified_path'" + } + } + } else { + error "supplied toml file must be of form _wrap.toml" + } } else { - foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { - if {[file exists $filepath_or_scriptset.$e]} { - set found_script 1 - break + if {$ext ni $allowed_extensions} { + error "supplied filepath_or_scriptset must be the name of a scriptset without extension, a file named _wrap.toml, or a script with one of the extensions: $allowed_extensions" + } + } + + set list_input_files [list] + set configd [dict create] + if {$scriptset ne ""} { + puts stdout "Attempting to process all scripts belonging to scriptset '$scriptset'" + #.toml file may or may not exist + if {[file exists ${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptdir/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptdir/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptdir $s] + } + } + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" + return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptdir" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptdir/$scriptset.$e]} { + lappend list_input_files $scriptdir/$scriptset.$e + } } } + } else { + #expect a single script + if {[file exists $specified_path]} { + lappend list_input_files $specified_path + } } + set found_script [expr {[llength $list_input_files] > 0}] #TODO! - use get_wrapper_folders - multishell should use same available templates as the 'templates' function - set scriptset [file rootname [file tail $specified_path]] if {$found_script} { - if {[file type $specified_path] eq "file"} { - set specified_root [file dirname $specified_path] - set pathinfo [punk::repo::find_repos [file dirname $specified_path]] - set projectroot [dict get $pathinfo closest] + #found scripts at absolute path - or path relative to cwd + set scriptroot $scriptdir + set pathinfo [punk::repo::find_repos $scriptroot] + set projectroot [dict get $pathinfo closest] + if {[file exists $scriptroot/wrappers]} { + set customwrapper_folder $scriptroot/wrappers + } else { + #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder if {[string length $projectroot]} { - #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - set customwrapper_folder $projectroot/src/scriptapps/wrappers - } + set customwrapper_folder $projectroot/src/scriptapps/wrappers } else { #outside of any project - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - #no customwrapper folder available - set customwrapper_folder "" - } + set customwrapper_folder "" } - } else { - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false } } else { + if {[file pathtype $filepath_or_scriptset] eq "absolute"} { + return false + } set pathinfo [punk::repo::find_repos $startdir] set projectroot [dict get $pathinfo closest] - if {[string length $projectroot]} { - if {[llength [file split $filepath_or_scriptset]] > 1} { - puts stderr "filepath_or_scriptset looks like a path - but doesn't seem to point to a file" - puts stderr "Ensure you are within a project and use just the name of the scriptset, or pass in the full correct path or relative path to current directory" - puts stderr $usage - return false - } else { - #we've already ruled out empty string - so must have a single element representing scriptset - possibly with file extension - set scriptroot $projectroot/src/scriptapps - set customwrapper_folder $projectroot/src/scriptapps/wrappers - #check something matches the scriptset.. - set something_found "" - if {[file exists $scriptroot/$scriptset]} { - set found_script 1 - set something_found $scriptroot/$scriptset ;#extensionless file - that's ok too - } else { - foreach e $allowed_extensions { - if {[file exists $scriptroot/$scriptset.$e]} { - set found_script 1 - set something_found $scriptroot/$scriptset.$e - break - } + if {![string length $projectroot]} { + puts stderr "No matching scripts or config found for $filepath_or_scriptset, and you are not within a directory where projectroot and src/scriptapps can be determined" + return false + } + + set scriptroot $projectroot/src/scriptapps + set customwrapper_folder $projectroot/src/scriptapps/wrappers + #check something matches the scriptset.. + if {$scriptset ne ""} { + #.toml file may or may not exist + if {[file exists $scriptroot/${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptroot/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptroot/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptroot $s] } } - if {!$found_script} { - puts stderr "Searched within $scriptroot" - puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" - puts stderr $usage + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" return false - } else { - if {[file type $something_found] ne "file"} { - puts stderr "Found '$something_found'" - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptroot" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptroot/$scriptset.$e]} { + lappend list_input_files $scriptroot/$scriptset.$e } } } - } else { - puts stderr "filepath_or_scriptset parameter doesn't seem to refer to a file, and you are not within a directory where projectroot and src/scriptapps/wrappers can be determined" - puts stderr $usage - return false + #expect a single script + if {[file exists $scriptroot/$filepath_or_scriptset]} { + if {[file type $scriptroot/$filepath_or_scriptset] ne "file"} { + puts stderr "wrap_in_multishell doesn't currently support a directory as the path. path: $scriptroot/$filepath_or_scriptset" + return false + } + lappend list_input_files $scriptroot/$filepath_or_scriptset + } } - } - #assertion - customwrapper_folder var exists - but might be empty + set found_script [expr {[llength $list_input_files] > 0}] - - if {[string length $ext]} { - #If there was an explicitly supplied extension - then that file should exist - if {![file exists $scriptroot/$scriptset.$ext]} { - puts stderr "Explicit extension .$ext was supplied - but matching file not found." - puts stderr $usage - return false - } else { - if {$ext eq "wrapconfig"} { - set process_extensions ALLFOUNDORCONFIGURED + #---------------------- + if {!$found_script} { + puts stderr "Searched within $scriptdir and $scriptroot" + if {$scriptset ne ""} { + puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" } else { - set process_extensions $ext + puts stderr "Unable to find file $filepath_or_scriptset" } + return false } - } else { - #no explicit extension - process all for scriptset - set process_extensions ALLFOUNDORCONFIGURED + } - #process_extensions - either a single one - or all found or as per .wrapconfig + #assertion - customwrapper_folder var exists - but might be empty - if {$opt_template eq "\uFFFF"} { - set templatename punk.multishell.cmd + if {[dict exists $configd template]} { + set templatename [dict get $configd template] } else { - set templatename $opt_template + if {$opt_template eq "\uFFFF"} { + set templatename punk.multishell.cmd + } else { + set templatename $opt_template + } } set templatename_root [file rootname [file tail $templatename]] @@ -995,7 +1136,7 @@ namespace eval punk::mix::commandset::scriptwrap { set template_base_dict [punk::mix::base::lib::get_template_basefolders] set tpldirs [list] dict for {tdir tsourceinfo} $template_base_dict { - set vendor [dict get $tsourceinfo vendor] + set vendor [dict get $tsourceinfo vendor] if {[file exists $tdir/utility/scriptappwrappers/$templatename]} { lappend tpldirs $tdir } elseif {[file exists $tdir/utility/scriptappwrappers/${templatename_fileroot}[file extension $templatename]]} { @@ -1032,7 +1173,7 @@ namespace eval punk::mix::commandset::scriptwrap { } - if {$opt_outputfolder eq "\uFFFF"} { + if {$opt_outputfolder eq ""} { #outputfolder not explicitly specified by caller if {[string length $projectroot]} { set output_folder [file join $projectroot/bin] @@ -1056,13 +1197,36 @@ namespace eval punk::mix::commandset::scriptwrap { #todo - #output_file extension may also depend on the template being used.. and/or the .wrapconfig - if {$::tcl_platform(platform) eq "windows"} { - set output_extension cmd + #output_file extension may also depend on the template being used.. and/or the _wrap.toml config + + if {[dict size $configd]} { + package require platform + set thisplatform [string tolower [platform::identify]] + set ptype [lindex [split $thisplatform -] 0] + switch -- $ptype { + win32 - dragonflybsd - freebsd - netbsd - linux - macosx {} + default { + set ptype other + } + } + set out [dict get $configd $ptype outputfile] + set output_file [file join $output_folder $out] } else { - set output_extension sh + #no _wrap.toml file available + if {$::tcl_platform(platform) eq "windows"} { + set output_extension .cmd + } else { + set output_extension .sh + } + if {$scriptset ne ""} { + set output_file [file join $output_folder $scriptset$output_extension] + } else { + set infile [lindex $list_input_files 0] + set output_file [file join $output_folder [file rootname [file tail $infile]]$output_extension] + } } - set output_file [file join $output_folder $scriptset.$output_extension] + + if {[file exists $output_file]} { set fdexisting [open $output_file r] fconfigure $fdexisting -translation binary @@ -1103,13 +1267,10 @@ namespace eval punk::mix::commandset::scriptwrap { #foreach ln $template_lines { #} - set list_input_files [list] - if {$process_extensions eq "ALLFOUNDORCONFIGURED"} { - #todo - look for .wrapconfig or all extensions for the scriptset - puts stderr "Sorry - only single input file supported. Supply a file extension or use a .wrapconfig with a single input file for now - implementation incomplete" + if {[llength $list_input_files] > 1} { + #todo + puts stderr "Sorry - only single input file supported. Supply a file extension or use a _wrap.toml config with a single input file for now - implementation incomplete" return false - } else { - lappend list_input_files $scriptroot/$scriptset.$ext } #todo - split template at each etc marker and build a dict of parts @@ -1117,7 +1278,6 @@ namespace eval punk::mix::commandset::scriptwrap { #hack - process one input set filepath [lindex $list_input_files 0] - set fdscript [open $filepath r] fconfigure $fdscript -translation binary set script_data [read $fdscript] @@ -1131,7 +1291,8 @@ namespace eval punk::mix::commandset::scriptwrap { } puts stdout "-----------------------------------------------\n" puts stdout "Target for above script data is '$output_file'" - set lang [dict get $extension_langs [string tolower $ext]] + set script_ext [string trim [file extension $filepath] .] + set lang [dict get $extension_langs [string tolower $script_ext]] puts stdout "Language of script being wrapped is $lang" if {$opt_askme} { set answer [util::askuser "Does this look correct? Y|N"] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm index 6bd826e2..f8e55b02 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -444,9 +444,8 @@ tcl::namespace::eval punk::ns { set nspath [string map {:::: ::} $nspath] set mapped [string map {:: \u0FFF} $nspath] set parts [split $mapped \u0FFF] - if {[lindex $parts end] eq ""} { - - } + #if {[lindex $parts end] eq ""} { + #} return $parts } @@ -531,6 +530,21 @@ tcl::namespace::eval punk::ns { return [regexp [dict get $ns_re_cache $glob] $path] } + #namespace tree without globbing or weird ns consideration + proc nstree_raw {{location ::}} { + if {![string match ::* $location]} { + error "nstree_raw requires a fully qualified namespace" + } + nstree_rawlist $location + } + proc nstree_rawlist {location} { + set nslist [list $location] + foreach ch [::namespace children $location] { + lappend nslist {*}[nstree_rawlist $ch] + } + return $nslist + } + proc nstree {{location ""}} { if {![string match ::* $location]} { set nscaller [uplevel 1 {::namespace current}] @@ -3899,6 +3913,7 @@ tcl::namespace::eval punk::ns { } proc _pkguse_vars {varnames} { + #review - obsolete? while {"pkguse_vars_[incr n]" in $varnames} {} #return [concat $varnames pkguse_vars_$n] return [list {*}$varnames pkguse_vars_$n] @@ -3932,10 +3947,12 @@ tcl::namespace::eval punk::ns { #load package and move to namespace of same name if run interactively with only pkg/namespace argument. #if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock #if no newline or $args in the script - treat as one-liner and supply {*}$args automatically + variable pkguse_package_to_namespace [dict create] proc pkguse {args} { + variable pkguse_package_to_namespace set argd [punk::args::parse $args withid ::punk::ns::pkguse] lassign [dict values $argd] leaders opts values received - puts stderr "leaders:$leaders opts:$opts values:$values received:$received" + #puts stderr "leaders:$leaders opts:$opts values:$values received:$received" set pkg_or_existing_ns [dict get $leaders pkg_or_existing_ns] if {[dict exists $received script]} { @@ -3967,68 +3984,159 @@ tcl::namespace::eval punk::ns { set ver "";# tcl version? } default { - if {[string match ::* $pkg_or_existing_ns]} { - set pkg_unqualified [string range $pkg_or_existing_ns 2 end] - if {![tcl::namespace::exists $pkg_or_existing_ns]} { - set ver [package require $pkg_unqualified] - } else { - set ver "" - } + #- comparing namespaces_before vs namespaces_after only works if the package was not previously loaded + #we could either go to the somewhat expensive route of steaming up an interp with the same auto_path & tcl::tm::list each time.. + #or cache the result of the namespace we picked for later pkguse calls (pkguse_package_to_namespace dict) + #we are using the cache method - but this also doesn't help for packages previously loaded by normal package require + #our aim is for pkguse to be deterministic in what namespace it finds - even if it doesn't always get the ideal one (e.g cookiejar, see below) + #To determine appropriate namespace for already loaded packages where we have no cache entry - we may still need the helper interp mechanism + #The helper interp could be persistent - but only so long as the auto_path/tcl::tm::list values are in sync + #review. + + #also see img::png img::raw etc + #these don't directly load namespaces or direct commands.. just change behaviour of existing commands? + #but they can load things like tk (ttk namespace) first one creates ::tkimg? + + if {[string match ::* $pkg_or_existing_ns] && [tcl::namespace::exists $pkg_or_existing_ns]} { + #pkguse on an existing full qualified namespace does no package require set ns $pkg_or_existing_ns + set ver "" } else { - set pkg_unqualified $pkg_or_existing_ns - set ver [package require $pkg_unqualified] - set ns ::$pkg_unqualified - } - #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index - set previous_command_count 0 - if {[namespace exists $ns]} { - set previous_command_count [llength [info commands ${ns}::*]] - } + if {[string match ::* $pkg_or_existing_ns]} { + set pkg_unqualified [string range $pkg_or_existing_ns 2 end] + } else { + set pkg_unqualified $pkg_or_existing_ns + } + #foreach equiv of while 1 - just to allow early exit with break + foreach code_block single { + if {[dict exists $pkguse_package_to_namespace $pkg_unqualified]} { + set ns [dict get $pkguse_package_to_namespace $pkg_unqualified] + set ver [package provide $pkg_unqualified] + break + } + if {[package provide $pkg_unqualified] ne ""} { + #package has already been loaded + if {[namespace exists ::$pkg_unqualified]} { + set ns ::$pkg_unqualified + set ver [package provide $pkg_unqualified] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + break + } + #existing package but no matching namespace.. + #- load in throwaway interp and see what cmds/namespaces created + interp create nstest + try { + nstest eval {tcl::tm::remove {*}[tcl::tm::list]} + nstest eval [list tcl::tm::add {*}[lreverse [tcl::tm::list]]] + nstest eval [list set ::auto_path $::auto_path] + nstest eval {package require punk::ns} + set ns "" + if {![catch {nstest eval [list punk::ns::pkguse $pkg_unqualified]} errMsg]} { + set script [string map [list %p% $pkg_unqualified] {dict get $::punk::ns::pkguse_package_to_namespace %p%}] + set ns [nstest eval $script] + } else { + puts "couldn't test pkg $pkg_unqualified\n$errMsg" + } + } finally { + interp delete nstest + } - #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands - #for the purposes of pkguse - which most commonly interactive - we want the namespace populated - #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + set ver [package provide $pkg_unqualified] + break + } - if {!$ns_populated} { - #we will catch-run an auto_index entry if any - #auto_index entry may or may not be prefixed with :: - set keys [list] - #first look for exact pkg_unqualified and ::pkg_unqualified - #leave these at beginning of keys list - if {[array exists ::auto_index($pkg_unqualified)]} { - lappend keys $pkg_unqualified - } - if {[array exists ::auto_index(::$pkg_unqualified)]} { - lappend keys ::$pkg_unqualified - } - #as auto_index is an array - we could get keys in arbitrary order - set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] - lappend keys {*}$matches - set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] - lappend keys {*}$matches - set ns_populated 0 - set i 0 - set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing - set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] - while {!$ns_populated && $i < [llength $keys]} { - #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base - #e.g if we are loading ::x::y - #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc - set k [lindex $keys $i] - set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] - if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { - set auto_source [set ::auto_index($k)] - if {$auto_source ni $already_sourced} { - uplevel 1 $auto_source - lappend already_sourced $auto_source - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + #pkg not loaded + set namespaces_before [nstree_rawlist ::] ;#approx 1ms for 500 or so namespaces - not cheap but bearable + #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index + #gathering prior cmdcount for every ns in system is also a somewhat expensive operation.. review + #we don't know for sure that the namespace for the package require operation actually matches the package name + #e.g tcllib inifile package uses namespace ::ini + #e.g sqlite3 package adds commands to the global namespace + set dict_ns_commandcounts [dict create] + foreach nsb $namespaces_before { + dict set dict_ns_commandcounts $nsb [llength [info commands ${nsb}::*]] + } + + set ver [package require $pkg_unqualified] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + set namespaces_after [nstree_rawlist ::] + + if {[llength $namespaces_after] > [llength $namespaces_before]} { + set namespaces_new [struct::set difference $namespaces_after $namespaces_before] + if {$ns ni $namespaces_new} { + #todo - use shortest result? what if this is a namespace from a required sub package? + #e.g cookiejar loads sqlite3,http,tcl::idna which creates ::sqlite3 etc - but cookiejar just creates an object at ::http::cookiejar + #In this specific case we end up in oo::ObjXXX - but would be better placed in ::http, where the new cookiejar command resides + #review - todo? + set pkgs [package names] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + #find something new - that doesn't match another package name + foreach new $namespaces_new { + if {[lsearch $pkgs [string trimleft $new :]] == -1} { + set ns $new + break + } + } } } - incr i - } + if {[tcl::namespace::exists $ns]} { + #review - only cache if exists? + dict set pkguse_package_to_namespace $pkg_unqualified $ns; + } + set previous_command_count 0 + if {[dict exists $dict_ns_commandcounts $ns]} { + set previous_command_count [dict get $dict_ns_commandcounts $ns] + } + + #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands + #for the purposes of pkguse - which most commonly interactive - we want the namespace populated + #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + + if {!$ns_populated} { + #we will catch-run an auto_index entry if any + #auto_index entry may or may not be prefixed with :: + set keys [list] + #first look for exact pkg_unqualified and ::pkg_unqualified + #leave these at beginning of keys list + if {[array exists ::auto_index($pkg_unqualified)]} { + lappend keys $pkg_unqualified + } + if {[array exists ::auto_index(::$pkg_unqualified)]} { + lappend keys ::$pkg_unqualified + } + #as auto_index is an array - we could get keys in arbitrary order + set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] + lappend keys {*}$matches + set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] + lappend keys {*}$matches + set ns_populated 0 + set i 0 + set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing + set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] + while {!$ns_populated && $i < [llength $keys]} { + #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base + #e.g if we are loading ::x::y + #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc + set k [lindex $keys $i] + set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] + if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { + set auto_source [set ::auto_index($k)] + if {$auto_source ni $already_sourced} { + puts stderr "pkguse sourcing auto_index script $auto_source" + uplevel 1 $auto_source + lappend already_sourced $auto_source + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + } + } + incr i + } + + } + + }; # end foreach code_block single - scope for use of 'break' } } diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm index a31e255e..fd84ec8d 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm @@ -3567,7 +3567,6 @@ namespace eval repl { if {[catch { package require punk::args - catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical package require punk::config package require punk::ns #puts stderr "loading natsort" @@ -3589,6 +3588,7 @@ namespace eval repl { }} [punk::config::configure running] package require textblock + catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical } errM]} { puts stderr "========================" puts stderr "code interp error:" diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm index 472edc54..f2f4a3af 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/textblock-0.1.3.tm @@ -6007,7 +6007,7 @@ tcl::namespace::eval textblock { proc welcome_test {} { package require punk::ansi - set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/roy-welc.ans 80x8]] + set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/ROY-WELC.ANS 80x8]] # Ansi art courtesy of Carsten Cumbrowski aka Roy/SAC - roysac.com set table [[textblock::spantest] print] set punks [a+ web-lawngreen][>punk . lhs][a]\n\n[a+ rgb#FFFF00][>punk . rhs][a] diff --git a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl index 2de13afb..37f36a9a 100644 --- a/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.project-0.1/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] } @@ -1077,10 +1077,16 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - This help." \n \n append h " $scriptname project ?-k?" \n append h " - this is the literal word project - and confirms you want to run the project build - which includes src/vfs/* checks and builds" \n - append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n - append h " - built modules go into /modules /lib etc." \n \n + append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n + append h " - builds/copies .tm modules from src to /modules etc and pkgIndex.tcl based libraries from src to /lib etc." \n \n append h " $scriptname modules" \n - append h " - build modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " - build (or copy if build not required) .tm modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname libs" \n + append h " - build (or copy if build not required) pkgIndex.tcl based libraries from src/lib src/vendorlib etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname packages" \n + append h " - build (or copy if build not required) both .tm and pkgIndex.tcl based packages from src to their corresponding locations under " \n append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n append h " $scriptname bootsupport" \n append h " - update the src/bootsupport modules as well as the mixtemplates/layouts//src/bootsupport modules if the folder exists" \n @@ -1089,6 +1095,7 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - bootsupport modules are available to make.tcl" \n \n append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n + append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -1213,6 +1220,8 @@ if {![string length [set projectroot [punk::repo::find_project $scriptfolder]]]} } set sourcefolder $projectroot/src +set binfolder $projectroot/bin + if {$::punkboot::command eq "check"} { set sep [string repeat - 75] puts stdout $sep @@ -1348,8 +1357,8 @@ if {$::punkboot::command eq "info"} { puts stdout "- -- --- --- --- --- --- --- --- --- -- -" puts stdout "- projectroot : $projectroot" set sourcefolder $projectroot/src - set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib_tcl*] - set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules_tcl*] + set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] + set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] puts stdout "- vendorlib folders: ([llength $vendorlibfolders])" foreach fld $vendorlibfolders { puts stdout " src/$fld" @@ -1358,13 +1367,18 @@ if {$::punkboot::command eq "info"} { foreach fld $vendormodulefolders { puts stdout " src/$fld" } - set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] - puts stdout "- source module paths: [llength $source_module_folderlist]" - foreach fld $source_module_folderlist { + #set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] ;#returns only those containing .tm files + #foreach fld $source_module_folderlist { + # set relpath [punkcheck::lib::path_relative $projectroot $fld] + # puts stdout " $relpath" + #} + set projectmodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails modules_tcl* modules] + puts stdout "- source module paths: [llength $projectmodulefolders]" + #JJJ + foreach fld $projectmodulefolders { puts stdout " $fld" } - set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] - lappend projectlibfolders lib + set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl* lib] puts stdout "- source libary paths: [llength $projectlibfolders]" foreach fld $projectlibfolders { puts stdout " src/$fld" @@ -1759,7 +1773,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules vfs}} { +if {$::punkboot::command ni {project modules libs packages vfs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -1772,7 +1786,7 @@ if {$::punkboot::command ni {project modules vfs}} { #install src vendor contents (from version controlled src folder) to base of project (same target folders as our own src/modules etc ie to paths that go on the auto_path and in tcl::tm::list) -if {$::punkboot::command in {project modules}} { +if {$::punkboot::command in {project packages modules}} { set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] foreach vf $vendormodulefolders { lassign [split $vf _] _vm tclx @@ -1797,7 +1811,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendormodulefolders]} { puts stderr "VENDORMODULES: No src/vendormodules or src/vendormodules_tcl* folders found." } +} +if {$::punkboot::command in {project packages libs}} { set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] foreach lf $vendorlibfolders { lassign [split $lf _] _vm tclx @@ -1827,8 +1843,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendorlibfolders]} { puts stderr "VENDORLIB: No src/vendorlib or src/vendorlib_tcl* folder found." } +} - +if {$::punkboot::command in {project packages modules libs}} { ######################################################## #templates #e.g The default project layout is mainly folder structure and readme files - but has some scripts developed under the main src that we want to sync @@ -1896,6 +1913,9 @@ if {$::punkboot::command in {project modules}} { $tpl_installer destroy } } +} + +if {$::punkboot::command in {project packages libs}} { ######################################################## set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] lappend projectlibfolders lib @@ -1927,7 +1947,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $projectlibfolders]} { puts stderr "PROJECTLIB: No src/lib or src/lib_tcl* folder found." } +} +if {$::punkboot::command in {project packages modules}} { #consolidated /modules /modules_tclX folder used for target where X is tcl major version #the make process will process for any _tclX not just the major version of the current interpreter @@ -1964,9 +1986,10 @@ if {$::punkboot::command in {project modules}} { ] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } +} +if {$::punkboot::command in {project packages modules libs}} { set installername "make.tcl" - # ---------------------------------------- if {[punk::repo::is_fossil_root $projectroot]} { set config [dict create\ @@ -2013,7 +2036,7 @@ if {$::punkboot::command in {project modules}} { #review set installername "make.tcl" -if {$::punkboot::command ni {project vfs}} { +if {$::punkboot::command ni {project vfs bin}} { #command = modules puts stdout "vfs folders not checked" puts stdout " - use 'make.tcl vfscommonupdate' to copy built modules into base vfs folder" @@ -2033,6 +2056,17 @@ if {$buildfolder ne "$sourcefolder/_build"} { exit 2 } +if {$::punkboot::command eq "bin"} { + puts stdout "checking $sourcefolder/bin" + set resultdict [punkcheck::install $sourcefolder/bin $binfolder\ + -overwrite synced-targets\ + -installer "punkboot-bin"\ + -progresschannel stdout\ + ] + + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout +} #find runtimes set rtfolder $sourcefolder/runtime @@ -2056,11 +2090,32 @@ if {![llength $runtimes]} { } set has_sdx 1 -if {[catch {exec sdx help} errM]} { - puts stderr "FAILED to find usable sdx command - check that sdx executable is on path" - puts stderr "err: $errM" - #exit 1 - set has_sdx 0 +set sdxpath [auto_execok $binfolder/sdx] +if {$sdxpath eq ""} { + set sdxpath [auto_execok [file dirname [info nameofexecutable]]/sdx] + if {$sdxpath eq ""} { + #last resort - look on path + set sdxpath [auto_execok sdx] + } + if {$sdxpath eq ""} { + #last resort - a tclkit and sdx.kit fine + if {[file exists $binfolder/sdx.kit]} { + set tclkitpath [auto_execok $binfolder/tclkit] + if {$tclkitpath eq ""} { + set tclkitpath [auto_execok tclkit] + } + set sdxpath [list {*}$tclkitpath $binfolder/sdx.kit] + } + } + + if {$sdxpath eq "" || [catch {exec {*}$sdxpath help} errM]} { + puts stderr "FAILED to find usable sdx command or tclkit executable with sdx.bat" + puts stderr "If tclkit-based runtimes are required - check that sdx executable is in bin folder of project or in same folder as tcl/punk executable or on path" + puts stderr "This is not a problem if tcl8.7/tcl9+ kits using the preferred method 'zipfs' are to be used, or if cookfs based kits are to be used." + puts stderr "err: $errM" + #exit 1 + set has_sdx 0 + } } # -- --- --- --- --- --- --- --- --- --- @@ -2825,17 +2880,17 @@ foreach vfstail $vfs_tails { if {[catch { if {$rtname ne "-"} { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose } else { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose } } result]} { if {$rtname ne "-"} { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" } else { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" } - puts stderr "sdx wrap $targetkit failed" + puts stderr "$::sdxpath wrap $targetkit failed" lappend failed_kits [list kit $targetkit reason $sdxmsg] $vfs_event targetset_end FAILED $vfs_event destroy @@ -3022,6 +3077,7 @@ foreach vfstail $vfs_tails { } ;#end foreach rtname in runtimes # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } + cd $startdir if {[llength $installed_kits]} { puts stdout "INSTALLED KITS: ([llength $installed_kits])" diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm index a4f56010..1b15d45a 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/libunknown-0.1.tm @@ -890,10 +890,10 @@ tcl::namespace::eval punk::libunknown { set prev_e [dict get $epoch pkg current] set current_e [expr {$prev_e + 1}] # ------------- - puts stderr "--> pkg epoch $prev_e -> $current_e" - puts stderr "args: $args" - puts stderr "last_auto: $last_auto_path" - puts stderr "auto_path: $auto_path" + #puts stderr "--> pkg epoch $prev_e -> $current_e" + #puts stderr "args: $args" + #puts stderr "last_auto: $last_auto_path" + #puts stderr "auto_path: $auto_path" # ------------- if {[llength $auto_path] > [llength $last_auto_path] && [punk::libunknown::lib::is_list_all_in_list $last_auto_path $auto_path]} { #The auto_path changed, and is a pure addition of entry/entries diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm index 8ef36e27..06b145de 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/scriptwrap-0.1.0.tm @@ -20,7 +20,7 @@ #[manpage_begin punkshell_module_scriptwrap 0 0.1.0] #[copyright "2024"] #[titledesc {scriptwrap polyglot tool}] [comment {-- Name section and table of contents description --}] -#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] +#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] #[require punk::mix::commandset::scriptwrap] #[keywords module commandset launcher scriptwrap] #[description] @@ -30,7 +30,7 @@ #*** !doctools #[section Overview] -#[para] overview of scriptwrap +#[para] overview of scriptwrap #[subsection Concepts] #[para] - @@ -74,7 +74,7 @@ package require punk::fileline namespace eval punk::mix::commandset::scriptwrap { #*** !doctools #[subsection {Namespace punk::mix::commandset::scriptwrap}] - #[para] Core API functions for punk::mix::commandset::scriptwrap + #[para] Core API functions for punk::mix::commandset::scriptwrap #[list_begin definitions] namespace export * @@ -93,7 +93,7 @@ namespace eval punk::mix::commandset::scriptwrap { foreach k [lreverse [dict keys $tdict_low_to_high]] { dict set tdict $k [dict get $tdict_low_to_high $k] } - + #set pathinfolist [dict values $tdict] set names [dict keys $tdict] @@ -142,9 +142,9 @@ namespace eval punk::mix::commandset::scriptwrap { put stderr "commandset::scriptwrap::templates_dict WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } return - } - - + } + + #A batch file with unix line-endings is sensitive to label positioning. #batch file with windows crlf line endings can exhibit this problem - but probably only if specifically crafted with long lines deliberately designed to trigger it. #see: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 (Call and goto may fail when the batch file has Unix line endings) @@ -808,176 +808,317 @@ namespace eval punk::mix::commandset::scriptwrap { return $result } #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site - #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf - proc multishell {filepath_or_scriptset args} { - set opts [dict create\ - -askme 1\ - -outputfolder "\uFFFF"\ - -template "\uFFFF"\ - -returnextra 0\ - -force 0\ - ] - #set known_opts [dict keys $defaults] - foreach {k v} $args { - switch -- $k { - -askme - -outputfolder - -template - -returnextra - -force { - dict set opts $k $v - } - default { - error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" - } + #scriptset name to substitute multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf + #set usage "" + #append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n + #append usage "The scriptset name will be used to search for .sh|.tcl|.ps1 or names as you specify in yourname.wrapconfig if it exists" \n + #append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n + #if {![string length $filepath_or_scriptset]} { + # puts stderr "No filepath_or_scriptset specified" + # puts stderr $usage + # return false + #} + proc _read_scriptset_wrap_tomlfile {fname} { + set resultd [dict create] + package require tomlish + set tomldata [readFile $fname] + #todo - fix tomlish to provide line number in ERROR structure during from_toml call. + if {[catch {tomlish::to_dict [tomlish::from_toml $tomldata]} tomldict]} { + puts stderr "Failed to parse $fname" + puts stderr "error: $tomldict" + } + if {[tomlish::dict::path::exists $tomldict {.application.template}]} { + dict set resultd template [tomlish::dict::path::get $tomldict {.application.template.value}] + } + set scripts [list] + if {[tomlish::dict::path::exists $tomldict {.application.scripts.value}]} { + set arrvalues [tomlish::dict::path::get $tomldict {.application.scripts.value}] + foreach tvdict $arrvalues { + lappend scripts [dict get $tvdict value] } } + dict set resultd scripts $scripts - set usage "" - append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n - append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n - append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n - if {![string length $filepath_or_scriptset]} { - puts stderr "No filepath_or_scriptset specified" - puts stderr $usage - return false + set ftail [file rootname [file tail $fname]] ;#e.g example_wrap.toml + set scriptset [lindex [split $ftail _] 0] + set fallback_outputfile $scriptset.cmd + set fallback_nextshellpath "/usr/bin/env tclsh" + set fallback_nextshelltype "tcl" + + if {[tomlish::dict::path::exists $tomldict {.application.default_outputfile.value}]} { + dict set resultd default_outputfile [tomlish::dict::path::get $tomldict {.application.default_outputfile.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshellpath.value}]} { + dict set resultd default_nextshellpath [tomlish::dict::path::get $tomldict {.application.default_nextshellpath.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshelltype.value}]} { + dict set resultd default_nextshelltype [tomlish::dict::path::get $tomldict {.application.default_nextshelltype.value}] + } + foreach platform {win32 dragonflybsd freebsd netbsd linux macosx other} { + set d [dict create] + foreach field {outputfile nextshellpath nextshelltype} { + if {[tomlish::dict::path::exists $tomldict ".application.$platform.$field.value"]} { + dict set d $field [tomlish::dict::path::get $tomldict ".application.$platform.$field.value"] + } else { + if {[dict exists $resultd default_$field]} { + dict set d $field [dict get $resultd default_$field] + } else { + dict set d $field [set fallback_$field] + } + } + } + dict set resultd $platform $d } + + return $resultd + } + punk::args::define { + @id -id ::punk::mix::commandset::scriptwrap::multishell + @cmd -name punk::mix::commandset::scriptwrap::multishell\ + -summary\ + "Wrap script(s) into a polyglot cross-platform executable script."\ + -help\ + "Create a polyglot executable script that wraps constituent scripts written in + various scripting languages such as perl, tcl, shell script, powershell. + The resulting polyglot file should run cross platform on windows and various + types of unix-like OS. For use on windows the output file should be named with + a .bat or .cmd extension - but the same file with extension removed should also + be capable of running on FreeBSD, Linux etc. + Note that a polyglot script such as this may be somewhat brittle over the long + term with regards to default shells and scripting languages across platforms." + @leaders -min 1 -max 1 + filepath_or_scriptset -type string -minsize 1 -help\ + "Supply the path to a single script file to wrap, or the name of a scriptset. + The scriptset name will be used to search for .sh|.bash|.tcl|.ps1|.pl + or alternatively, names as specified in a configuration file named _wrap.toml + if it exists in the current folder, or is specified with a full path name. + If no template name/path is specified in a _wrap.toml file and no + -template argument is supplied the default punk.multishell.cmd will be used. + If the template is specified explicitly in -template as well as in the .toml + file - the supplied -template argument will override that specified in the + .toml file." + @opts + -template -type string -default "punk.multishell.cmd" -help\ + "Templates are provided from modules or paths in the current project, + so available templates will vary based on whether the multishell + command is being run from within a project directory or not. + To see available templates use punk::mix::commandset::scriptwrap::templates." + -outputfolder -type directory -default "" -help\ + "Folder to which to write resulting polyglot script. + If empty, the output will go to the /bin folder or + to the current working directory if there is no projectroot." + -askme -type boolean -default 1 -help\ + "Prompt user at console (stdin) for confirmation of operations such as + overwrite." + -force -type boolean -default 0 + -returnextra -type boolean -default 0 + @values -minvalues 0 -maxvalues 0 + } + #: + #@SET "nextshellpath[win32___________]=tclsh___________________________" + #@SET "nextshelltype[win32___________]=tcl_____________" + #@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[dragonflybsd____]=tcl_____________" + #@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[freebsd_________]=tcl_____________" + #@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[netbsd__________]=tcl_____________" + #@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[linux___________]=tcl_____________" + #@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[macosx__________]=tcl_____________" + #@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[other___________]=tcl_____________" + #: + proc multishell {args} { + set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::multishell] + lassign [dict values $argd] leaders opts values received + # -- --- --- --- --- --- --- --- --- --- --- --- - set opt_askme [dict get $opts -askme] - set opt_template [dict get $opts -template] - set opt_outputfolder [dict get $opts -outputfolder] - set opt_returnextra [dict get $opts -returnextra] - set opt_force [dict get $opts -force] + set filepath_or_scriptset [dict get $leaders filepath_or_scriptset] + set opt_askme [dict get $opts -askme] + set opt_template [dict get $opts -template] ;#use dict exists $received -template to see if overridable in .toml + set opt_outputfolder [dict get $opts -outputfolder] + set opt_returnextra [dict get $opts -returnextra] + set opt_force [dict get $opts -force] # -- --- --- --- --- --- --- --- --- --- --- --- - set ext [file extension $filepath_or_scriptset] set startdir [pwd] + set allowed_extensions [list tcl ps1 sh bash pl] + #TODO - distinct sections for sh vs bash? needs experiments.. + #for now we use shell-pre-launch-subprocess etc + #set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] + set extension_langs [list tcl tcl ps1 powershell sh shell bash shell pl perl] + + if {[file pathtype $filepath_or_scriptset] ni {absolute relative}} { + error "bad pathtype for '$filepath_or_scriptset' (expected absolute or relative path, or name of scriptset)" + } - - - #first check if relative or absolute path matches a file + #first check if absolute path matches a file or relative path from cwd matches a file if {[file pathtype $filepath_or_scriptset] eq "absolute"} { - set specified_path $filepath_or_scriptset + set specified_path $filepath_or_scriptset } else { set specified_path [file join $startdir $filepath_or_scriptset] } + set scriptdir [file dirname $specified_path] + set ext [string trim [file extension $filepath_or_scriptset] .] - set allowed_extensions [list wrapconfig tcl ps1 sh bash pl] - set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] - #set allowed_extensions [list tcl] - set found_script 0 - if {[file exists $specified_path]} { - set found_script 1 + set scriptset "" + if {$ext eq ""} { + set scriptset [file rootname [file tail $specified_path]] + } elseif {$ext eq "toml"} { + set tomltail [file tail $specified_path] + if {[string match *_wrap.toml $tomltail]} { + set scriptset [lindex [split $tomltail _] 0] + #if .toml was specified - the config file must exist + if {![file exists $specified_path]} { + if {[file pathtype $filepath_or_scriptset] eq "relative"} { + puts stderr "unable to locate '$specified_path' - will continue search in src/scriptapps folder" + } else { + #caller was specific about path - no fallback to src/scriptapps + error "unable to locate '$specified_path'" + } + } + } else { + error "supplied toml file must be of form _wrap.toml" + } } else { - foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { - if {[file exists $filepath_or_scriptset.$e]} { - set found_script 1 - break + if {$ext ni $allowed_extensions} { + error "supplied filepath_or_scriptset must be the name of a scriptset without extension, a file named _wrap.toml, or a script with one of the extensions: $allowed_extensions" + } + } + + set list_input_files [list] + set configd [dict create] + if {$scriptset ne ""} { + puts stdout "Attempting to process all scripts belonging to scriptset '$scriptset'" + #.toml file may or may not exist + if {[file exists ${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptdir/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptdir/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptdir $s] + } + } + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" + return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptdir" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptdir/$scriptset.$e]} { + lappend list_input_files $scriptdir/$scriptset.$e + } } } + } else { + #expect a single script + if {[file exists $specified_path]} { + lappend list_input_files $specified_path + } } + set found_script [expr {[llength $list_input_files] > 0}] #TODO! - use get_wrapper_folders - multishell should use same available templates as the 'templates' function - set scriptset [file rootname [file tail $specified_path]] if {$found_script} { - if {[file type $specified_path] eq "file"} { - set specified_root [file dirname $specified_path] - set pathinfo [punk::repo::find_repos [file dirname $specified_path]] - set projectroot [dict get $pathinfo closest] + #found scripts at absolute path - or path relative to cwd + set scriptroot $scriptdir + set pathinfo [punk::repo::find_repos $scriptroot] + set projectroot [dict get $pathinfo closest] + if {[file exists $scriptroot/wrappers]} { + set customwrapper_folder $scriptroot/wrappers + } else { + #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder if {[string length $projectroot]} { - #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - set customwrapper_folder $projectroot/src/scriptapps/wrappers - } + set customwrapper_folder $projectroot/src/scriptapps/wrappers } else { #outside of any project - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - #no customwrapper folder available - set customwrapper_folder "" - } + set customwrapper_folder "" } - } else { - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false } } else { + if {[file pathtype $filepath_or_scriptset] eq "absolute"} { + return false + } set pathinfo [punk::repo::find_repos $startdir] set projectroot [dict get $pathinfo closest] - if {[string length $projectroot]} { - if {[llength [file split $filepath_or_scriptset]] > 1} { - puts stderr "filepath_or_scriptset looks like a path - but doesn't seem to point to a file" - puts stderr "Ensure you are within a project and use just the name of the scriptset, or pass in the full correct path or relative path to current directory" - puts stderr $usage - return false - } else { - #we've already ruled out empty string - so must have a single element representing scriptset - possibly with file extension - set scriptroot $projectroot/src/scriptapps - set customwrapper_folder $projectroot/src/scriptapps/wrappers - #check something matches the scriptset.. - set something_found "" - if {[file exists $scriptroot/$scriptset]} { - set found_script 1 - set something_found $scriptroot/$scriptset ;#extensionless file - that's ok too - } else { - foreach e $allowed_extensions { - if {[file exists $scriptroot/$scriptset.$e]} { - set found_script 1 - set something_found $scriptroot/$scriptset.$e - break - } + if {![string length $projectroot]} { + puts stderr "No matching scripts or config found for $filepath_or_scriptset, and you are not within a directory where projectroot and src/scriptapps can be determined" + return false + } + + set scriptroot $projectroot/src/scriptapps + set customwrapper_folder $projectroot/src/scriptapps/wrappers + #check something matches the scriptset.. + if {$scriptset ne ""} { + #.toml file may or may not exist + if {[file exists $scriptroot/${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptroot/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptroot/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptroot $s] } } - if {!$found_script} { - puts stderr "Searched within $scriptroot" - puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" - puts stderr $usage + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" return false - } else { - if {[file type $something_found] ne "file"} { - puts stderr "Found '$something_found'" - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptroot" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptroot/$scriptset.$e]} { + lappend list_input_files $scriptroot/$scriptset.$e } } } - } else { - puts stderr "filepath_or_scriptset parameter doesn't seem to refer to a file, and you are not within a directory where projectroot and src/scriptapps/wrappers can be determined" - puts stderr $usage - return false + #expect a single script + if {[file exists $scriptroot/$filepath_or_scriptset]} { + if {[file type $scriptroot/$filepath_or_scriptset] ne "file"} { + puts stderr "wrap_in_multishell doesn't currently support a directory as the path. path: $scriptroot/$filepath_or_scriptset" + return false + } + lappend list_input_files $scriptroot/$filepath_or_scriptset + } } - } - #assertion - customwrapper_folder var exists - but might be empty + set found_script [expr {[llength $list_input_files] > 0}] - - if {[string length $ext]} { - #If there was an explicitly supplied extension - then that file should exist - if {![file exists $scriptroot/$scriptset.$ext]} { - puts stderr "Explicit extension .$ext was supplied - but matching file not found." - puts stderr $usage - return false - } else { - if {$ext eq "wrapconfig"} { - set process_extensions ALLFOUNDORCONFIGURED + #---------------------- + if {!$found_script} { + puts stderr "Searched within $scriptdir and $scriptroot" + if {$scriptset ne ""} { + puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" } else { - set process_extensions $ext + puts stderr "Unable to find file $filepath_or_scriptset" } + return false } - } else { - #no explicit extension - process all for scriptset - set process_extensions ALLFOUNDORCONFIGURED + } - #process_extensions - either a single one - or all found or as per .wrapconfig + #assertion - customwrapper_folder var exists - but might be empty - if {$opt_template eq "\uFFFF"} { - set templatename punk.multishell.cmd + if {[dict exists $configd template]} { + set templatename [dict get $configd template] } else { - set templatename $opt_template + if {$opt_template eq "\uFFFF"} { + set templatename punk.multishell.cmd + } else { + set templatename $opt_template + } } set templatename_root [file rootname [file tail $templatename]] @@ -995,7 +1136,7 @@ namespace eval punk::mix::commandset::scriptwrap { set template_base_dict [punk::mix::base::lib::get_template_basefolders] set tpldirs [list] dict for {tdir tsourceinfo} $template_base_dict { - set vendor [dict get $tsourceinfo vendor] + set vendor [dict get $tsourceinfo vendor] if {[file exists $tdir/utility/scriptappwrappers/$templatename]} { lappend tpldirs $tdir } elseif {[file exists $tdir/utility/scriptappwrappers/${templatename_fileroot}[file extension $templatename]]} { @@ -1032,7 +1173,7 @@ namespace eval punk::mix::commandset::scriptwrap { } - if {$opt_outputfolder eq "\uFFFF"} { + if {$opt_outputfolder eq ""} { #outputfolder not explicitly specified by caller if {[string length $projectroot]} { set output_folder [file join $projectroot/bin] @@ -1056,13 +1197,36 @@ namespace eval punk::mix::commandset::scriptwrap { #todo - #output_file extension may also depend on the template being used.. and/or the .wrapconfig - if {$::tcl_platform(platform) eq "windows"} { - set output_extension cmd + #output_file extension may also depend on the template being used.. and/or the _wrap.toml config + + if {[dict size $configd]} { + package require platform + set thisplatform [string tolower [platform::identify]] + set ptype [lindex [split $thisplatform -] 0] + switch -- $ptype { + win32 - dragonflybsd - freebsd - netbsd - linux - macosx {} + default { + set ptype other + } + } + set out [dict get $configd $ptype outputfile] + set output_file [file join $output_folder $out] } else { - set output_extension sh + #no _wrap.toml file available + if {$::tcl_platform(platform) eq "windows"} { + set output_extension .cmd + } else { + set output_extension .sh + } + if {$scriptset ne ""} { + set output_file [file join $output_folder $scriptset$output_extension] + } else { + set infile [lindex $list_input_files 0] + set output_file [file join $output_folder [file rootname [file tail $infile]]$output_extension] + } } - set output_file [file join $output_folder $scriptset.$output_extension] + + if {[file exists $output_file]} { set fdexisting [open $output_file r] fconfigure $fdexisting -translation binary @@ -1103,13 +1267,10 @@ namespace eval punk::mix::commandset::scriptwrap { #foreach ln $template_lines { #} - set list_input_files [list] - if {$process_extensions eq "ALLFOUNDORCONFIGURED"} { - #todo - look for .wrapconfig or all extensions for the scriptset - puts stderr "Sorry - only single input file supported. Supply a file extension or use a .wrapconfig with a single input file for now - implementation incomplete" + if {[llength $list_input_files] > 1} { + #todo + puts stderr "Sorry - only single input file supported. Supply a file extension or use a _wrap.toml config with a single input file for now - implementation incomplete" return false - } else { - lappend list_input_files $scriptroot/$scriptset.$ext } #todo - split template at each etc marker and build a dict of parts @@ -1117,7 +1278,6 @@ namespace eval punk::mix::commandset::scriptwrap { #hack - process one input set filepath [lindex $list_input_files 0] - set fdscript [open $filepath r] fconfigure $fdscript -translation binary set script_data [read $fdscript] @@ -1131,7 +1291,8 @@ namespace eval punk::mix::commandset::scriptwrap { } puts stdout "-----------------------------------------------\n" puts stdout "Target for above script data is '$output_file'" - set lang [dict get $extension_langs [string tolower $ext]] + set script_ext [string trim [file extension $filepath] .] + set lang [dict get $extension_langs [string tolower $script_ext]] puts stdout "Language of script being wrapped is $lang" if {$opt_askme} { set answer [util::askuser "Does this look correct? Y|N"] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm index 6bd826e2..f8e55b02 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/ns-0.1.0.tm @@ -444,9 +444,8 @@ tcl::namespace::eval punk::ns { set nspath [string map {:::: ::} $nspath] set mapped [string map {:: \u0FFF} $nspath] set parts [split $mapped \u0FFF] - if {[lindex $parts end] eq ""} { - - } + #if {[lindex $parts end] eq ""} { + #} return $parts } @@ -531,6 +530,21 @@ tcl::namespace::eval punk::ns { return [regexp [dict get $ns_re_cache $glob] $path] } + #namespace tree without globbing or weird ns consideration + proc nstree_raw {{location ::}} { + if {![string match ::* $location]} { + error "nstree_raw requires a fully qualified namespace" + } + nstree_rawlist $location + } + proc nstree_rawlist {location} { + set nslist [list $location] + foreach ch [::namespace children $location] { + lappend nslist {*}[nstree_rawlist $ch] + } + return $nslist + } + proc nstree {{location ""}} { if {![string match ::* $location]} { set nscaller [uplevel 1 {::namespace current}] @@ -3899,6 +3913,7 @@ tcl::namespace::eval punk::ns { } proc _pkguse_vars {varnames} { + #review - obsolete? while {"pkguse_vars_[incr n]" in $varnames} {} #return [concat $varnames pkguse_vars_$n] return [list {*}$varnames pkguse_vars_$n] @@ -3932,10 +3947,12 @@ tcl::namespace::eval punk::ns { #load package and move to namespace of same name if run interactively with only pkg/namespace argument. #if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock #if no newline or $args in the script - treat as one-liner and supply {*}$args automatically + variable pkguse_package_to_namespace [dict create] proc pkguse {args} { + variable pkguse_package_to_namespace set argd [punk::args::parse $args withid ::punk::ns::pkguse] lassign [dict values $argd] leaders opts values received - puts stderr "leaders:$leaders opts:$opts values:$values received:$received" + #puts stderr "leaders:$leaders opts:$opts values:$values received:$received" set pkg_or_existing_ns [dict get $leaders pkg_or_existing_ns] if {[dict exists $received script]} { @@ -3967,68 +3984,159 @@ tcl::namespace::eval punk::ns { set ver "";# tcl version? } default { - if {[string match ::* $pkg_or_existing_ns]} { - set pkg_unqualified [string range $pkg_or_existing_ns 2 end] - if {![tcl::namespace::exists $pkg_or_existing_ns]} { - set ver [package require $pkg_unqualified] - } else { - set ver "" - } + #- comparing namespaces_before vs namespaces_after only works if the package was not previously loaded + #we could either go to the somewhat expensive route of steaming up an interp with the same auto_path & tcl::tm::list each time.. + #or cache the result of the namespace we picked for later pkguse calls (pkguse_package_to_namespace dict) + #we are using the cache method - but this also doesn't help for packages previously loaded by normal package require + #our aim is for pkguse to be deterministic in what namespace it finds - even if it doesn't always get the ideal one (e.g cookiejar, see below) + #To determine appropriate namespace for already loaded packages where we have no cache entry - we may still need the helper interp mechanism + #The helper interp could be persistent - but only so long as the auto_path/tcl::tm::list values are in sync + #review. + + #also see img::png img::raw etc + #these don't directly load namespaces or direct commands.. just change behaviour of existing commands? + #but they can load things like tk (ttk namespace) first one creates ::tkimg? + + if {[string match ::* $pkg_or_existing_ns] && [tcl::namespace::exists $pkg_or_existing_ns]} { + #pkguse on an existing full qualified namespace does no package require set ns $pkg_or_existing_ns + set ver "" } else { - set pkg_unqualified $pkg_or_existing_ns - set ver [package require $pkg_unqualified] - set ns ::$pkg_unqualified - } - #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index - set previous_command_count 0 - if {[namespace exists $ns]} { - set previous_command_count [llength [info commands ${ns}::*]] - } + if {[string match ::* $pkg_or_existing_ns]} { + set pkg_unqualified [string range $pkg_or_existing_ns 2 end] + } else { + set pkg_unqualified $pkg_or_existing_ns + } + #foreach equiv of while 1 - just to allow early exit with break + foreach code_block single { + if {[dict exists $pkguse_package_to_namespace $pkg_unqualified]} { + set ns [dict get $pkguse_package_to_namespace $pkg_unqualified] + set ver [package provide $pkg_unqualified] + break + } + if {[package provide $pkg_unqualified] ne ""} { + #package has already been loaded + if {[namespace exists ::$pkg_unqualified]} { + set ns ::$pkg_unqualified + set ver [package provide $pkg_unqualified] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + break + } + #existing package but no matching namespace.. + #- load in throwaway interp and see what cmds/namespaces created + interp create nstest + try { + nstest eval {tcl::tm::remove {*}[tcl::tm::list]} + nstest eval [list tcl::tm::add {*}[lreverse [tcl::tm::list]]] + nstest eval [list set ::auto_path $::auto_path] + nstest eval {package require punk::ns} + set ns "" + if {![catch {nstest eval [list punk::ns::pkguse $pkg_unqualified]} errMsg]} { + set script [string map [list %p% $pkg_unqualified] {dict get $::punk::ns::pkguse_package_to_namespace %p%}] + set ns [nstest eval $script] + } else { + puts "couldn't test pkg $pkg_unqualified\n$errMsg" + } + } finally { + interp delete nstest + } - #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands - #for the purposes of pkguse - which most commonly interactive - we want the namespace populated - #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + set ver [package provide $pkg_unqualified] + break + } - if {!$ns_populated} { - #we will catch-run an auto_index entry if any - #auto_index entry may or may not be prefixed with :: - set keys [list] - #first look for exact pkg_unqualified and ::pkg_unqualified - #leave these at beginning of keys list - if {[array exists ::auto_index($pkg_unqualified)]} { - lappend keys $pkg_unqualified - } - if {[array exists ::auto_index(::$pkg_unqualified)]} { - lappend keys ::$pkg_unqualified - } - #as auto_index is an array - we could get keys in arbitrary order - set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] - lappend keys {*}$matches - set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] - lappend keys {*}$matches - set ns_populated 0 - set i 0 - set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing - set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] - while {!$ns_populated && $i < [llength $keys]} { - #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base - #e.g if we are loading ::x::y - #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc - set k [lindex $keys $i] - set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] - if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { - set auto_source [set ::auto_index($k)] - if {$auto_source ni $already_sourced} { - uplevel 1 $auto_source - lappend already_sourced $auto_source - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + #pkg not loaded + set namespaces_before [nstree_rawlist ::] ;#approx 1ms for 500 or so namespaces - not cheap but bearable + #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index + #gathering prior cmdcount for every ns in system is also a somewhat expensive operation.. review + #we don't know for sure that the namespace for the package require operation actually matches the package name + #e.g tcllib inifile package uses namespace ::ini + #e.g sqlite3 package adds commands to the global namespace + set dict_ns_commandcounts [dict create] + foreach nsb $namespaces_before { + dict set dict_ns_commandcounts $nsb [llength [info commands ${nsb}::*]] + } + + set ver [package require $pkg_unqualified] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + set namespaces_after [nstree_rawlist ::] + + if {[llength $namespaces_after] > [llength $namespaces_before]} { + set namespaces_new [struct::set difference $namespaces_after $namespaces_before] + if {$ns ni $namespaces_new} { + #todo - use shortest result? what if this is a namespace from a required sub package? + #e.g cookiejar loads sqlite3,http,tcl::idna which creates ::sqlite3 etc - but cookiejar just creates an object at ::http::cookiejar + #In this specific case we end up in oo::ObjXXX - but would be better placed in ::http, where the new cookiejar command resides + #review - todo? + set pkgs [package names] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + #find something new - that doesn't match another package name + foreach new $namespaces_new { + if {[lsearch $pkgs [string trimleft $new :]] == -1} { + set ns $new + break + } + } } } - incr i - } + if {[tcl::namespace::exists $ns]} { + #review - only cache if exists? + dict set pkguse_package_to_namespace $pkg_unqualified $ns; + } + set previous_command_count 0 + if {[dict exists $dict_ns_commandcounts $ns]} { + set previous_command_count [dict get $dict_ns_commandcounts $ns] + } + + #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands + #for the purposes of pkguse - which most commonly interactive - we want the namespace populated + #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + + if {!$ns_populated} { + #we will catch-run an auto_index entry if any + #auto_index entry may or may not be prefixed with :: + set keys [list] + #first look for exact pkg_unqualified and ::pkg_unqualified + #leave these at beginning of keys list + if {[array exists ::auto_index($pkg_unqualified)]} { + lappend keys $pkg_unqualified + } + if {[array exists ::auto_index(::$pkg_unqualified)]} { + lappend keys ::$pkg_unqualified + } + #as auto_index is an array - we could get keys in arbitrary order + set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] + lappend keys {*}$matches + set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] + lappend keys {*}$matches + set ns_populated 0 + set i 0 + set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing + set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] + while {!$ns_populated && $i < [llength $keys]} { + #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base + #e.g if we are loading ::x::y + #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc + set k [lindex $keys $i] + set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] + if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { + set auto_source [set ::auto_index($k)] + if {$auto_source ni $already_sourced} { + puts stderr "pkguse sourcing auto_index script $auto_source" + uplevel 1 $auto_source + lappend already_sourced $auto_source + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + } + } + incr i + } + + } + + }; # end foreach code_block single - scope for use of 'break' } } diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm index a31e255e..fd84ec8d 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.1.2.tm @@ -3567,7 +3567,6 @@ namespace eval repl { if {[catch { package require punk::args - catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical package require punk::config package require punk::ns #puts stderr "loading natsort" @@ -3589,6 +3588,7 @@ namespace eval repl { }} [punk::config::configure running] package require textblock + catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical } errM]} { puts stderr "========================" puts stderr "code interp error:" diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm index 472edc54..f2f4a3af 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/textblock-0.1.3.tm @@ -6007,7 +6007,7 @@ tcl::namespace::eval textblock { proc welcome_test {} { package require punk::ansi - set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/roy-welc.ans 80x8]] + set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/ROY-WELC.ANS 80x8]] # Ansi art courtesy of Carsten Cumbrowski aka Roy/SAC - roysac.com set table [[textblock::spantest] print] set punks [a+ web-lawngreen][>punk . lhs][a]\n\n[a+ rgb#FFFF00][>punk . rhs][a] diff --git a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl index 2de13afb..37f36a9a 100644 --- a/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl +++ b/src/project_layouts/custom/_project/punk.shell-0.1/src/make.tcl @@ -22,7 +22,7 @@ namespace eval ::punkboot { variable pkg_requirements [list]; variable pkg_missing [list];variable pkg_loaded [list] variable non_help_flags [list -k] variable help_flags [list -help --help /? -h] - variable known_commands [list project modules vfs info check shell vendorupdate bootsupport vfscommonupdate ] + variable known_commands [list project modules libs packages vfs bin info check shell vendorupdate bootsupport vfscommonupdate ] } @@ -1077,10 +1077,16 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - This help." \n \n append h " $scriptname project ?-k?" \n append h " - this is the literal word project - and confirms you want to run the project build - which includes src/vfs/* checks and builds" \n - append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n - append h " - built modules go into /modules /lib etc." \n \n + append h " - the optional -k flag will terminate running processes matching the executable being built (if applicable)" \n + append h " - builds/copies .tm modules from src to /modules etc and pkgIndex.tcl based libraries from src to /lib etc." \n \n append h " $scriptname modules" \n - append h " - build modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " - build (or copy if build not required) .tm modules from src/modules src/vendormodules etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname libs" \n + append h " - build (or copy if build not required) pkgIndex.tcl based libraries from src/lib src/vendorlib etc to their corresponding locations under " \n + append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n + append h " $scriptname packages" \n + append h " - build (or copy if build not required) both .tm and pkgIndex.tcl based packages from src to their corresponding locations under " \n append h " This does not scan src/runtime and src/vfs folders to build kit/zipkit/cookfs executables" \n \n append h " $scriptname bootsupport" \n append h " - update the src/bootsupport modules as well as the mixtemplates/layouts//src/bootsupport modules if the folder exists" \n @@ -1089,6 +1095,7 @@ proc ::punkboot::punkboot_gethelp {args} { append h " - bootsupport modules are available to make.tcl" \n \n append h " $scriptname vendorupdate" \n append h " - update the src/vendormodules based on src/vendormodules/include_modules.config" \n \n + append h " - update the src/vendorlib based on src/vendorlib/config.toml (todo)" \n \n append h " $scriptname vfscommonupdate" \n append h " - update the src/vfs/_vfscommon.vfs from compiled src/modules and src/lib etc" \n append h " - before calling this (followed by make project) - you can test using '(.exe) dev'" \n @@ -1213,6 +1220,8 @@ if {![string length [set projectroot [punk::repo::find_project $scriptfolder]]]} } set sourcefolder $projectroot/src +set binfolder $projectroot/bin + if {$::punkboot::command eq "check"} { set sep [string repeat - 75] puts stdout $sep @@ -1348,8 +1357,8 @@ if {$::punkboot::command eq "info"} { puts stdout "- -- --- --- --- --- --- --- --- --- -- -" puts stdout "- projectroot : $projectroot" set sourcefolder $projectroot/src - set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib_tcl*] - set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules_tcl*] + set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] + set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] puts stdout "- vendorlib folders: ([llength $vendorlibfolders])" foreach fld $vendorlibfolders { puts stdout " src/$fld" @@ -1358,13 +1367,18 @@ if {$::punkboot::command eq "info"} { foreach fld $vendormodulefolders { puts stdout " src/$fld" } - set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] - puts stdout "- source module paths: [llength $source_module_folderlist]" - foreach fld $source_module_folderlist { + #set source_module_folderlist [punk::mix::cli::lib::find_source_module_paths $projectroot] ;#returns only those containing .tm files + #foreach fld $source_module_folderlist { + # set relpath [punkcheck::lib::path_relative $projectroot $fld] + # puts stdout " $relpath" + #} + set projectmodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails modules_tcl* modules] + puts stdout "- source module paths: [llength $projectmodulefolders]" + #JJJ + foreach fld $projectmodulefolders { puts stdout " $fld" } - set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] - lappend projectlibfolders lib + set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl* lib] puts stdout "- source libary paths: [llength $projectlibfolders]" foreach fld $projectlibfolders { puts stdout " src/$fld" @@ -1759,7 +1773,7 @@ if {$::punkboot::command eq "bootsupport"} { -if {$::punkboot::command ni {project modules vfs}} { +if {$::punkboot::command ni {project modules libs packages vfs bin}} { puts stderr "Command $::punkboot::command not implemented - aborting." flush stderr after 100 @@ -1772,7 +1786,7 @@ if {$::punkboot::command ni {project modules vfs}} { #install src vendor contents (from version controlled src folder) to base of project (same target folders as our own src/modules etc ie to paths that go on the auto_path and in tcl::tm::list) -if {$::punkboot::command in {project modules}} { +if {$::punkboot::command in {project packages modules}} { set vendormodulefolders [glob -nocomplain -dir $sourcefolder -type d -tails vendormodules vendormodules_tcl*] foreach vf $vendormodulefolders { lassign [split $vf _] _vm tclx @@ -1797,7 +1811,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendormodulefolders]} { puts stderr "VENDORMODULES: No src/vendormodules or src/vendormodules_tcl* folders found." } +} +if {$::punkboot::command in {project packages libs}} { set vendorlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails vendorlib vendorlib_tcl*] foreach lf $vendorlibfolders { lassign [split $lf _] _vm tclx @@ -1827,8 +1843,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $vendorlibfolders]} { puts stderr "VENDORLIB: No src/vendorlib or src/vendorlib_tcl* folder found." } +} - +if {$::punkboot::command in {project packages modules libs}} { ######################################################## #templates #e.g The default project layout is mainly folder structure and readme files - but has some scripts developed under the main src that we want to sync @@ -1896,6 +1913,9 @@ if {$::punkboot::command in {project modules}} { $tpl_installer destroy } } +} + +if {$::punkboot::command in {project packages libs}} { ######################################################## set projectlibfolders [glob -nocomplain -dir $sourcefolder -type d -tails lib_tcl*] lappend projectlibfolders lib @@ -1927,7 +1947,9 @@ if {$::punkboot::command in {project modules}} { if {![llength $projectlibfolders]} { puts stderr "PROJECTLIB: No src/lib or src/lib_tcl* folder found." } +} +if {$::punkboot::command in {project packages modules}} { #consolidated /modules /modules_tclX folder used for target where X is tcl major version #the make process will process for any _tclX not just the major version of the current interpreter @@ -1964,9 +1986,10 @@ if {$::punkboot::command in {project modules}} { ] puts stdout [punkcheck::summarize_install_resultdict $resultdict] } +} +if {$::punkboot::command in {project packages modules libs}} { set installername "make.tcl" - # ---------------------------------------- if {[punk::repo::is_fossil_root $projectroot]} { set config [dict create\ @@ -2013,7 +2036,7 @@ if {$::punkboot::command in {project modules}} { #review set installername "make.tcl" -if {$::punkboot::command ni {project vfs}} { +if {$::punkboot::command ni {project vfs bin}} { #command = modules puts stdout "vfs folders not checked" puts stdout " - use 'make.tcl vfscommonupdate' to copy built modules into base vfs folder" @@ -2033,6 +2056,17 @@ if {$buildfolder ne "$sourcefolder/_build"} { exit 2 } +if {$::punkboot::command eq "bin"} { + puts stdout "checking $sourcefolder/bin" + set resultdict [punkcheck::install $sourcefolder/bin $binfolder\ + -overwrite synced-targets\ + -installer "punkboot-bin"\ + -progresschannel stdout\ + ] + + puts stdout [punkcheck::summarize_install_resultdict $resultdict] + flush stdout +} #find runtimes set rtfolder $sourcefolder/runtime @@ -2056,11 +2090,32 @@ if {![llength $runtimes]} { } set has_sdx 1 -if {[catch {exec sdx help} errM]} { - puts stderr "FAILED to find usable sdx command - check that sdx executable is on path" - puts stderr "err: $errM" - #exit 1 - set has_sdx 0 +set sdxpath [auto_execok $binfolder/sdx] +if {$sdxpath eq ""} { + set sdxpath [auto_execok [file dirname [info nameofexecutable]]/sdx] + if {$sdxpath eq ""} { + #last resort - look on path + set sdxpath [auto_execok sdx] + } + if {$sdxpath eq ""} { + #last resort - a tclkit and sdx.kit fine + if {[file exists $binfolder/sdx.kit]} { + set tclkitpath [auto_execok $binfolder/tclkit] + if {$tclkitpath eq ""} { + set tclkitpath [auto_execok tclkit] + } + set sdxpath [list {*}$tclkitpath $binfolder/sdx.kit] + } + } + + if {$sdxpath eq "" || [catch {exec {*}$sdxpath help} errM]} { + puts stderr "FAILED to find usable sdx command or tclkit executable with sdx.bat" + puts stderr "If tclkit-based runtimes are required - check that sdx executable is in bin folder of project or in same folder as tcl/punk executable or on path" + puts stderr "This is not a problem if tcl8.7/tcl9+ kits using the preferred method 'zipfs' are to be used, or if cookfs based kits are to be used." + puts stderr "err: $errM" + #exit 1 + set has_sdx 0 + } } # -- --- --- --- --- --- --- --- --- --- @@ -2825,17 +2880,17 @@ foreach vfstail $vfs_tails { if {[catch { if {$rtname ne "-"} { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $building_runtime {*}$verbose } else { - exec sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose + exec {*}$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose } } result]} { if {$rtname ne "-"} { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs -runtime $buildfolder/build_$runtime_fullname {*}$verbose failed with msg: $result" } else { - set sdxmsg "sdx wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" + set sdxmsg "$::sdxpath wrap $buildfolder/$vfsname.new -vfs $wrapvfs {*}$verbose failed with msg: $result" } - puts stderr "sdx wrap $targetkit failed" + puts stderr "$::sdxpath wrap $targetkit failed" lappend failed_kits [list kit $targetkit reason $sdxmsg] $vfs_event targetset_end FAILED $vfs_event destroy @@ -3022,6 +3077,7 @@ foreach vfstail $vfs_tails { } ;#end foreach rtname in runtimes # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- } + cd $startdir if {[llength $installed_kits]} { puts stdout "INSTALLED KITS: ([llength $installed_kits])" diff --git a/src/runtime/mapvfs.config b/src/runtime/mapvfs.config index 1af6958f..6ed5f1f3 100644 --- a/src/runtime/mapvfs.config +++ b/src/runtime/mapvfs.config @@ -53,7 +53,7 @@ tclsh90magic.exe {punk9magicsplat.vfs punkmagic zipcat} #we would require compiled cookfs extension to extract existing vfs from a cookit, or if we wanted to re-write as cookfs #(possibly upx binary too if compressed - upx is easily attainable on most platforms) -#cookitU.exe {punk9cook.vfs punk9cook cookfs} +cookitU.exe {punk9cook.vfs punk9cook cookfs} #cookitU.exe {punk9cook.vfs punk9cz zip} ################################## diff --git a/src/scriptapps/example.sh b/src/scriptapps/example.sh new file mode 100644 index 00000000..3f0f1e40 --- /dev/null +++ b/src/scriptapps/example.sh @@ -0,0 +1 @@ +echo "output from example.sh wrapped in polyglot script" \ No newline at end of file diff --git a/src/scriptapps/example.tcl b/src/scriptapps/example.tcl new file mode 100644 index 00000000..cd3796d2 --- /dev/null +++ b/src/scriptapps/example.tcl @@ -0,0 +1 @@ +puts stdout "output from example.tcl wrapped in polyglot script" \ No newline at end of file diff --git a/src/scriptapps/example_out.bat b/src/scriptapps/example_out.bat new file mode 100644 index 00000000..c45adc6c --- /dev/null +++ b/src/scriptapps/example_out.bat @@ -0,0 +1,743 @@ +: "punk MULTISHELL - shebangless polyglot for Tcl Perl sh bash cmd pwsh powershell" + "[rename set s;proc Hide x {proc $x args {}};Hide :]" + "\$(function : {<#pwsh#>})" + "perlhide" + qw^ +set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' +: heredoc1 - hide from powershell using @ and squote above. close sqote for unix shells + ' \ +: .bat/.cmd launch section, leading colon hides from cmd, trailing slash hides next line from tcl + \ +: "[Hide @GOTO; Hide =begin; Hide @REM] #not necessary but can help avoid errs in testing" + +: << 'HEREDOC1B_HIDE_FROM_BASH_AND_SH' +: STRONG SUGGESTION: DO NOT MODIFY FIRST LINE OF THIS SCRIPT - except for first double quoted section. +: shebang line is not required on unix or windows and will reduce functionality and/or portability. +: Even comment lines can be part of the functionality of this script (both on unix and windows) - modify with care. +@GOTO :skip_perl_pod_start ^; +=begin excludeperl +: skip_perl_pod_start +: Continuation char at end of this line and rem with curly-braces used to exlude Tcl from the whole cmd block \ +: { +@REM ############################################################################################################################ +@REM THIS IS A POLYGLOT SCRIPT - supporting payloads in Tcl, bash, (some sh) and/or powershelll (powershell.exe or pwsh.exe) +@REM It should remain portable between unix-like OSes & windows if the proper structure is maintained. +@REM ############################################################################################################################ +@REM On windows, change the value of nextshell to one of the listed 2 digit values if desired, and add code within payload sections for tcl,sh,bash,powershell as appropriate. +@REM This wrapper can be edited manually (carefully!) - or sh,bash,tcl,powershell scripts can be wrapped using the Tcl-based punkshell system +@REM e.g from within a running punkshell: deck scriptwrap.multishell -outputfolder +@REM On unix-like systems, call with sh, bash or tclsh. (powershell untested on unix - and requires wscript if security elevation is used) +@REM Due to lack of shebang (#! line) Unix-like systems will probably (hopefully) default to sh if the script is called without an interpreter - but it may depend on the shell in use when called. +@REM If you find yourself really wanting/needing to add a shebang line - do so on the basis that the script will exist on unix-like systems only. +@REM in batch scripts - array syntax with square brackets is a simulation of arrays or associative arrays. +@REM note that many shells linked as sh do not support substition syntax and may fail - e.g dash etc - generally bash should be used in this context +@SETLOCAL EnableExtensions EnableDelayedExpansion +@SET "validshelltypes= powershell______ sh______________ wslbash_________ bash____________ tcl_____________ perl____________" +@REM for batch - only win32 is relevant - but other scripts on other platforms also parse the nextshell block to determine next shell to launch +@REM nextshellpath and nextshelltype indices (underscore-padded to 16wide) are "other" plus those returned by Tcl platform pkg e.g win32,linux,freebsd,macosx +@REM The horrible underscore-padded fixed-widths are to keep the batch labels aligned whilst allowing values to be set +@REM If more than 32 chars needed for a target, it can still be done but overall script padding may need checking/adjusting +@REM Supporting more explicit oses than those listed may also require script padding adjustment +: +@SET "nextshellpath[win32___________]=tclsh___________________________" +@SET "nextshelltype[win32___________]=tcl_____________" +@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" +@SET "nextshelltype[dragonflybsd____]=tcl_____________" +@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[freebsd_________]=tcl_____________" +@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[netbsd__________]=tcl_____________" +@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[linux___________]=tcl_____________" +@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[macosx__________]=tcl_____________" +@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" +@SET "nextshelltype[other___________]=tcl_____________" +: +@rem asadmin is for automatic elevation to administrator. Separate window will be created (seems unavoidable with current elevation mechanism) and user will still get security prompt (probably reasonable). +: +@SET "asadmin=0" +: +@REM @ECHO nextshelltype is %nextshelltype[win32___________]% +@REM @SET "selected_shelltype=%nextshelltype[win32___________]%" +@SET "selected_shelltype=%nextshelltype[win32___________]%" +@REM @ECHO selected_shelltype %selected_shelltype% +@CALL :stringTrimTrailingUnderscores %selected_shelltype% selected_shelltype_trimmed +@REM @ECHO selected_shelltype_trimmed %selected_shelltype_trimmed% +@SET "selected_shellpath=%nextshellpath[win32___________]%" +@CALL :stringTrimTrailingUnderscores %selected_shellpath% selected_shellpath_trimmed +@CALL SET "keyRemoved=%%validshelltypes:!selected_shelltype!=%%" +@REM @ECHO keyremoved %keyRemoved% +@REM Note that 'powershell' e.g v5 is just a fallback for when pwsh is not available +@REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### +@REM -- cmd/batch file section (ignored on unix but should be left in place) +@REM -- This section intended mainly to launch the next shell (and to escalate privileges if necessary) +@REM -- Avoid customising this if you are not familiar with batch scripting. cmd/batch script can be useful, but is probably the least expressive language and most error prone. +@REM -- For example - as this file needs to use unix-style lf line-endings - the label scanner is susceptible to the 512Byte boundary issue: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 +@REM -- This label issue can be triggered/abused in files with crlf line endings too - but it is less likely to happen accidentaly. +@REm -- See also: https://stackoverflow.com/questions/4094699/how-does-the-windows-command-interpreter-cmd-exe-parse-scripts/4095133#4095133 +@REM ############################################################################################################################ +@REM -- Due to this issue -seemingly trivial edits of the batch file section can break the script! (for Windows anyway) +@REM -- Even something as simple as adding or removing an @REM +@REM -- From within punkshell - use: +@REM -- deck scriptwrap.checkfile +@REM -- to check your templates or final wrapped scripts for byte boundary issues +@REM -- It will report any labels that are on boundaries +@REM -- This is why the nextshell value above is a 2 digit key instead of a string - so that editing the value doesn't change the byte offsets. +@REM -- Editing your sh,bash,tcl,pwsh payloads is much less likely to cause an issue. There is the possibility of the final batch :exit_multishell label spanning a boundary - so testing using deck scriptwrap.checkfile is still recommended. +@REM -- Alternatively, as you should do anyway - test the final script on windows +@REM -- Aside from adding comments/whitespace to tweak the location of labels - you can try duplicating the label (e.g just add the label on a line above) but this is not guaranteed to work in all situations. +@REM -- '@REM' is a safer comment mechanism than a leading colon - which is used sparingly here. +@REM -- A colon anywhere in the script that happens to land on a 512 Byte boundary (from file start or from a callsite) could be misinterpreted as a label +@REM -- It is unknown what versions of cmd interpreters behave this way - and deck scriptwrap.checkfile doesn't check all such boundaries. +@REm -- For this reason, batch labels should be chosen to be relatively unlikely to collide with other strings in the file, and simple names such as :exit or :end should probably be avoided +@REM ############################################################################################################################ +@REM -- custom windows payloads should be in powershell,tclsh (or sh/bash if available) code sections +@REM ## ### ### ### ### ### ### ### ### ### ### ### ### ### +@SET "winpath=%~dp0" +@SET "fname=%~nx0" +@REM @ECHO fname %fname% +@REM @ECHO winpath %winpath% +@REM @ECHO commandlineascalled %0 +@REM @ECHO commandlineresolved %~f0 +@CALL :getNormalizedScriptTail nftail +@REM @ECHO normalizedscripttail %nftail% +@CALL :getFileTail %0 clinetail +@REM @ECHO clinetail %clinetail% +@CALL :stringToUpper %~nx0 capscripttail +@REM @ECHO capscriptname: %capscripttail% + +@IF "%nftail%"=="%capscripttail%" ( + @ECHO forcing asadmin=1 due to file name on filesystem being uppercase + @SET "asadmin=1" +) else ( + @CALL :stringToUpper %clinetail% capcmdlinetail + @REM @ECHO capcmdlinetail !capcmdlinetail! + IF "%clinetail%"=="!capcmdlinetail!" ( + @ECHO forcing asadmin=1 due to cmdline scriptname in uppercase + @set "asadmin=1" + ) +) +@SET "vbsGetPrivileges=%temp%\punk_bat_elevate_%fname%.vbs" +@SET arglist=%* +@SET "qstrippedargs=args%arglist%" +@SET "qstrippedargs=%qstrippedargs:"=%" +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" ( + GOTO :gotPrivileges +) +@IF !asadmin!==1 ( + net file 1>NUL 2>NUL + @IF '!errorlevel!'=='0' ( GOTO :gotPrivileges ) else ( GOTO :getPrivileges ) +) +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@REM padding +@GOTO skip_privileges +:getPrivileges +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" (echo PUNK-ELEVATED & shift /1 & goto :gotPrivileges ) +@ECHO Set UAC = CreateObject^("Shell.Application"^) > "%vbsGetPrivileges%" +@ECHO args = "PUNK-ELEVATED " >> "%vbsGetPrivileges%" +@ECHO For Each strArg in WScript.Arguments >> "%vbsGetPrivileges%" +@ECHO args = args ^& strArg ^& " " >> "%vbsGetPrivileges%" +@ECHO Next >> "%vbsGetPrivileges%" +@ECHO UAC.ShellExecute "%~dp0%~n0%~x0", args, "", "runas", 1 >> "%vbsGetPrivileges%" +@ECHO Launching script in new windows due to administrator elevation +@"%SystemRoot%\System32\WScript.exe" "%vbsGetPrivileges%" %* +@EXIT /B + +:gotPrivileges +@REM setlocal & pushd . +@PUSHD . +@cd /d %~dp0 +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" ( + @DEL "%vbsGetPrivileges%" 1>nul 2>nul + @SET arglist=%arglist:~14% +) + +:skip_privileges +@SET need_ps1=0 +@REM we want the ps1 to exist even if the nextshell isn't powershell +@if not exist "%~dp0%~n0.ps1" ( + @SET need_ps1=1 +) ELSE ( + fc "%~dp0%~n0%~x0" "%~dp0%~n0.ps1" >nul || goto different + @REM @ECHO "files same" + @SET need_ps1=0 +) +@GOTO :pscontinue +:different +@REM @ECHO "files differ" +@SET need_ps1=1 +:pscontinue +@IF !need_ps1!==1 ( + COPY "%~dp0%~n0%~x0" "%~dp0%~n0.ps1" >NUL +) +@REM avoid using CALL to launch pwsh,tclsh etc - it will intercept some args such as /? +@IF "%selected_shelltype_trimmed%"=="powershell" ( + REM pws vs powershell hasn't been tested because we didn't need to copy cmd to ps1 this time + REM test availability of preferred option of powershell7+ pwsh + pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; write-host "statusmessage: pwsh-found" >NUL + SET pwshtest_exitcode=!errorlevel! + REM ECHO pwshtest_exitcode !pwshtest_exitcode! + REM fallback to powershell if pwsh failed + IF !pwshtest_exitcode!==0 ( + pwsh -nop -nol -c set-executionpolicy -Scope Process Unrestricted; "%~dp0%~n0.ps1" %arglist% + SET task_exitcode=!errorlevel! + ) ELSE ( + REM CALL powershell -nop -nol -c write-host powershell-found + REM powershell -nop -nol -file "%~dp0%~n0.ps1" %* + powershell -nop -nol -c set-executionpolicy -Scope Process Unrestricted; %~dp0%~n0.ps1" %arglist% + SET task_exitcode=!errorlevel! + ) +) ELSE ( + IF "%selected_shelltype_trimmed%"=="wslbash" ( + CALL :getWslPath %winpath% wslpath + REM ECHO wslfullpath "!wslpath!%fname%" + %selected_shellpath_trimmed% "!wslpath!%fname%" %arglist% + SET task_exitcode=!errorlevel! + ) ELSE ( + REM perl or tcl or sh or bash + IF NOT "x%keyRemoved%"=="x%validshelltypes%" ( + REM sh on windows uses /c/ instead of /mnt/c - at least if using msys. Todo, review what is the norm on windows with and without msys2,cygwin,wsl + REM and what logic if any may be needed. For now sh with /c/xxx seems to work the same as sh with c:/xxx + REM The compound statement with trailing call is required to stop batch termination confirmation, whilst still capturing exitcode + %selected_shellpath_trimmed% "%~dp0%fname%" %arglist% & SET task_exitcode=!errorlevel! & Call; + ) ELSE ( + ECHO %fname% has invalid nextshelltype value %selected_shelltype% valid options are %validshelltypes% + SET task_exitcode=66 + @REM boundary padding + @REM boundary padding + @REM boundary padding + @REM boundary padding + GOTO :exit_multishell + ) + ) +) +@REM batch file library functions +@REM boundary padding +@GOTO :endlib + +:getWslPath +@SETLOCAL + @SET "_path=%~p1" + @SET "name=%~nx1" + @SET "drive=%~d1" + @SET "rtrn=%~2" + @REM Although drive letters on windows are normally upper case wslbash seems to expect lower case drive letters + @CALL :stringToLower %drive ldrive + @SET "result=/mnt/%ldrive:~0,1%%_path:\=/%%name%" +@ENDLOCAL & ( + @if "%~2" neq "" ( + SET "%rtrn%=%result%" + ) ELSE ( + ECHO %result% + ) +) +@EXIT /B + +:getFileTail +@REM return tail of file without any normalization e.g c:/punkshell/bin/Punk.cmd returns Punk.cmd even if file is punk.cmd +@REM we can't use things such as %~nx1 as it can change capitalisation +@REM This function is designed explicitly to preserve capitalisation +@REM accepts full paths with either / or \ as delimiters - or +@SETLOCAL + @SET "rtrn=%~2" + @SET "arg=%~1" + @REM @SET "result=%_arg:*/=%" + @REM @SET "result=%~1" + @SET LF=^ + + + : The above 2 empty lines are important. Don't remove + @CALL :stringContains "!arg!" "\" hasBackSlash + @IF "!hasBackslash!"=="true" ( + @for %%A in ("!LF!") do @( + @FOR /F %%B in ("!arg:\=%%~A!") do @set "result=%%B" + ) + ) ELSE ( + @CALL :stringContains "!arg!" "/" hasForwardSlash + @IF "!hasForwardSlash!"=="true" ( + @FOR %%A in ("!LF!") do @( + @FOR /F %%B in ("!arg:/=%%~A!") do @set "result=%%B" + ) + ) ELSE ( + @set "result=%arg%" + ) + ) +@ENDLOCAL & ( + @if "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO %result% + ) +) +@EXIT /B +@REM boundary padding +@REM boundary padding +:getNormalizedScriptTail +@SETLOCAL + @SET "result=%~nx0" + @SET "rtrn=%~1" +@ENDLOCAL & ( + @IF "%~1" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO %result% + ) +) +@EXIT /B + +:getNormalizedFileTailFromPath +@REM warn via echo, and do not set return variable if path not found +@REM note that %~nx1 does not preserve case of provided path - hence the name 'normalized' +@REM boundary padding +@REM boundary padding +@REM boundary padding +@REM boundary padding +@SETLOCAL + @CALL :stringContains %~1 "\" hasBackSlash + @CALL :stringContains %~1 "/" hasForwardSlash + @IF "%hasBackslash%-%hasForwardslash%"=="false-false" ( + @SET "P=%cd%%~1" + @CALL :getNormalizedFileTailFromPath "!P!" ftail2 + @SET "result=!ftail2!" + ) else ( + @IF EXIST "%~1" ( + @SET "result=%~nx1" + ) else ( + @ECHO error getNormalizedFileTailFromPath file not found: %~1 + @EXIT /B 1 + ) + ) + @SET "rtrn=%~2" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + SET "%rtrn%=%result%" + ) ELSE ( + @ECHO getNormalizedFileTailFromPath %1 result: %result% + ) +) +@EXIT /B + +:stringContains +@REM usage: @CALL:stringContains string needle returnvarname +@SETLOCAL + @SET "rtrn=%~3" + @SET "string=%~1" + @SET "needle=%~2" + @IF "!string:%needle%=!"=="!string!" @( + @SET "result=false" + ) ELSE ( + @SET "result=true" + ) +@ENDLOCAL & ( + @IF "%~3" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringContains %string% %needle% result: %result% + ) +) +@EXIT /B +@REM boundary padding +@REM boundary padding +:stringToUpper +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "capstring=%~1" + @FOR %%A in (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z) DO @( + @SET "capstring=!capstring:%%A=%%A!" + ) + @SET "result=!capstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringToUpper %string% result: %result% + ) +) +@EXIT /B +:stringToLower +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "retstring=%~1" + @FOR %%A in (a b c d e f g h i j k l m n o p q r s t u v w x y z) DO @( + @SET "retstring=!retstring:%%A=%%A!" + ) + @SET "result=!retstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringToLower %string% result: %result% + ) +) +@EXIT /B +@REM boundary padding +@REM boundary padding +:stringTrimTrailingUnderscores +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "trimstring=%~1" + @REM trim up to 31 underscores from the end of a string using string substitution + @SET trimstring=%trimstring%### + @SET trimstring=%trimstring:________________###=###% + @SET trimstring=%trimstring:________###=###% + @SET trimstring=%trimstring:____###=###% + @SET trimstring=%trimstring:__###=###% + @SET trimstring=%trimstring:_###=###% + @SET trimstring=%trimstring:###=% + @SET "result=!trimstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringTrimTrailingUnderscores %string% result: %result% + ) +) +@EXIT /B +:isNumeric +@SETLOCAL + @SET "notnumeric="&FOR /F "delims=0123456789" %%i in ("%1") do set "notnumeric=%%i" + @IF defined notnumeric ( + @SET "result=false" + ) else ( + @SET "result=true" + ) + @SET "rtrn=%~2" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO %result% + ) +) +@EXIT /B + +:endlib +: \ +@REM padding +@REM padding +@REM @SET taskexit_code=!errorlevel! & goto :exit_multishell +@GOTO :exit_multishell +# } +# -*- tcl -*- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- tcl script section +# -- This is a punk multishell file +# -- Primary payload target is Tcl, with sh,bash,powershell as helpers +# -- but it may equally be used with any of these being the primary script. +# -- It is tuned to run when called as a batch file, a tcl script a sh/bash script or a pwsh/powershell script +# -- i.e it is a polyglot file. +# -- The specific layout including some lines that appear just as comments is quite sensitive to change. +# -- It can be called on unix or windows platforms with or without the interpreter being specified on the commandline. +# -- e.g ./filename.polypunk.cmd in sh or bash +# -- e.g tclsh filename.cmd +# -- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +rename set ""; rename s set; set k {-- "$@" "a}; if {[info exists ::env($k)]} {unset ::env($k)} ;# tidyup and restore +Hide :exit_multishell;Hide {<#};Hide '@ +namespace eval ::punk::multishell { + set last_script_root [file dirname [file normalize ${::argv0}/__]] + set last_script [file dirname [file normalize [info script]/__]] + if {[info exists ::argv0] && + $last_script eq $last_script_root + } { + set ::punk::multishell::is_main($last_script) 1 ;#run as executable/script - likely desirable to launch application and return an exitcode + } else { + set ::punk::multishell::is_main($last_script) 0 ;#sourced - likely to be being used as a library - no launch, no exit. Can use return. + } + if {"::punk::multishell::is_main" ni [info commands ::punk::multishell::is_main]} { + proc ::punk::multishell::is_main {{script_name {}}} { + if {$script_name eq ""} { + set script_name [file dirname [file normalize [info script]/--]] + } + if {![info exists ::punk::multishell::is_main($script_name)]} { + #e.g a .dll or something else unanticipated + puts stderr "Warning punk::multishell didn't recognize info script result: $script_name - will treat as if sourced and return instead of exiting" + puts stderr "Info: script_root: [file dirname [file normalize ${::argv0}/__]]" + return 0 + } + return [set ::punk::multishell::is_main($script_name)] + } + } +} +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin Tcl Payload +#puts "script : [info script]" +#puts "argcount : $::argc" +#puts "argvalues: $::argv" +#puts "argv0 : $::argv0" +# -- --- --- --- --- --- --- --- --- --- --- --- + + +# +# + +# +# + + +# +# + + +# -- --- --- --- --- --- --- --- --- --- --- --- +# -- Best practice is to always return or exit above, or just by leaving the below defaults in place. +# -- If the multishell script is modified to have Tcl below the Tcl Payload section, +# -- then Tcl bracket balancing needs to be carefully managed in the shell and powershell sections below. +# -- Only the # in front of the two relevant if statements below needs to be removed to enable Tcl below +# -- but the sh/bash 'then' and 'fi' would also need to be uncommented. +# -- This facility left in place for experiments on whether configuration payloads etc can be appended +# -- to tail of file - possibly binary with ctrl-z char - but utility is dependent on which other interpreters/shells +# -- can be made to ignore/cope with such data. +if {[::punk::multishell::is_main]} { + exit 0 +} else { + return +} +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end Tcl Payload +# end hide from unix shells \ +HEREDOC1B_HIDE_FROM_BASH_AND_SH +# sh/bash \ +shift && set -- "${@:1:$#-1}" +#------------------------------------------------------ +# -- This if block only needed if Tcl didn't exit or return above. +if false==false # else { + then + : # +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- sh/bash script section +# -- leave as is if all that is required is launching the Tcl payload" +# -- +# -- Note that sh/bash script isn't called when running a .bat/.cmd from cmd.exe on windows by default +# -- adjust the %nextshell% value above +# -- if sh/bash scripting needs to run on windows too. +# -- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin sh Payload +exitcode=0 +#printf "start of bash or sh code" + +# +echo "output from example.sh wrapped in polyglot script" +# + +# -- --- --- --- --- --- --- --- +# +#-- sh/bash launches Tcl here instead of shebang line at top +#-- use exec to use exitcode (if any) directly from the tcl script +#exec /usr/bin/env tclsh "$0" "$@" +#-- alternative - can run sh/bash script after the tcl call. +/usr/bin/env tclsh "$0" "$@" +exitcode=$? +#echo "sh/bash reporting tcl exitcode: ${exitcode}" +#-- override exitcode example +#exit 66 +# +# -- --- --- --- --- --- --- --- + +# +# + + +#printf "sh/bash done \n" +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end sh Payload +#------------------------------------------------------ +fi +exit ${exitcode} +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- Perl script section +# -- leave the script below as is, if all that is required is launching the Tcl payload" +# -- +# -- Note that perl script isn't called by default when simply running this script by name +# -- adjust the nextshell value at the top of the script to point to perl +# -- +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +=cut +#!/user/bin/perl +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin perl Payload +my $exit_code = 0; +#use ExtUtils::Installed; +#my $installed = ExtUtils::Installed->new(); +#my @modules = $installed->modules(); +#print "Modules:\n"; +#foreach my $m (@modules) { +# print "$m\n"; +#} +# -- --- --- + + + +my $scriptname = $0; +print "perl $scriptname\n"; +my $i =1; +foreach my $a(@ARGV) { + print "Arg # $i: $a\n"; +} + +# +# + + + +# -- --- --- --- --- --- --- --- +# +$exit_code=system("tclsh", $scriptname, @ARGV); +#print "perl reporting tcl exitcode: $exit_code"; +# +# -- --- --- --- --- --- --- --- + +# +# + + +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end perl Payload +exit $exit_code; +__END__ + +# end hide sh/bash/perl block from Tcl +# This comment with closing brace should stay in place whether if commented or not } +#------------------------------------------------------ +# begin hide powershell-block from Tcl - only needed if Tcl didn't exit or return above +if 0 { +: end heredoc1 - end hide from powershell \ +'@ +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +# -- powershell/pwsh section +# -- Do not edit if current file is the .ps1 +# -- Edit the corresponding .cmd and it will autocopy +# -- unbalanced braces { } here *even in comments* will cause problems if there was no Tcl exit or return above +# -- custom script should generally go below the begin_powershell_payload line +# ## ### ### ### ### ### ### ### ### ### ### ### ### ### +function GetScriptName { $myInvocation.ScriptName } +$scriptname = GetScriptName +function GetDynamicParamDictionary { + [CmdletBinding()] + param( + [Parameter(ValueFromPipeline=$true, Mandatory=$true)] + [string] $CommandName + ) + + begin { + # Get a list of params that should be ignored (they're common to all advanced functions) + $CommonParameterNames = [System.Runtime.Serialization.FormatterServices]::GetUninitializedObject([type] [System.Management.Automation.Internal.CommonParameters]) | + Get-Member -MemberType Properties | + Select-Object -ExpandProperty Name + } + + process { + # Create the dictionary that this scriptblock will return: + $DynParamDictionary = New-Object System.Management.Automation.RuntimeDefinedParameterDictionary + + # Convert to object array and get rid of Common params: + (Get-Command $CommandName | select -exp Parameters).GetEnumerator() | + Where-Object { $CommonParameterNames -notcontains $_.Key } | + ForEach-Object { + $DynamicParameter = New-Object System.Management.Automation.RuntimeDefinedParameter ( + $_.Key, + $_.Value.ParameterType, + $_.Value.Attributes + ) + $DynParamDictionary.Add($_.Key, $DynamicParameter) + } + + # Return the dynamic parameters + return $DynParamDictionary + } +} +# GetDynamicParamDictionary +# - This can make it easier to share a single set of param definitions between functions +# - sample usage +#function ParameterDefinitions { +# param( +# [Parameter(Mandatory)][string] $myargument +# ) +#} +#function psmain { +# [CmdletBinding()] +# param() +# dynamicparam { GetDynamicParamDictionary ParameterDefinitions } +# process { +# #called once with $PSBoundParameters dictionary +# #can be used to validate arguments, or set a simpler variable name for access +# switch ($PSBoundParameters.keys) { +# 'myargumentname' { +# Set-Variable -Name $_ -Value $PSBoundParameters."$_" +# } +# #... +# } +# foreach ($boundparam in $PSBoundParameters.GetEnumerator()) { +# #... +# } +# } +# end { +# #Main function logic +# Write-Host "myargumentname value is: $myargumentname" +# #myotherfunction @PSBoundParameters +# } +#} +#psmain @args +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---begin powershell Payload +#"Timestamp : {0,10:yyyy-MM-dd HH:mm:ss}" -f $(Get-Date) | write-host +#"Script Name : {0}" -f $scriptname | write-host +#"Powershell Version: {0}" -f $PSVersionTable.PSVersion.Major | write-host +#"powershell args : {0}" -f ($args -join ", ") | write-host +# -- --- --- --- + +# +# + + +# -- --- --- --- --- --- --- --- +# +tclsh $scriptname $args +#"powershell reporting exitcode: {0}" -f $LASTEXITCODE | write-host +# +# -- --- --- --- --- --- --- --- + + +# +# + +# -- --- --- --- --- --- --- --- --- --- --- --- --- ---end powershell Payload +Exit $LASTEXITCODE +# heredoc2 for powershell to ignore block below +$1 = @' +' +: comment end hide powershell-block from Tcl \ +# This comment with closing brace should stay in place whether 'if' commented or not } +: multishell doubled-up cmd exit label - return exitcode +:exit_multishell +:exit_multishell +: \ +@REM @ECHO exitcode: !task_exitcode! +: \ +@IF "is%qstrippedargs:~4,13%"=="isPUNK-ELEVATED" (echo. & @cmd /k echo elevated prompt: type exit to quit) +: \ +@EXIT /B !task_exitcode! +# cmd has exited +: comment end heredoc2 \ +'@ +<# +# id:tailblock0 +# -- powershell multiline comment +#> +<# +no script engine should try to run me +# id:tailblock1 +# + +# +# -- unreachable by tcl directly if ctrl-z character is in the section above. (but file can be read and split on \x1A) +# -- Potential for zip and/or base64 contents, but we can't stop pwsh parser from slurping in the data +# -- so for example a plain text tar archive could cause problems depending on the content. +# -- final line in file must be the powershell multiline comment terminator or other data it can handle. +# -- e.g plain # comment lines will work too +# -- (for example a powershell digital signature is a # commented block of data at the end of the file) +#> + + diff --git a/src/scriptapps/example_wrap.toml b/src/scriptapps/example_wrap.toml new file mode 100644 index 00000000..3e7b0d62 --- /dev/null +++ b/src/scriptapps/example_wrap.toml @@ -0,0 +1,41 @@ +[application] + template="punk.multishell.cmd" + + #scripts=[ + # "example.sh", + # "example.tcl" + #] + scripts=[ + "example.sh" + ] + + default_outputfile="example_out.sh" + default_nextshellpath="/usr/bin/env tclsh" + default_nextshelltype="tcl" + + + #valid nextshelltype entries are: tcl perl powershell bash. + #nextshellpath entries must be 32 characters or less. + + win32.nextshellpath="tclsh" + win32.nextshelltype="tcl" + win32.outputfile="example_out.bat" + + dragonflybsd.nextshellpath="/usr/bin/env tclsh" + dragonflybsd.nextshelltype="tcl" + + freebsd.nextshellpath="/usr/bin/env tclsh" + freebsd.nextshelltype="tcl" + + netbsd.nextshellpath="/usr/bin/env tclsh" + netbsd.nextshelltype="tcl" + + linux.nextshellpath="/usr/bin/env tclsh" + linux.nextshelltype="tcl" + + macosx.nextshellpath="/usr/bin/env tclsh" + macosx.nextshelltype="tcl" + + other.nextshellpath="/usr/bin/env tclsh" + other.nextshelltype="tcl" + diff --git a/src/vfs/_config/punk_main.tcl b/src/vfs/_config/punk_main.tcl index 6ecce171..8081acfe 100644 --- a/src/vfs/_config/punk_main.tcl +++ b/src/vfs/_config/punk_main.tcl @@ -43,7 +43,7 @@ apply { args { set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] - puts stderr "STARKIT: [package provide starkit]" + #puts stderr "STARKIT: [package provide starkit]" set topdir [file dirname $normscript] set found_starkit_tcl 0 @@ -60,10 +60,10 @@ apply { args { #package versions does not always return versions in increasing order! if {[set starkitv [lindex [lsort -command {package vcompare} [package versions starkit]] end]] ne ""} { #run the ifneeded script for the latest found (assuming package versions ordering is correct) - puts "111 autopath: $::auto_path" + #puts "111 autopath: $::auto_path" eval [package ifneeded starkit $starkitv] set found_starkit_tcl 1 - puts "222 autopath: $::auto_path" + #puts "222 autopath: $::auto_path" } if {!$found_starkit_tcl} { #our internal 'quick' search for starkit failed. @@ -263,8 +263,8 @@ apply { args { #(differences in boot.tcl in the kits) if {[llength $package_modes] > 1} { - puts stderr "main.tcl PACKAGE MODE is preferencing libraries and modules in the order: $package_modes" - puts stderr "main.tcl original auto_path: $::auto_path" + #puts stderr "main.tcl PACKAGE MODE is preferencing libraries and modules in the order: $package_modes" + #puts stderr "main.tcl original auto_path: $::auto_path" #------------------------------------------------------------------------------ @@ -614,8 +614,8 @@ apply { args { } } } - puts stderr "main.tcl internal_paths: $internal_paths" - puts stderr "main.tcl filtered_auto_path: $filtered_auto_path" + #puts stderr "main.tcl internal_paths: $internal_paths" + #puts stderr "main.tcl filtered_auto_path: $filtered_auto_path" set filtered_tm_list [list] foreach tm [tcl::tm::list] { @@ -700,8 +700,8 @@ apply { args { } #force rescan #catch {package require flobrudder666_nonexistant} - puts stderr "main.tcl auto_path :$::auto_path" - puts stderr "main.tcl tcl::tm::list:[tcl::tm::list]" + #puts stderr "main.tcl auto_path :$::auto_path" + #puts stderr "main.tcl tcl::tm::list:[tcl::tm::list]" } if {1 || $has_zipfs_attached} { diff --git a/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl b/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl index 95f057bb..0508bafe 100644 --- a/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl +++ b/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl @@ -88,11 +88,24 @@ namespace eval shellspy { return [expr {[clock millis]/1000.0}] } variable shellspy_status_log "shellspy-[clock micros]" - set debug_syslog_server 127.0.0.1:514 - #set debug_syslog_server 172.16.6.42:51500 - #set debug_syslog_server "" - set error_syslog_server 127.0.0.1:514 - set data_syslog_server 127.0.0.1:514 + + #todo - default to no logging not even to local syslog + #load a .toml config which can configure logging as desired + set do_log 0 + if {$do_log} { + set debug_syslog_server 127.0.0.1:514 + #set debug_syslog_server 172.16.6.42:51500 + #set debug_syslog_server "" + set error_syslog_server 127.0.0.1:514 + set data_syslog_server 127.0.0.1:514 + } else { + set debug_syslog_server "" + set error_syslog_server "" + set data_syslog_server "" + } + + + shellfilter::log::open $shellspy_status_log [list -tag $shellspy_status_log -syslog $debug_syslog_server -file ""] shellfilter::log::write $shellspy_status_log "shellspy launch with args '$::argv'" @@ -570,8 +583,9 @@ namespace eval shellspy { proc do_script_process {scriptbin scriptname args} { variable shellspy_status_log shellfilter::log::write $shellspy_status_log "do_script_process got scriptname:'$scriptname' args:'$args'" - set args [do_callback script_process {*}$args] - set params [do_callback_parameters script_process] + #no script_process callbacks + #set args [do_callback script_process {*}$args] + #set params [do_callback_parameters script_process] dict set params -teehandle shellspy set params [dict merge $params [get_channel_config $::testconfig]] @@ -620,7 +634,7 @@ namespace eval shellspy { proc do_script {scriptname replwhen args} { #ideally we don't want to launch an external process to run the script variable shellspy_status_log - shellfilter::log::write $shellspy_status_log "do_script got scriptname:'$scriptname' replwhen:$replwhen args:'$args'" + #shellfilter::log::write $shellspy_status_log "do_script got scriptname:'$scriptname' replwhen:$replwhen args:'$args'" set exepath [file dirname [file join [info nameofexecutable] __dummy__]] set exedir [file dirname $exepath] @@ -651,7 +665,7 @@ namespace eval shellspy { set modulesdir $basedir/modules set script [string map [list %a% $args %s% $scriptpath %m% $modulesdir] { -::tcl::tm::add %m% +#::tcl::tm::add %m% set scriptname %s% set normscript [file normalize $scriptname] @@ -696,9 +710,10 @@ dict with prevglobal {} #just the script } + #no script callbacks + #set args [do_callback script {*}$args] + #set params [do_callback_parameters script] - set args [do_callback script {*}$args] - set params [do_callback_parameters script] dict set params -tclscript 1 ;#don't give callback a chance to omit/break this dict set params -teehandle shellspy #dict set params -teehandle punksh @@ -716,7 +731,8 @@ dict with prevglobal {} # shellfilter::log::write $shellspy_status_log "do_script returning $exitinfo" #} - shellfilter::log::write $shellspy_status_log "do_script raw exitinfo: $exitinfo" + #jjj + #shellfilter::log::write $shellspy_status_log "do_script raw exitinfo: $exitinfo" if {[dict exists $exitinfo errorInfo]} { #strip out the irrelevant info from the errorInfo - we don't want info beyond 'invoked from within' as this is just plumbing related to the script sourcing set stacktrace [string map [list \r\n \n] [dict get $exitinfo errorInfo]] @@ -730,7 +746,8 @@ dict with prevglobal {} } set output [string trimright $output \n] dict set exitinfo errorInfo $output - shellfilter::log::write $shellspy_status_log "do_script simplified exitinfo: $exitinfo" + #jjj + #shellfilter::log::write $shellspy_status_log "do_script simplified exitinfo: $exitinfo" } return $exitinfo } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm index a4f56010..1b15d45a 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/libunknown-0.1.tm @@ -890,10 +890,10 @@ tcl::namespace::eval punk::libunknown { set prev_e [dict get $epoch pkg current] set current_e [expr {$prev_e + 1}] # ------------- - puts stderr "--> pkg epoch $prev_e -> $current_e" - puts stderr "args: $args" - puts stderr "last_auto: $last_auto_path" - puts stderr "auto_path: $auto_path" + #puts stderr "--> pkg epoch $prev_e -> $current_e" + #puts stderr "args: $args" + #puts stderr "last_auto: $last_auto_path" + #puts stderr "auto_path: $auto_path" # ------------- if {[llength $auto_path] > [llength $last_auto_path] && [punk::libunknown::lib::is_list_all_in_list $last_auto_path $auto_path]} { #The auto_path changed, and is a pure addition of entry/entries diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/scriptwrap-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/scriptwrap-0.1.0.tm index 8ef36e27..06b145de 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/scriptwrap-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/commandset/scriptwrap-0.1.0.tm @@ -20,7 +20,7 @@ #[manpage_begin punkshell_module_scriptwrap 0 0.1.0] #[copyright "2024"] #[titledesc {scriptwrap polyglot tool}] [comment {-- Name section and table of contents description --}] -#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] +#[moddesc {scriptwrap tool}] [comment {-- Description at end of page heading --}] #[require punk::mix::commandset::scriptwrap] #[keywords module commandset launcher scriptwrap] #[description] @@ -30,7 +30,7 @@ #*** !doctools #[section Overview] -#[para] overview of scriptwrap +#[para] overview of scriptwrap #[subsection Concepts] #[para] - @@ -74,7 +74,7 @@ package require punk::fileline namespace eval punk::mix::commandset::scriptwrap { #*** !doctools #[subsection {Namespace punk::mix::commandset::scriptwrap}] - #[para] Core API functions for punk::mix::commandset::scriptwrap + #[para] Core API functions for punk::mix::commandset::scriptwrap #[list_begin definitions] namespace export * @@ -93,7 +93,7 @@ namespace eval punk::mix::commandset::scriptwrap { foreach k [lreverse [dict keys $tdict_low_to_high]] { dict set tdict $k [dict get $tdict_low_to_high $k] } - + #set pathinfolist [dict values $tdict] set names [dict keys $tdict] @@ -142,9 +142,9 @@ namespace eval punk::mix::commandset::scriptwrap { put stderr "commandset::scriptwrap::templates_dict WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide template locations" } return - } - - + } + + #A batch file with unix line-endings is sensitive to label positioning. #batch file with windows crlf line endings can exhibit this problem - but probably only if specifically crafted with long lines deliberately designed to trigger it. #see: https://www.dostips.com/forum/viewtopic.php?t=8988#p58888 (Call and goto may fail when the batch file has Unix line endings) @@ -808,176 +808,317 @@ namespace eval punk::mix::commandset::scriptwrap { return $result } #specific filepath to just wrap one script at the xxx-pre-launch-suprocess site - #scriptset name to substiture multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf - proc multishell {filepath_or_scriptset args} { - set opts [dict create\ - -askme 1\ - -outputfolder "\uFFFF"\ - -template "\uFFFF"\ - -returnextra 0\ - -force 0\ - ] - #set known_opts [dict keys $defaults] - foreach {k v} $args { - switch -- $k { - -askme - -outputfolder - -template - -returnextra - -force { - dict set opts $k $v - } - default { - error "punk::mix::commandset::multishell error. Unrecognized option '$k'. Known-options: [dict keys $opts]" - } + #scriptset name to substitute multiple scriptset.xxx files at the default locations - or as specified in scriptset.wrapconf + #set usage "" + #append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n + #append usage "The scriptset name will be used to search for .sh|.tcl|.ps1 or names as you specify in yourname.wrapconfig if it exists" \n + #append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n + #if {![string length $filepath_or_scriptset]} { + # puts stderr "No filepath_or_scriptset specified" + # puts stderr $usage + # return false + #} + proc _read_scriptset_wrap_tomlfile {fname} { + set resultd [dict create] + package require tomlish + set tomldata [readFile $fname] + #todo - fix tomlish to provide line number in ERROR structure during from_toml call. + if {[catch {tomlish::to_dict [tomlish::from_toml $tomldata]} tomldict]} { + puts stderr "Failed to parse $fname" + puts stderr "error: $tomldict" + } + if {[tomlish::dict::path::exists $tomldict {.application.template}]} { + dict set resultd template [tomlish::dict::path::get $tomldict {.application.template.value}] + } + set scripts [list] + if {[tomlish::dict::path::exists $tomldict {.application.scripts.value}]} { + set arrvalues [tomlish::dict::path::get $tomldict {.application.scripts.value}] + foreach tvdict $arrvalues { + lappend scripts [dict get $tvdict value] } } + dict set resultd scripts $scripts - set usage "" - append usage "Use directly with the script file to wrap, or supply the name of a scriptset" \n - append usage "The scriptset name will be used to search for yourname.sh|tcl|ps1 or names as you specify in yourname.wrapconfig if it exists" \n - append usage "If no template is specified in a .wrapconfig and no -template argument is supplied, it will default to punk-multishell.cmd" \n - if {![string length $filepath_or_scriptset]} { - puts stderr "No filepath_or_scriptset specified" - puts stderr $usage - return false + set ftail [file rootname [file tail $fname]] ;#e.g example_wrap.toml + set scriptset [lindex [split $ftail _] 0] + set fallback_outputfile $scriptset.cmd + set fallback_nextshellpath "/usr/bin/env tclsh" + set fallback_nextshelltype "tcl" + + if {[tomlish::dict::path::exists $tomldict {.application.default_outputfile.value}]} { + dict set resultd default_outputfile [tomlish::dict::path::get $tomldict {.application.default_outputfile.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshellpath.value}]} { + dict set resultd default_nextshellpath [tomlish::dict::path::get $tomldict {.application.default_nextshellpath.value}] + } + if {[tomlish::dict::path::exists $tomldict {.application.default_nextshelltype.value}]} { + dict set resultd default_nextshelltype [tomlish::dict::path::get $tomldict {.application.default_nextshelltype.value}] + } + foreach platform {win32 dragonflybsd freebsd netbsd linux macosx other} { + set d [dict create] + foreach field {outputfile nextshellpath nextshelltype} { + if {[tomlish::dict::path::exists $tomldict ".application.$platform.$field.value"]} { + dict set d $field [tomlish::dict::path::get $tomldict ".application.$platform.$field.value"] + } else { + if {[dict exists $resultd default_$field]} { + dict set d $field [dict get $resultd default_$field] + } else { + dict set d $field [set fallback_$field] + } + } + } + dict set resultd $platform $d } + + return $resultd + } + punk::args::define { + @id -id ::punk::mix::commandset::scriptwrap::multishell + @cmd -name punk::mix::commandset::scriptwrap::multishell\ + -summary\ + "Wrap script(s) into a polyglot cross-platform executable script."\ + -help\ + "Create a polyglot executable script that wraps constituent scripts written in + various scripting languages such as perl, tcl, shell script, powershell. + The resulting polyglot file should run cross platform on windows and various + types of unix-like OS. For use on windows the output file should be named with + a .bat or .cmd extension - but the same file with extension removed should also + be capable of running on FreeBSD, Linux etc. + Note that a polyglot script such as this may be somewhat brittle over the long + term with regards to default shells and scripting languages across platforms." + @leaders -min 1 -max 1 + filepath_or_scriptset -type string -minsize 1 -help\ + "Supply the path to a single script file to wrap, or the name of a scriptset. + The scriptset name will be used to search for .sh|.bash|.tcl|.ps1|.pl + or alternatively, names as specified in a configuration file named _wrap.toml + if it exists in the current folder, or is specified with a full path name. + If no template name/path is specified in a _wrap.toml file and no + -template argument is supplied the default punk.multishell.cmd will be used. + If the template is specified explicitly in -template as well as in the .toml + file - the supplied -template argument will override that specified in the + .toml file." + @opts + -template -type string -default "punk.multishell.cmd" -help\ + "Templates are provided from modules or paths in the current project, + so available templates will vary based on whether the multishell + command is being run from within a project directory or not. + To see available templates use punk::mix::commandset::scriptwrap::templates." + -outputfolder -type directory -default "" -help\ + "Folder to which to write resulting polyglot script. + If empty, the output will go to the /bin folder or + to the current working directory if there is no projectroot." + -askme -type boolean -default 1 -help\ + "Prompt user at console (stdin) for confirmation of operations such as + overwrite." + -force -type boolean -default 0 + -returnextra -type boolean -default 0 + @values -minvalues 0 -maxvalues 0 + } + #: + #@SET "nextshellpath[win32___________]=tclsh___________________________" + #@SET "nextshelltype[win32___________]=tcl_____________" + #@SET "nextshellpath[dragonflybsd____]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[dragonflybsd____]=tcl_____________" + #@SET "nextshellpath[freebsd_________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[freebsd_________]=tcl_____________" + #@SET "nextshellpath[netbsd__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[netbsd__________]=tcl_____________" + #@SET "nextshellpath[linux___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[linux___________]=tcl_____________" + #@SET "nextshellpath[macosx__________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[macosx__________]=tcl_____________" + #@SET "nextshellpath[other___________]=/usr/bin/env tclsh______________" + #@SET "nextshelltype[other___________]=tcl_____________" + #: + proc multishell {args} { + set argd [punk::args::parse $args withid ::punk::mix::commandset::scriptwrap::multishell] + lassign [dict values $argd] leaders opts values received + # -- --- --- --- --- --- --- --- --- --- --- --- - set opt_askme [dict get $opts -askme] - set opt_template [dict get $opts -template] - set opt_outputfolder [dict get $opts -outputfolder] - set opt_returnextra [dict get $opts -returnextra] - set opt_force [dict get $opts -force] + set filepath_or_scriptset [dict get $leaders filepath_or_scriptset] + set opt_askme [dict get $opts -askme] + set opt_template [dict get $opts -template] ;#use dict exists $received -template to see if overridable in .toml + set opt_outputfolder [dict get $opts -outputfolder] + set opt_returnextra [dict get $opts -returnextra] + set opt_force [dict get $opts -force] # -- --- --- --- --- --- --- --- --- --- --- --- - set ext [file extension $filepath_or_scriptset] set startdir [pwd] + set allowed_extensions [list tcl ps1 sh bash pl] + #TODO - distinct sections for sh vs bash? needs experiments.. + #for now we use shell-pre-launch-subprocess etc + #set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] + set extension_langs [list tcl tcl ps1 powershell sh shell bash shell pl perl] + + if {[file pathtype $filepath_or_scriptset] ni {absolute relative}} { + error "bad pathtype for '$filepath_or_scriptset' (expected absolute or relative path, or name of scriptset)" + } - - - #first check if relative or absolute path matches a file + #first check if absolute path matches a file or relative path from cwd matches a file if {[file pathtype $filepath_or_scriptset] eq "absolute"} { - set specified_path $filepath_or_scriptset + set specified_path $filepath_or_scriptset } else { set specified_path [file join $startdir $filepath_or_scriptset] } + set scriptdir [file dirname $specified_path] + set ext [string trim [file extension $filepath_or_scriptset] .] - set allowed_extensions [list wrapconfig tcl ps1 sh bash pl] - set extension_langs [list tcl tcl ps1 powershell sh sh bash bash pl perl] - #set allowed_extensions [list tcl] - set found_script 0 - if {[file exists $specified_path]} { - set found_script 1 + set scriptset "" + if {$ext eq ""} { + set scriptset [file rootname [file tail $specified_path]] + } elseif {$ext eq "toml"} { + set tomltail [file tail $specified_path] + if {[string match *_wrap.toml $tomltail]} { + set scriptset [lindex [split $tomltail _] 0] + #if .toml was specified - the config file must exist + if {![file exists $specified_path]} { + if {[file pathtype $filepath_or_scriptset] eq "relative"} { + puts stderr "unable to locate '$specified_path' - will continue search in src/scriptapps folder" + } else { + #caller was specific about path - no fallback to src/scriptapps + error "unable to locate '$specified_path'" + } + } + } else { + error "supplied toml file must be of form _wrap.toml" + } } else { - foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { - if {[file exists $filepath_or_scriptset.$e]} { - set found_script 1 - break + if {$ext ni $allowed_extensions} { + error "supplied filepath_or_scriptset must be the name of a scriptset without extension, a file named _wrap.toml, or a script with one of the extensions: $allowed_extensions" + } + } + + set list_input_files [list] + set configd [dict create] + if {$scriptset ne ""} { + puts stdout "Attempting to process all scripts belonging to scriptset '$scriptset'" + #.toml file may or may not exist + if {[file exists ${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptdir/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptdir/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptdir $s] + } + } + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" + return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptdir" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptdir/$scriptset.$e]} { + lappend list_input_files $scriptdir/$scriptset.$e + } } } + } else { + #expect a single script + if {[file exists $specified_path]} { + lappend list_input_files $specified_path + } } + set found_script [expr {[llength $list_input_files] > 0}] #TODO! - use get_wrapper_folders - multishell should use same available templates as the 'templates' function - set scriptset [file rootname [file tail $specified_path]] if {$found_script} { - if {[file type $specified_path] eq "file"} { - set specified_root [file dirname $specified_path] - set pathinfo [punk::repo::find_repos [file dirname $specified_path]] - set projectroot [dict get $pathinfo closest] + #found scripts at absolute path - or path relative to cwd + set scriptroot $scriptdir + set pathinfo [punk::repo::find_repos $scriptroot] + set projectroot [dict get $pathinfo closest] + if {[file exists $scriptroot/wrappers]} { + set customwrapper_folder $scriptroot/wrappers + } else { + #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder if {[string length $projectroot]} { - #use the specified files folder - but use the main scriptapps/wrappers folder if specified one has no wrappers subfolder - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - set customwrapper_folder $projectroot/src/scriptapps/wrappers - } + set customwrapper_folder $projectroot/src/scriptapps/wrappers } else { #outside of any project - set scriptroot [file dirname $specified_path] - if {[file exists $scriptroot/wrappers]} { - set customwrapper_folder $scriptroot/wrappers - } else { - #no customwrapper folder available - set customwrapper_folder "" - } + set customwrapper_folder "" } - } else { - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false } } else { + if {[file pathtype $filepath_or_scriptset] eq "absolute"} { + return false + } set pathinfo [punk::repo::find_repos $startdir] set projectroot [dict get $pathinfo closest] - if {[string length $projectroot]} { - if {[llength [file split $filepath_or_scriptset]] > 1} { - puts stderr "filepath_or_scriptset looks like a path - but doesn't seem to point to a file" - puts stderr "Ensure you are within a project and use just the name of the scriptset, or pass in the full correct path or relative path to current directory" - puts stderr $usage - return false - } else { - #we've already ruled out empty string - so must have a single element representing scriptset - possibly with file extension - set scriptroot $projectroot/src/scriptapps - set customwrapper_folder $projectroot/src/scriptapps/wrappers - #check something matches the scriptset.. - set something_found "" - if {[file exists $scriptroot/$scriptset]} { - set found_script 1 - set something_found $scriptroot/$scriptset ;#extensionless file - that's ok too - } else { - foreach e $allowed_extensions { - if {[file exists $scriptroot/$scriptset.$e]} { - set found_script 1 - set something_found $scriptroot/$scriptset.$e - break - } + if {![string length $projectroot]} { + puts stderr "No matching scripts or config found for $filepath_or_scriptset, and you are not within a directory where projectroot and src/scriptapps can be determined" + return false + } + + set scriptroot $projectroot/src/scriptapps + set customwrapper_folder $projectroot/src/scriptapps/wrappers + #check something matches the scriptset.. + if {$scriptset ne ""} { + #.toml file may or may not exist + if {[file exists $scriptroot/${scriptset}_wrap.toml]} { + puts stdout "Loading configuration from $scriptroot/${scriptset}_wrap.toml" + set configd [_read_scriptset_wrap_tomlfile $scriptroot/${scriptset}_wrap.toml] + if {[dict exists $configd scripts]} { + set configured_scripts [dict get $configd scripts] + foreach s $configured_scripts { + lappend list_input_files [file join $scriptroot $s] } } - if {!$found_script} { - puts stderr "Searched within $scriptroot" - puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" - puts stderr $usage + if {![llength $list_input_files]} { + puts stderr "No input script files defined in {$scriptset}_wrap.toml" return false - } else { - if {[file type $something_found] ne "file"} { - puts stderr "Found '$something_found'" - puts stderr "wrap_in_multishell doesn't currently support a directory as the path." - puts stderr $usage - return false + } + } else { + puts stdout "No config file for scriptset (must be named ${scriptset}_wrap.toml" + puts stdout "Will look for the following scripts in $scriptroot" + foreach e $allowed_extensions { + puts stderr "$scriptset.$e" + } + foreach e [concat $allowed_extensions [string toupper $allowed_extensions]] { + if {[file exists $scriptroot/$scriptset.$e]} { + lappend list_input_files $scriptroot/$scriptset.$e } } } - } else { - puts stderr "filepath_or_scriptset parameter doesn't seem to refer to a file, and you are not within a directory where projectroot and src/scriptapps/wrappers can be determined" - puts stderr $usage - return false + #expect a single script + if {[file exists $scriptroot/$filepath_or_scriptset]} { + if {[file type $scriptroot/$filepath_or_scriptset] ne "file"} { + puts stderr "wrap_in_multishell doesn't currently support a directory as the path. path: $scriptroot/$filepath_or_scriptset" + return false + } + lappend list_input_files $scriptroot/$filepath_or_scriptset + } } - } - #assertion - customwrapper_folder var exists - but might be empty + set found_script [expr {[llength $list_input_files] > 0}] - - if {[string length $ext]} { - #If there was an explicitly supplied extension - then that file should exist - if {![file exists $scriptroot/$scriptset.$ext]} { - puts stderr "Explicit extension .$ext was supplied - but matching file not found." - puts stderr $usage - return false - } else { - if {$ext eq "wrapconfig"} { - set process_extensions ALLFOUNDORCONFIGURED + #---------------------- + if {!$found_script} { + puts stderr "Searched within $scriptdir and $scriptroot" + if {$scriptset ne ""} { + puts stderr "Unable to find a file matching $scriptset or one of the extensions: $allowed_extensions" } else { - set process_extensions $ext + puts stderr "Unable to find file $filepath_or_scriptset" } + return false } - } else { - #no explicit extension - process all for scriptset - set process_extensions ALLFOUNDORCONFIGURED + } - #process_extensions - either a single one - or all found or as per .wrapconfig + #assertion - customwrapper_folder var exists - but might be empty - if {$opt_template eq "\uFFFF"} { - set templatename punk.multishell.cmd + if {[dict exists $configd template]} { + set templatename [dict get $configd template] } else { - set templatename $opt_template + if {$opt_template eq "\uFFFF"} { + set templatename punk.multishell.cmd + } else { + set templatename $opt_template + } } set templatename_root [file rootname [file tail $templatename]] @@ -995,7 +1136,7 @@ namespace eval punk::mix::commandset::scriptwrap { set template_base_dict [punk::mix::base::lib::get_template_basefolders] set tpldirs [list] dict for {tdir tsourceinfo} $template_base_dict { - set vendor [dict get $tsourceinfo vendor] + set vendor [dict get $tsourceinfo vendor] if {[file exists $tdir/utility/scriptappwrappers/$templatename]} { lappend tpldirs $tdir } elseif {[file exists $tdir/utility/scriptappwrappers/${templatename_fileroot}[file extension $templatename]]} { @@ -1032,7 +1173,7 @@ namespace eval punk::mix::commandset::scriptwrap { } - if {$opt_outputfolder eq "\uFFFF"} { + if {$opt_outputfolder eq ""} { #outputfolder not explicitly specified by caller if {[string length $projectroot]} { set output_folder [file join $projectroot/bin] @@ -1056,13 +1197,36 @@ namespace eval punk::mix::commandset::scriptwrap { #todo - #output_file extension may also depend on the template being used.. and/or the .wrapconfig - if {$::tcl_platform(platform) eq "windows"} { - set output_extension cmd + #output_file extension may also depend on the template being used.. and/or the _wrap.toml config + + if {[dict size $configd]} { + package require platform + set thisplatform [string tolower [platform::identify]] + set ptype [lindex [split $thisplatform -] 0] + switch -- $ptype { + win32 - dragonflybsd - freebsd - netbsd - linux - macosx {} + default { + set ptype other + } + } + set out [dict get $configd $ptype outputfile] + set output_file [file join $output_folder $out] } else { - set output_extension sh + #no _wrap.toml file available + if {$::tcl_platform(platform) eq "windows"} { + set output_extension .cmd + } else { + set output_extension .sh + } + if {$scriptset ne ""} { + set output_file [file join $output_folder $scriptset$output_extension] + } else { + set infile [lindex $list_input_files 0] + set output_file [file join $output_folder [file rootname [file tail $infile]]$output_extension] + } } - set output_file [file join $output_folder $scriptset.$output_extension] + + if {[file exists $output_file]} { set fdexisting [open $output_file r] fconfigure $fdexisting -translation binary @@ -1103,13 +1267,10 @@ namespace eval punk::mix::commandset::scriptwrap { #foreach ln $template_lines { #} - set list_input_files [list] - if {$process_extensions eq "ALLFOUNDORCONFIGURED"} { - #todo - look for .wrapconfig or all extensions for the scriptset - puts stderr "Sorry - only single input file supported. Supply a file extension or use a .wrapconfig with a single input file for now - implementation incomplete" + if {[llength $list_input_files] > 1} { + #todo + puts stderr "Sorry - only single input file supported. Supply a file extension or use a _wrap.toml config with a single input file for now - implementation incomplete" return false - } else { - lappend list_input_files $scriptroot/$scriptset.$ext } #todo - split template at each etc marker and build a dict of parts @@ -1117,7 +1278,6 @@ namespace eval punk::mix::commandset::scriptwrap { #hack - process one input set filepath [lindex $list_input_files 0] - set fdscript [open $filepath r] fconfigure $fdscript -translation binary set script_data [read $fdscript] @@ -1131,7 +1291,8 @@ namespace eval punk::mix::commandset::scriptwrap { } puts stdout "-----------------------------------------------\n" puts stdout "Target for above script data is '$output_file'" - set lang [dict get $extension_langs [string tolower $ext]] + set script_ext [string trim [file extension $filepath] .] + set lang [dict get $extension_langs [string tolower $script_ext]] puts stdout "Language of script being wrapped is $lang" if {$opt_askme} { set answer [util::askuser "Does this look correct? Y|N"] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd index 2975975d..9daf7ebf 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd +++ b/src/vfs/_vfscommon.vfs/modules/punk/mix/templates/utility/scriptappwrappers/multishell.cmd @@ -209,6 +209,8 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' SET task_exitcode=66 @REM boundary padding @REM boundary padding + @REM boundary padding + @REM boundary padding GOTO :exit_multishell ) ) @@ -223,7 +225,9 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' @SET "name=%~nx1" @SET "drive=%~d1" @SET "rtrn=%~2" - @SET "result=/mnt/%drive:~0,1%%_path:\=/%%name%" + @REM Although drive letters on windows are normally upper case wslbash seems to expect lower case drive letters + @CALL :stringToLower %drive ldrive + @SET "result=/mnt/%ldrive:~0,1%%_path:\=/%%name%" @ENDLOCAL & ( @if "%~2" neq "" ( SET "%rtrn%=%result%" @@ -336,7 +340,8 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' ) ) @EXIT /B - +@REM boundary padding +@REM boundary padding :stringToUpper @SETLOCAL @SET "rtrn=%~2" @@ -354,6 +359,25 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' ) ) @EXIT /B +:stringToLower +@SETLOCAL + @SET "rtrn=%~2" + @SET "string=%~1" + @SET "retstring=%~1" + @FOR %%A in (a b c d e f g h i j k l m n o p q r s t u v w x y z) DO @( + @SET "retstring=!retstring:%%A=%%A!" + ) + @SET "result=!retstring!" +@ENDLOCAL & ( + @IF "%~2" neq "" ( + @SET "%rtrn%=%result%" + ) ELSE ( + @ECHO stringToLower %string% result: %result% + ) +) +@EXIT /B +@REM boundary padding +@REM boundary padding :stringTrimTrailingUnderscores @SETLOCAL @SET "rtrn=%~2" @@ -397,6 +421,7 @@ set -- "$@" "a=[Hide <#;Hide set;s 1 list]"; set -- : "$@";$1 = @' :endlib : \ @REM padding +@REM padding @REM @SET taskexit_code=!errorlevel! & goto :exit_multishell @GOTO :exit_multishell # } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm index 6bd826e2..f8e55b02 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/ns-0.1.0.tm @@ -444,9 +444,8 @@ tcl::namespace::eval punk::ns { set nspath [string map {:::: ::} $nspath] set mapped [string map {:: \u0FFF} $nspath] set parts [split $mapped \u0FFF] - if {[lindex $parts end] eq ""} { - - } + #if {[lindex $parts end] eq ""} { + #} return $parts } @@ -531,6 +530,21 @@ tcl::namespace::eval punk::ns { return [regexp [dict get $ns_re_cache $glob] $path] } + #namespace tree without globbing or weird ns consideration + proc nstree_raw {{location ::}} { + if {![string match ::* $location]} { + error "nstree_raw requires a fully qualified namespace" + } + nstree_rawlist $location + } + proc nstree_rawlist {location} { + set nslist [list $location] + foreach ch [::namespace children $location] { + lappend nslist {*}[nstree_rawlist $ch] + } + return $nslist + } + proc nstree {{location ""}} { if {![string match ::* $location]} { set nscaller [uplevel 1 {::namespace current}] @@ -3899,6 +3913,7 @@ tcl::namespace::eval punk::ns { } proc _pkguse_vars {varnames} { + #review - obsolete? while {"pkguse_vars_[incr n]" in $varnames} {} #return [concat $varnames pkguse_vars_$n] return [list {*}$varnames pkguse_vars_$n] @@ -3932,10 +3947,12 @@ tcl::namespace::eval punk::ns { #load package and move to namespace of same name if run interactively with only pkg/namespace argument. #if args is supplied - first word is script to run in the namespace remaining args are args passed to scriptblock #if no newline or $args in the script - treat as one-liner and supply {*}$args automatically + variable pkguse_package_to_namespace [dict create] proc pkguse {args} { + variable pkguse_package_to_namespace set argd [punk::args::parse $args withid ::punk::ns::pkguse] lassign [dict values $argd] leaders opts values received - puts stderr "leaders:$leaders opts:$opts values:$values received:$received" + #puts stderr "leaders:$leaders opts:$opts values:$values received:$received" set pkg_or_existing_ns [dict get $leaders pkg_or_existing_ns] if {[dict exists $received script]} { @@ -3967,68 +3984,159 @@ tcl::namespace::eval punk::ns { set ver "";# tcl version? } default { - if {[string match ::* $pkg_or_existing_ns]} { - set pkg_unqualified [string range $pkg_or_existing_ns 2 end] - if {![tcl::namespace::exists $pkg_or_existing_ns]} { - set ver [package require $pkg_unqualified] - } else { - set ver "" - } + #- comparing namespaces_before vs namespaces_after only works if the package was not previously loaded + #we could either go to the somewhat expensive route of steaming up an interp with the same auto_path & tcl::tm::list each time.. + #or cache the result of the namespace we picked for later pkguse calls (pkguse_package_to_namespace dict) + #we are using the cache method - but this also doesn't help for packages previously loaded by normal package require + #our aim is for pkguse to be deterministic in what namespace it finds - even if it doesn't always get the ideal one (e.g cookiejar, see below) + #To determine appropriate namespace for already loaded packages where we have no cache entry - we may still need the helper interp mechanism + #The helper interp could be persistent - but only so long as the auto_path/tcl::tm::list values are in sync + #review. + + #also see img::png img::raw etc + #these don't directly load namespaces or direct commands.. just change behaviour of existing commands? + #but they can load things like tk (ttk namespace) first one creates ::tkimg? + + if {[string match ::* $pkg_or_existing_ns] && [tcl::namespace::exists $pkg_or_existing_ns]} { + #pkguse on an existing full qualified namespace does no package require set ns $pkg_or_existing_ns + set ver "" } else { - set pkg_unqualified $pkg_or_existing_ns - set ver [package require $pkg_unqualified] - set ns ::$pkg_unqualified - } - #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index - set previous_command_count 0 - if {[namespace exists $ns]} { - set previous_command_count [llength [info commands ${ns}::*]] - } + if {[string match ::* $pkg_or_existing_ns]} { + set pkg_unqualified [string range $pkg_or_existing_ns 2 end] + } else { + set pkg_unqualified $pkg_or_existing_ns + } + #foreach equiv of while 1 - just to allow early exit with break + foreach code_block single { + if {[dict exists $pkguse_package_to_namespace $pkg_unqualified]} { + set ns [dict get $pkguse_package_to_namespace $pkg_unqualified] + set ver [package provide $pkg_unqualified] + break + } + if {[package provide $pkg_unqualified] ne ""} { + #package has already been loaded + if {[namespace exists ::$pkg_unqualified]} { + set ns ::$pkg_unqualified + set ver [package provide $pkg_unqualified] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + break + } + #existing package but no matching namespace.. + #- load in throwaway interp and see what cmds/namespaces created + interp create nstest + try { + nstest eval {tcl::tm::remove {*}[tcl::tm::list]} + nstest eval [list tcl::tm::add {*}[lreverse [tcl::tm::list]]] + nstest eval [list set ::auto_path $::auto_path] + nstest eval {package require punk::ns} + set ns "" + if {![catch {nstest eval [list punk::ns::pkguse $pkg_unqualified]} errMsg]} { + set script [string map [list %p% $pkg_unqualified] {dict get $::punk::ns::pkguse_package_to_namespace %p%}] + set ns [nstest eval $script] + } else { + puts "couldn't test pkg $pkg_unqualified\n$errMsg" + } + } finally { + interp delete nstest + } - #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands - #for the purposes of pkguse - which most commonly interactive - we want the namespace populated - #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + dict set pkguse_package_to_namespace $pkg_unqualified $ns + set ver [package provide $pkg_unqualified] + break + } - if {!$ns_populated} { - #we will catch-run an auto_index entry if any - #auto_index entry may or may not be prefixed with :: - set keys [list] - #first look for exact pkg_unqualified and ::pkg_unqualified - #leave these at beginning of keys list - if {[array exists ::auto_index($pkg_unqualified)]} { - lappend keys $pkg_unqualified - } - if {[array exists ::auto_index(::$pkg_unqualified)]} { - lappend keys ::$pkg_unqualified - } - #as auto_index is an array - we could get keys in arbitrary order - set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] - lappend keys {*}$matches - set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] - lappend keys {*}$matches - set ns_populated 0 - set i 0 - set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing - set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] - while {!$ns_populated && $i < [llength $keys]} { - #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base - #e.g if we are loading ::x::y - #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc - set k [lindex $keys $i] - set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] - if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { - set auto_source [set ::auto_index($k)] - if {$auto_source ni $already_sourced} { - uplevel 1 $auto_source - lappend already_sourced $auto_source - set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + #pkg not loaded + set namespaces_before [nstree_rawlist ::] ;#approx 1ms for 500 or so namespaces - not cheap but bearable + #some packages don't create their namespace immediately and/or don't populate it with commands and instead put entries in ::auto_index + #gathering prior cmdcount for every ns in system is also a somewhat expensive operation.. review + #we don't know for sure that the namespace for the package require operation actually matches the package name + #e.g tcllib inifile package uses namespace ::ini + #e.g sqlite3 package adds commands to the global namespace + set dict_ns_commandcounts [dict create] + foreach nsb $namespaces_before { + dict set dict_ns_commandcounts $nsb [llength [info commands ${nsb}::*]] + } + + set ver [package require $pkg_unqualified] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + set namespaces_after [nstree_rawlist ::] + + if {[llength $namespaces_after] > [llength $namespaces_before]} { + set namespaces_new [struct::set difference $namespaces_after $namespaces_before] + if {$ns ni $namespaces_new} { + #todo - use shortest result? what if this is a namespace from a required sub package? + #e.g cookiejar loads sqlite3,http,tcl::idna which creates ::sqlite3 etc - but cookiejar just creates an object at ::http::cookiejar + #In this specific case we end up in oo::ObjXXX - but would be better placed in ::http, where the new cookiejar command resides + #review - todo? + set pkgs [package names] + set ns ::$pkg_unqualified ;#fallback - tested for existence below + #find something new - that doesn't match another package name + foreach new $namespaces_new { + if {[lsearch $pkgs [string trimleft $new :]] == -1} { + set ns $new + break + } + } } } - incr i - } + if {[tcl::namespace::exists $ns]} { + #review - only cache if exists? + dict set pkguse_package_to_namespace $pkg_unqualified $ns; + } + set previous_command_count 0 + if {[dict exists $dict_ns_commandcounts $ns]} { + set previous_command_count [dict get $dict_ns_commandcounts $ns] + } + + #also if a sub package was loaded first - then the namespace for the base or lower package may exist but have no commands + #for the purposes of pkguse - which most commonly interactive - we want the namespace populated + #It may still not be *fully* populated because we stop at first source that adds commands - REVIEW + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + + if {!$ns_populated} { + #we will catch-run an auto_index entry if any + #auto_index entry may or may not be prefixed with :: + set keys [list] + #first look for exact pkg_unqualified and ::pkg_unqualified + #leave these at beginning of keys list + if {[array exists ::auto_index($pkg_unqualified)]} { + lappend keys $pkg_unqualified + } + if {[array exists ::auto_index(::$pkg_unqualified)]} { + lappend keys ::$pkg_unqualified + } + #as auto_index is an array - we could get keys in arbitrary order + set matches [lsort [array names ::auto_index ${pkg_unqualified}::*]] + lappend keys {*}$matches + set matches [lsort [array names ::auto_index ::${pkg_unqualified}::*]] + lappend keys {*}$matches + set ns_populated 0 + set i 0 + set already_sourced [list] ;#often multiple triggers for the same source - don't waste time re-sourcing + set ns_depth [llength [punk::ns::nsparts [string trimleft $ns :]]] + while {!$ns_populated && $i < [llength $keys]} { + #todo - skip sourcing deeper entries from a subpkg which may have been loaded earlier than the base + #e.g if we are loading ::x::y + #only source for keys the same depth, or one deeper ie ::x::y, x::y, ::x::y::z not ::x or ::x::y::z::etc + set k [lindex $keys $i] + set k_depth [llength [punk::ns::nsparts [string trimleft $k :]]] + if {$k_depth == $ns_depth || $k_depth == $ns_depth + 1} { + set auto_source [set ::auto_index($k)] + if {$auto_source ni $already_sourced} { + puts stderr "pkguse sourcing auto_index script $auto_source" + uplevel 1 $auto_source + lappend already_sourced $auto_source + set ns_populated [expr {[tcl::namespace::exists $ns] && [llength [info commands ${ns}::*]] > $previous_command_count}] + } + } + incr i + } + + } + + }; # end foreach code_block single - scope for use of 'break' } } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm index a31e255e..fd84ec8d 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm @@ -3567,7 +3567,6 @@ namespace eval repl { if {[catch { package require punk::args - catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical package require punk::config package require punk::ns #puts stderr "loading natsort" @@ -3589,6 +3588,7 @@ namespace eval repl { }} [punk::config::configure running] package require textblock + catch {package require punk::args::tclcore} ;#while tclcore is highly desirable, and should be installed with punk::args - it's not critical } errM]} { puts stderr "========================" puts stderr "code interp error:" diff --git a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm index 472edc54..f2f4a3af 100644 --- a/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm +++ b/src/vfs/_vfscommon.vfs/modules/textblock-0.1.3.tm @@ -6007,7 +6007,7 @@ tcl::namespace::eval textblock { proc welcome_test {} { package require punk::ansi - set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/roy-welc.ans 80x8]] + set ansi [textblock::join -- " " [punk::ansi::ansicat src/testansi/publicdomain/roysac/ROY-WELC.ANS 80x8]] # Ansi art courtesy of Carsten Cumbrowski aka Roy/SAC - roysac.com set table [[textblock::spantest] print] set punks [a+ web-lawngreen][>punk . lhs][a]\n\n[a+ rgb#FFFF00][>punk . rhs][a]