You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

681 lines
30 KiB

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::mix::commandset::scriptwrap 999999.0a1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
package require punk::mix
package require punk::mix::base
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::commandset::scriptwrap {
namespace export *
#scriptpath allows templates command to use same custom template set as when multishell pointed to a filepath
#it may or may not be within a project
#by using the same folder or path, the same project root will be discovered. REVIEW.
proc templates_dict {args} {
set defaults [list -scriptpath ""]
set opts [dict merge $defaults $args]
set opt_scriptpath [dict get $opts -scriptpath]
set wrapper_folders [lib::get_wrapper_folders $opt_scriptpath]
set wrapper_templates [list]
foreach fld $wrapper_folders {
set templates [glob -nocomplain -dir $fld -type f *]
foreach tf $templates {
if {[string match ignore* $tf]} {
continue
}
set ext [file extension $tf]
if {$ext in [list "" ".bat" ".cmd" ".sh"]} {
lappend wrapper_templates $tf
}
}
}
set tdict [dict create]
set seen_dict [dict create]
foreach fullpath $wrapper_templates {
set ftail [file tail $fullpath]
if {![dict exists $seen_dict $ftail]} {
dict set seen_dict $ftail 1
dict set tdict $ftail $fullpath ; #first seen of filename gets no number
} else {
set n [dict get $seen_dict $ftail]
incr n
dict incr seen_dict $ftail
dict set tdict ${ftail}.$n $fullpath
}
}
return $tdict
}
proc templates {args} {
package require overtype
set tdict [templates_dict {*}$args]
set paths [dict values $tdict]
set names [dict keys $tdict]
set title1 "Path"
set widest1 [tcl::mathfunc::max {*}[lmap v [concat [list $title1] $paths] {punk::strlen $v}]]
set col1 [string repeat " " $widest1]
set title2 "Template Name"
set widest2 [tcl::mathfunc::max {*}[lmap v [concat [list $title2] $names] {punk::strlen $v}]]
set col2 [string repeat " " $widest2]
set tablewidth [expr {$widest1 + 1 + $widest2}]
set table ""
append table [string repeat - $tablewidth] \n
append table "[overtype::left $col1 $title1] [overtype::left $col2 $title2]" \n
append table [string repeat - $tablewidth] \n
foreach p $paths n $names {
append table "[overtype::left $col1 $p] [overtype::left $col2 $n]" \n
}
return $table
}
#specific filepath to just wrap one script at the tcl-payload or xxx-payload-pre-tcl 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 defaults [dict create\
-askme 1\
-outputfolder "\uFFFF"\
-template "\uFFFF"\
]
set known_opts [dict keys $defaults]
dict for {k v} $args {
if {$k ni $known_opts} {
error "punk::mix::commandset::scriptwrap error. Unrecognized option '$k'. Known-options: $known_opts"
}
}
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 opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- --- --- ---
set opt_askme [dict get $opts -askme]
set opt_template [dict get $opts -template]
set opt_outputfolder [dict get $opts -outputfolder]
# -- --- --- --- --- --- --- --- --- --- --- ---
set ext [file extension $filepath_or_scriptset]
set startdir [pwd]
#first check if relative or absolute path matches a file
if {[file pathtype $filepath_or_scriptset] eq "absolute"} {
set specified_path $filepath_or_scriptset
} else {
set specified_path [file join $startdir $filepath_or_scriptset]
}
set ext [string trim [file extension $filepath_or_scriptset] .]
set allowed_extensions [list wrapconfig tcl ps1 sh bash]
#set allowed_extensions [list tcl]
set found_script 0
if {[file exists $specified_path]} {
set found_script 1
} else {
foreach e $allowed_extensions {
if {[file exists $filepath_or_scriptset.$e]} {
set found_script 1
break
}
}
}
#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]
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
}
} 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 ""
}
}
} else {
puts stderr "wrap_in_multishell doesn't currently support a directory as the path."
puts stderr $usage
return false
}
} else {
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 {!$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
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 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
}
}
#assert - customwrapper_folder var exists - but might be empty
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
} else {
set process_extensions $ext
}
}
} 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
if {$opt_template eq "\uFFFF"} {
set templatename punk-multishell.cmd
} else {
set templatename $opt_template
}
set template_base_dict [punk::mix::base::lib::get_template_basefolders]
set tpldirs [list]
dict for {tdir tsourceinfo} $template_base_dict {
if {[file exists $tdir/utility/scriptappwrappers/$templatename]} {
lappend tpldirs $tdir
}
}
if {[string length $customwrapper_folder] && [file exists [file join $customwrapper_folder $templatename] ]} {
set wrapper_template [file join $customwrapper_folder $templatename]
} else {
if {![llength $tpldirs]} {
set msg "No template named '$templatename' found in src/scriptapps/wrappers or in template dirs from packages"
append msg \n "Searched [dict size $template_base_dict] template dirs"
error $msg
}
#last pkg with templates cap which was loaded has highest precedence
set wrapper_template ""
foreach tdir [lreverse $tpldirs] {
set ftest [file join $tdir utility scriptappwrappers $templatename]
if {[file exists $ftest]} {
set wrapper_template $ftest
break
}
}
}
if {$wrapper_template eq "" || ![file exists $wrapper_template]} {
error "wrap_in_multishell: unable to find multishell template $templatename in template folders [concat $tpldirs $customwrapper_folder]"
}
if {$opt_outputfolder eq "\uFFFF"} {
#outputfolder not explicitly specified by caller
if {[string length $projectroot]} {
set output_folder [file join $projectroot/bin]
} else {
set output_folder $startdir
}
} else {
if {[file pathtype $opt_outputfolder] eq "relative"} {
if {[string length $projectroot]} {
set output_folder [file join $projectroot $opt_outputfolder]
} else {
set output_folder [file join $startdir $opt_outputfolder]
}
} else {
set output_folder $opt_outputfolder
}
}
if {![file isdirectory $output_folder]} {
error "wrap_in_multishell: output folder '$output_folder' not found. Please ensure target directory exists"
}
#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
} else {
set output_extension sh
}
set output_file [file join $output_folder $scriptset.$output_extension]
if {[file exists $output_file]} {
error "wrap_in_multishell: target file $output_file already exists.. aborting"
}
set fdt [open $wrapper_template r]
fconfigure $fdt -translation binary
set template_data [read $fdt]
close $fdt
puts stdout "Read [string length $template_data] bytes of template data.."
set template_lines [split $template_data \n]
puts stdout "Displaying first 3 lines of template between dashed lines..."
puts stdout "-----------------------------------------------"
foreach ln [lrange $template_lines 0 3] {
puts stdout $ln
}
puts stdout "-----------------------------------------------\n"
#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"
return false
} else {
lappend list_input_files $scriptroot/$scriptset.$ext
}
#todo - split template at each <ext-payload> etc marker and build a dict of parts
#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]
close $fdscript
puts stdout "Read [string length $script_data] bytes of template data.."
set script_lines [split $script_data \n]
puts stdout "Displaying first 3 lines of your script between dashed lines..."
puts stdout "-----------------------------------------------"
foreach ln [lrange $script_lines 0 3] {
puts stdout $ln
}
puts stdout "-----------------------------------------------\n"
puts stdout "Target for above data is '$output_file'"
if {$opt_askme} {
set answer [util::askuser "Does this look correct? Y|N"]
if {[string tolower $answer] ne "y"} {
puts stderr "mix new aborting due to user response '$answer' (required Y or y to proceed) use -askme 0 to avoid prompts."
return
}
}
set start_idx 0
set end_idx 0
set line_idx 0
set existing_payload [list]
foreach ln $template_lines {
if {[string match "#<tcl-payload>*" $ln]} {
set start_idx $line_idx
} elseif {[string match "#</tcl-payload>*" $ln]} {
set end_idx $line_idx
break
} elseif {$start_idx > 0} {
if {$end_idx > 0} {
lappend existing_payload [string trim $ln]
}
} else {
}
incr line_idx
}
if {($start_idx == 0) || ($end_idx == 0)} {
error "wrap_in_multishell was unable to find payload area in template marked with #<tcl-payload> and #</tcl-payload> on separate lines"
}
set existing_string [join $existing_payload \n]
if {[string length [string trim $existing_string]]} {
puts stdout "EXISTING PAYLOAD!!"
puts stdout "-----------------------------------------------\n"
puts stdout $existing_string
puts stdout "-----------------------------------------------\n"
error "wrap_in_multishell found existing payload.. aborting."
#todo - allow overwrite only in files outside of punkshell distribution?
if 0 {
puts stderr "Found existing payload.. overwrite?"
if {$opt_askme} {
set answer [util::askuser "Are you sure you want to replace the tcl payload shown above? Y|N"]
if {[string tolower $answer] ne "y"} {
puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -askme 0 to avoid prompts."
return
}
}
}
}
set tpl_head_lines [lrange $template_lines 0 $start_idx] ;#include tag line
set tpl_tail_lines [lrange $template_lines $end_idx end]
set newscript [join $tpl_head_lines \n]\n[join $script_lines \n]\n[join $tpl_tail_lines \n]
puts stdout "New script is [string length $newscript] bytes"
puts stdout $newscript
set fdtarget [open $output_file w]
fconfigure $fdtarget -translation binary
puts -nonewline $fdtarget $newscript
close $fdtarget
puts stdout "Wrote script file at $output_file"
#even though chmod might exist on windows - we will leave permissions alone
if {$::tcl_platform(platform) ne "windows"} {
catch {exec chmod +x $output_file}
}
puts stdout "-done-"
return $output_file
}
namespace eval lib {
#get_wrapper_folders
# scriptpath - file or folder
# It represents the base point from which to search for /wrapper folders either directly above the scriptpath or in the containing project if any
# The cwd will also be searched for /wrapper folder and project - but with lower precedence in the resultset (later in list)
proc get_wrapper_folders {{scriptpath ""}} {
set wrapper_folders [list]
if {$scriptpath ne ""} {
if {[file type $scriptpath] eq "file"} {
set searchbase [file dirname $scriptpath]
} else {
set searchbase $scriptpath
}
if {[file isdirectory [file join $searchbase wrappers]]} {
lappend wrapper_folders [file join $searchbase wrappers]
}
set pathinfo [punk::repo::find_repos $searchbase]
set scriptpath_projectroot [dict get $pathinfo closest]
if {$scriptpath_projectroot ne ""} {
set fld [file join $scriptpath_projectroot src/scriptapps/wrappers]
if {[file isdirectory $fld]} {
if {$fld ni $wrapper_folders} {
lappend wrapper_folders $fld
}
}
}
}
set searchbase [pwd]
set fld [file join $searchbase wrappers]
if {[file isdirectory $fld]} {
if {$fld ni $wrapper_folders} {
lappend wrapper_folders $fld
}
}
set pathinfo [punk::repo::find_repos $searchbase]
set pwd_projectroot [dict get $pathinfo closest]
if {$pwd_projectroot ne ""} {
set fld [file join $pwd_projectroot src/scriptapps/wrappers]
if {[file isdirectory $fld]} {
if {$fld ni $wrapper_folders} {
lappend wrapper_folders $fld
}
}
}
set template_base_dict [punk::mix::base::lib::get_template_basefolders]
set tpldirs [list]
dict for {tdir tsourceinfo} $template_base_dict {
if {[file exists $tdir/utility/scriptappwrappers]} {
lappend tpldirs $tdir
}
}
foreach tpldir $tpldirs {
set fld [file join $tpldir utility scriptappwrappers]
if {[file isdirectory $fld]} {
if {$fld ni $wrapper_folders} {
lappend wrapper_folders $fld
}
}
}
return $wrapper_folders
}
proc _scriptapp_tag_from_line {line} {
set result [list istag 0 raw ""] ;#default assumption. All
#----
set startc [string first "#" $line] ;#tags must be commented
#todo - review. next line is valid - note # doesn't have to be the only one before <tagname>
# @REM # etc < blah # <tagname> etc
#---
#fix - we should use a regexp on at least <tagname> </tagname> <tagname/> and only catch tagname without whitespace
regexp {(\s*).*} $line _ln indent ;#will match on empty line, whitespace only line - or anything really.
set indent [string map [list \t " "] $indent] ;#opinionated I guess - but need to normalize to something. The spec is that spaces should be used anyway.
dict set result indent [string length $indent]
set starttag [string first "<" $line]
set pretag [string range $line $startc $starttag-1]
if {[string match "*>*" $pretag]} {
return [list istag 0 raw $line reason pretag_contents]
}
set closetag [string first ">" $line]
set inelement [string range $line $starttag+1 $closetag-1]
if {[string match "*<*" $inelement]} {
return [list istag 0 raw $line reason tag_malformed_angles]
}
set elementchars [split $inelement ""]
set numslashes [llength [lsearch -all $elementchars "/"]]
if {$numslashes == 0} {
dict set result type "open"
} elseif {$numslashes == 1} {
if {[lindex $elementchars 0] eq "/"} {
dict set result type "close"
} elseif {[lindex $elementchars end] eq "/"} {
dict set result type "openclose"
} else {
return [list istag 0 raw $line reason tag_malformed_slashes]
}
} else {
return [list istag 0 raw $line reason tag_malformed_extraslashes]
}
if {[dict get $result type] eq "open"} {
dict set result name $inelement
} elseif {[dict get $result type] eq "close"} {
dict set result name [string range $inelement 1 end]
} else {
dict set result name [string range $inelement 0 end-1]
}
dict set result istag 1
dict set result raw $line
return $result
}
#get all \n#<something>\n ...\n#</something> data - where number of intervening newlines is at least one (and whitespace and/or other data can precede #)
#we don't verify 'something' against known tags - as custom templates can have own tags
#An openclose tag #<xxx/> is used to substitute a specific line in its entirety - but the tag *must* remain in the line
#
#e.g for the line:
# @set "nextshell=pwsh" & :: #<batch-nextshell-line/>
#The .wrapconfig might contain
# tag <batch-nextshell-line> line {@set "nextshell=tclsh" & :: @<batch-nextshell-line/>}
#
proc scriptapp_wrapper_get_tags {wrapperdata} {
set wrapperdata [string map [list \r\n \n] $wrapperdata]
set lines [split $wrapperdata \n]
#set tags_in_data [dict create];#active tags - list of lines accumulating. supports nested tags
set status 0
set tags [dict create]
set errors [list]
set errortags [dict create] ;#mark names invalid on first error so that more than 2 tags can't obscure config problem
set linenum 1 ;#editors and other utils use 1-based indexing when referencing files - we should too to avoid confusion, despite it being less natural for lindex operations on the result.
foreach ln $lines {
set lntrim [string trim $ln]
if {![string length $lntrim]} {
incr linenum
continue
}
if {[string match "*#*<*>*" $lntrim]} {
set taginfo [_scriptapp_tag_from_line $ln] ;#use untrimmed line - to get indent
if {[dict get $taginfo istag]} {
set nm [dict get $taginfo name]
if {[dict exists $errortags $nm]} {
#tag is already in error condition -
} else {
set tp [dict get $taginfo type] ;# type singular - related to just one line
#set raw [dict get $taginfo raw] #equivalent to $ln
if {[dict exists $tags $nm]} {
#already seen tag name
#tags dict has types key *plural* - need to track whether we have type open and type close (or openclose for self-closing tags)
if {[dict get $tags $nm types] ne "open"} {
lappend errors "line: $linenum tag $nm encountered type $tp after existing type [dict get $tags $nm types]"
dict incr errortags $nm
} else {
#we already have open - expect only close
if {$tp ne "close"} {
lappend errors "line: $linenum tag $nm encountered type $tp after existing type [dict get $tags $nm types]"
dict incr errortags $nm
} else {
#close after open
dict set tags $nm types [list open close]
dict set tags $nm end $linenum
set taglines [dict get $tags $nm taglines]
if {[llength $taglines] != 1} {
error "Unexpected result when closing tag $nm. Existing taglines length not 1."
}
dict set tags $nm taglines [concat $taglines $ln]
}
}
} else {
#first seen of tag name
if {$tp eq "close"} {
lappend errors "line: $linenum tag $nm encountered type $p close first"
dict incr errortags $nm
} else {
dict set tags $nm types $tp
dict set tags $nm indent [dict get $taginfo indent]
if {$tp eq "open"} {
dict set tags $nm start $linenum
dict set tags $nm taglines [list $ln] ;#first entry - another will be added on encountering matching closing tag
} elseif {$tp eq "openclose"} {
dict set tags $nm start $linenum
dict set tags $nm end $linenum
dict set tags $nm taglines [list $ln] ;#single entry is final result for self-closing tag
}
}
}
}
} else {
#looks like it should be a tag.. but failed to even parse for some reason.. just add to errorlist
lappend errors "line: $linenum tag parse failure reason: [dict get $taginfo reason] raw line: [dict get $taginfo raw]"
}
}
#whether the line is tag or not append to any tags_in_data
#foreach t [dict keys $tags_in_data] {
# dict lappend tags_in_data $t $ln ;#accumulate raw lines - written to the tag entry in tags only on encountering a closing tag, then removed from tags_in_data
#}
incr linenum
}
#assert [expr {$linenum -1 == [llength $lines]}]
if {[llength $errors]} {
set status 0
} else {
set status 1
}
if {$linenum == 0} {
}
return [dict create ok $status linecount [llength $lines] data $tags errors $errors]
}
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::mix::commandset::scriptwrap [namespace eval punk::mix::commandset::scriptwrap {
variable version
set version 999999.0a1.0
}]
return