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.
333 lines
14 KiB
333 lines
14 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 punkcheck::cli 0.1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
package require punk::mix::util |
|
|
|
namespace eval punkcheck::cli { |
|
namespace ensemble create |
|
#package require punk::overlay |
|
#punk::overlay::import_commandset debug. ::punk:mix::commandset::debug |
|
|
|
#init proc required - used for lazy loading of commandsets |
|
variable initialised 0 |
|
proc _init {args} { |
|
variable initialised |
|
if {$initialised} { |
|
return |
|
} |
|
puts stderr "punkcheck::cli::init $args" |
|
|
|
set initialised 1 |
|
} |
|
|
|
proc help {args} { |
|
set basehelp [punk::mix::base help {*}$args] |
|
return $basehelp |
|
} |
|
|
|
proc paths {{path {}}} { |
|
if {$path eq {}} { set path [pwd] } |
|
set search_from $path |
|
set bottom_to_top [list] |
|
while {[string length [set pcheck_file [punkcheck::cli::lib::find_nearest_file $search_from]]]} { |
|
set pcheck_folder [file dirname $pcheck_file] |
|
lappend bottom_to_top $pcheck_file |
|
set search_from [file dirname $pcheck_folder] |
|
} |
|
return $bottom_to_top |
|
} |
|
#todo! - group by fileset |
|
proc status {{path {}}} { |
|
if {$path eq {}} { set path [pwd] } |
|
set fullpath [file normalize $path] |
|
|
|
set ftype [file type $fullpath] |
|
|
|
|
|
set files [list] |
|
if {$ftype eq "file"} { |
|
set container [file dirname $fullpath] |
|
lappend files $fullpath |
|
} else { |
|
set container $fullpath |
|
#vfs can mask mounted files - so we can't just use 'file type' or glob with -type f |
|
##set files [glob -nocomplain -dir $fullpath -type f *] |
|
package require punk::nav::fs |
|
set folderinfo [punk::nav::fs::dirfiles_dict $fullpath] |
|
set files [concat [dict get $folderinfo files] [dict get $folderinfo underlayfiles]] |
|
} |
|
set punkcheck_files [paths $container] |
|
set repodict [punk::repo::find_repo $container] |
|
|
|
if {![llength $punkcheck_files]} { |
|
puts stderr "No .punkcheck files found at or above this folder" |
|
} |
|
|
|
set table "" |
|
set files_with_records [list] |
|
foreach p $punkcheck_files { |
|
set basedir [file dirname $p] |
|
set recordlist [punkcheck::load_records_from_file $p] |
|
set tgt_dict [punkcheck::recordlist::records_as_target_dict $recordlist] |
|
|
|
foreach f $files { |
|
set relpath [punkcheck::lib::path_relative $basedir $f] |
|
|
|
if {[dict exists $tgt_dict $relpath]} { |
|
set filerec [dict get $tgt_dict $relpath] |
|
set records [punkcheck::dict_getwithdefault $filerec body [list]] |
|
if {$ftype eq "file"} { |
|
if {![llength $records]} { |
|
set pcheck "(has file record but no installation entries)" |
|
} else { |
|
set pcheck \n |
|
foreach irec $records { |
|
append pcheck [punk::tdl::prettyprint [list $irec] 1] \n |
|
#append pcheck " $irec" \n |
|
} |
|
} |
|
} else { |
|
if {![llength $records]} { |
|
set pcheck "(has file record but no installation entries)" |
|
} else { |
|
set display_records [list] |
|
set pcheck \n |
|
set latest_install_record [punkcheck::recordlist::file_record_latest_installrecord $filerec] |
|
if {[llength $latest_install_record]} { |
|
lappend display_records $latest_install_record |
|
} |
|
if {$latest_install_record ne [lindex $records end]} { |
|
lappend display_records [lindex $records end] |
|
} |
|
foreach irec $display_records { |
|
append pcheck "[format %-14s [dict get $irec tag]] [punkcheck::dict_getwithdefault $irec -tsiso "no-timestamp"]" |
|
set bodyrecords [punkcheck::dict_getwithdefault $irec body [list]] |
|
set source_files [list] |
|
set source_files_changed [list] |
|
set source_folders [list] |
|
set source_folders_changed [list] |
|
foreach r $bodyrecords { |
|
if {[dict get $r tag] eq "SOURCE"} { |
|
set path [dict get $r -path] |
|
set changed [dict get $r -changed] |
|
switch -- [dict get $r -type] { |
|
file { |
|
lappend source_files $path |
|
if {$changed} { |
|
lappend source_files_changed $path |
|
} |
|
} |
|
directory { |
|
lappend source_folders $path |
|
if {$changed} { |
|
lappend source_folders_changed $path |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if {[llength $source_files]} { |
|
append pcheck " source files : [llength $source_files] (changed [llength $source_files_changed])" |
|
} |
|
if {[llength $source_folders]} { |
|
append pcheck " source folders: [llength $source_folders] (changed [llength $source_folders_changed])" |
|
} |
|
append pcheck \n |
|
|
|
#append pcheck [punk::tdl::prettyprint [list $irec] 1] \n |
|
#append pcheck " $irec" \n |
|
} |
|
} |
|
} |
|
append table "$f $pcheck" \n |
|
} |
|
} |
|
} |
|
return $table |
|
} |
|
proc status_by_file {{path {}}} { |
|
if {$path eq {}} { set path [pwd] } |
|
set fullpath [file normalize $path] |
|
set ftype [file type $fullpath] |
|
set files [list] |
|
if {$ftype eq "file"} { |
|
set container [file dirname $fullpath] |
|
lappend files $fullpath |
|
} else { |
|
set container $fullpath |
|
set files [glob -nocomplain -dir $fullpath -type f *] |
|
} |
|
set punkcheck_files [paths $container] |
|
set repodict [punk::repo::find_repo $container] |
|
|
|
if {![llength $punkcheck_files]} { |
|
puts stderr "No .punkcheck files found at or above this folder" |
|
} |
|
|
|
set table "" |
|
set files_with_records [list] |
|
foreach p $punkcheck_files { |
|
set basedir [file dirname $p] |
|
set recordlist [punkcheck::load_records_from_file $p] |
|
set tgt_dict [punkcheck::recordlist::records_as_target_dict $recordlist] |
|
foreach f $files { |
|
set relpath [punkcheck::lib::path_relative $basedir $f] |
|
|
|
if {[dict exists $tgt_dict $relpath]} { |
|
set filerec [dict get $tgt_dict $relpath] |
|
set records [punkcheck::dict_getwithdefault $filerec body [list]] |
|
if {$ftype eq "file"} { |
|
if {![llength $records]} { |
|
set pcheck "(has file record but no installation entries)" |
|
} else { |
|
set pcheck \n |
|
foreach irec $records { |
|
append pcheck [punk::tdl::prettyprint [list $irec] 1] \n |
|
#append pcheck " $irec" \n |
|
} |
|
} |
|
} else { |
|
if {![llength $records]} { |
|
set pcheck "(has file record but no installation entries)" |
|
} else { |
|
set display_records [list] |
|
set pcheck \n |
|
set latest_install_record [punkcheck::recordlist::file_record_latest_installrecord $filerec] |
|
lappend display_records $latest_install_record |
|
if {$latest_install_record ne [lindex $records end]} { |
|
lappend display_records [lindex $records end] |
|
} |
|
foreach irec $display_records { |
|
append pcheck "[format %-14s [dict get $irec tag]] [punkcheck::dict_getwithdefault $irec -tsiso "no-timestamp"]" |
|
set bodyrecords [punkcheck::dict_getwithdefault $irec body [list]] |
|
set source_files [list] |
|
set source_files_changed [list] |
|
set source_folders [list] |
|
set source_folders_changed [list] |
|
foreach r $bodyrecords { |
|
if {[dict get $r tag] eq "SOURCE"} { |
|
set path [dict get $r -path] |
|
set changed [dict get $r -changed] |
|
switch -- [dict get $r -type] { |
|
file { |
|
lappend source_files $path |
|
if {$changed} { |
|
lappend source_files_changed $path |
|
} |
|
} |
|
directory { |
|
lappend source_folders $path |
|
if {$changed} { |
|
lappend source_folders_changed $path |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if {[llength $source_files]} { |
|
append pcheck " source files : [llength $source_files] (changed [llength $source_files_changed])" |
|
} |
|
if {[llength $source_folders]} { |
|
append pcheck " source folders: [llength $source_folders] (changed [llength $source_folders_changed])" |
|
} |
|
append pcheck \n |
|
|
|
#append pcheck [punk::tdl::prettyprint [list $irec] 1] \n |
|
#append pcheck " $irec" \n |
|
} |
|
} |
|
} |
|
append table "$f $pcheck" \n |
|
} |
|
} |
|
} |
|
return $table |
|
} |
|
} |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
namespace eval punkcheck::cli::lib { |
|
namespace path ::punk::mix::util ;#askuser, do_in_path, foreach-file etc |
|
|
|
proc find_nearest_file {{path {}}} { |
|
if {$path eq {}} { set path [pwd] } |
|
set folder [lib::scanup $path lib::is_punkchecked_folder] |
|
if {$folder eq ""} { |
|
return "" |
|
} else { |
|
return [file join $folder .punkcheck] |
|
} |
|
} |
|
|
|
proc is_punkchecked_folder {{path {}}} { |
|
if {$path eq {}} { set path [pwd] } |
|
foreach control { |
|
.punkcheck |
|
} { |
|
set control [file join $path $control] |
|
if {[file isfile $control]} {return 1} |
|
} |
|
return 0 |
|
} |
|
|
|
proc scanup {path cmd} { |
|
if {$path eq {}} { set path [pwd] } |
|
#based on kettle::path::scanup |
|
if {[file pathtype $path] eq "relative"} { |
|
set path [file normalize $path] |
|
} |
|
while {1} { |
|
# Found the proper directory, per the predicate. |
|
if {[{*}$cmd $path]} { return $path } |
|
|
|
# Not found, walk to parent |
|
set new [file dirname $path] |
|
|
|
# Stop when reaching the root. |
|
if {$new eq $path} { return {} } |
|
if {$new eq {}} { return {} } |
|
|
|
# Ok, truly walk up. |
|
set path $new |
|
} |
|
return {} |
|
} |
|
|
|
} |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
namespace eval punkcheck::cli { |
|
proc _cli {args} { |
|
#don't use tailcall - base uses info level to determine caller |
|
::punk::mix::base::_cli {*}$args |
|
} |
|
variable default_command status |
|
package require punk::mix::base |
|
package require punk::overlay |
|
punk::overlay::custom_from_base [namespace current] ::punk::mix::base |
|
} |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punkcheck::cli [namespace eval punkcheck::cli { |
|
variable version |
|
set version 0.1.0 |
|
}] |
|
return |
|
|
|
|
|
|