# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt # # Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. # Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # (C) 2023 # # @@ Meta Begin # Application punk::mix::commandset::repo 0.1.0 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements ##e.g package require frobz # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::mix::commandset::repo { namespace export * proc tickets {{project ""}} { #todo set result "" if {[string length $project]} { puts stderr "project status unimplemented" return } set active_dir [pwd] append result "Retrieving top 10 tickets only (for more, use fossil timeline -n -t t)" \n append result [exec fossil timeline -n 10 -t t] return $result } proc fossilize { args} { #check if project already managed by fossil.. initialise and check in if not. puts stderr "unimplemented" } proc unfossilize {projectname args} { #remove/archive .fossil puts stderr "unimplemented" } proc state {} { set result "" set repopaths [punk::repo::find_repos [pwd]] set repos [dict get $repopaths repos] if {![llength $repos]} { append result [dict get $repopaths warnings] } else { append result [dict get $repopaths warnings] lassign [lindex $repos 0] repopath repotypes if {"fossil" in $repotypes} { append result \n "Fossil repo based at $repopath" set repostate [punk::repo::workingdir_state $repopath -repopaths $repopaths -repotypes fossil] append result \n [punk::repo::workingdir_state_summary $repostate] } if {"git" in $repotypes} { append result \n "Git repo based at $repopath" set repostate [punk::repo::workingdir_state $repopath -repopaths $repopaths -repotypes git] append result \n [punk::repo::workingdir_state_summary $repostate] } } return $result } proc fossil-move-repository {{path ""}} { set searchbase [pwd] set projectinfo [punk::repo::find_repos $searchbase] set projectbase [dict get $projectinfo closest] set is_fossil [expr {"fossil" in [dict get $projectinfo closest_types]}] if {[catch { package require sqlite3 } errM]} { puts stderr "sqlite3 package failed to load" puts stderr "Try using 'fossil test-move-repository ' from within an open checkout folder, or ensure that the Tcl sqlite3 package is available." return } set ansiprompt [a+ green bold] set ansiwarn [a+ red bold] set ansihighlight [a+ cyan bold] set ansireset [a] set in_checkout 0 set is_checkout_relink 0; #whether we are attempting to link a checkout that has lost its repo #we may also encounter a different kind of relink candidate - other checkouts of the same repo that we examine and find don't point back. if {$projectbase eq "" || !$is_fossil} { set repodbs [glob -dir $searchbase -type f -tail *.fossil] if {![llength $repodbs]} { puts stderr "Current directory does not seem to be directly below a fossil checkout, and no .fossil files found" puts stderr "Please move to a folder containing the .fossil repository database to move, or to a folder directly within a fossil checkout (and with no intermediate git/fossil repos)" return } set choice_files [list] set i 1 set menu_message "" append menu_message "${ansiprompt}Select the number of the fossil repo db to potentially move (confirmation will be requested before any action is taken)${ansireset}" \n foreach db $repodbs { sqlite3 dbinfo [file join $searchbase $db] set ckouts [dbinfo eval {select name from config where name like 'ckout:%'}] dbinfo close lappend choice_files [list index $i repofile $db checkouts [llength $ckouts]] append menu_message "$i $db checkouts: [llength $ckouts]" \n incr i } puts stdout $menu_message set max [llength $choice_files] if {$max == 1} { set rangemsg "the number 1" } else { set rangemsg "a number from 1 to $max" } set answer [punk::repo::askuser "${ansiprompt}Enter $rangemsg to select a .fossil repository database to show details and potentially move. (or N to abort)${ansireset}"] if {![string is integer -strict $answer]} { puts stderr "Aborting" return } set index [expr {int($answer) -1}] if {$index >= 0 && $index <= $max-1} { set repo_file_choice [lindex $choice_files $index] set repo_file [dict get $repo_file_choice repofile] set repo_file [file join $searchbase $repo_file] puts stdout "Selected fossil repo database file: $repo_file" } else { puts stderr " No menu number matched - aborting." return } } else { if {[file exists $projectbase/_FOSSIL_]} { set cdbfile [file join $projectbase/_FOSSIL_] } elseif {[file exists $projectbase/.fslckout]} { set cdbfile [file join $projectbase/.fslckout] } else { puts stderr "No checkout database (_FOSSIL_ or .fslckout) found in nearest repository folder $projectbase (looked upwards from $searchbase)" puts stderr "Unable to locate repository databases for potential move. Please move to a checkout folder or a folder containing .fossil repositories" puts stderr "If run from a location where repositories are found, fossil-move-repository will give you the option to select a repository or cancel the operation" return } set in_checkout 1 sqlite3 cdb $cdbfile set repo_file [cdb eval {select value from vvar where name='repository'}] cdb close if {[string length [string trim $repo_file]] && [file pathtype $repo_file] eq "relative"} { set repo_file [file join $projectbase $repo_file] } if {![string length [string trim $repo_file]] || ![file exists $repo_file]} { puts stderr "${ansiwarn}Checkout at $projectbase points to repository '$repo_file' - but it doesn't seem to exist${ansireset}" set answer [punk::repo::askuser "${ansiprompt}Do you want to link this to an existing repository file? (Y|N)${ansireset}"] if {[string match y* [string tolower $answer]]} { set is_checkout_relink 1 } else { puts stderr "Aborting - Unable to link this checkout dir to a repository database file" return } } } set pname [file rootname [file tail $repo_file]] set full_path_repo_file [file join $searchbase $repo_file] if {[file isfile $full_path_repo_file]} { sqlite3 dbinfo [file join $searchbase $repo_file] set ckouts [dbinfo eval {select name from config where name like 'ckout:%'}] dbinfo close if {![llength $ckouts]} { puts stdout "Repository db at [file join $searchbase $repo_file] appears to have no open checkouts" } else { puts stdout "Repository db at [file join $searchbase $repo_file] appears to have [llength $ckouts] open checkouts:" foreach ck $ckouts { puts stdout [string range $ck 6 end] } } } else { puts stderr "${ansiwarn}Missing repository db at $full_path_repo_file${ansireset}" } puts stdout "${ansihighlight}Report for all projects with repository file name $pname${ansireset}" puts stdout [punk::mix::commandset::project::collection::detail $pname] puts stdout [punk::mix::commandset::project::collection::work $pname -detail 1] #todo #ask user if they want to select a different pname set wantrenameprompt "${ansiprompt}Would you like to rename the .fossil file? (Y|N)${ansireset}" append wantrenameprompt \n "${ansiprompt}.eg change $pname.fossil to something else such as ${pname}_new.fossil${ansireset}" set answer [punk::repo::askuser $wantrenameprompt] set pname2 $pname if {[string match y* [string tolower $answer]]} { set dorenameprompt "${ansiprompt}Enter the new name and hit enter. (Just an alphanumeric name (possibly with dots/dashes/underscores) without .fossil and without any path)${ansireset}" set namechoice [punk::repo::askuser $dorenameprompt] if {[string length $namechoice]} { set permittedmap [list . "" - "" _ ""] if {[string is alnum -strict [string map $permittedmap $namechoice]]} { set pname2 $namechoice } else { puts stderr "Entered name was invalid. Must be numbers,letters,underscore,dot,dash" } } puts stdout "Continuing with name $pname2 - cancel at next prompt if this is incorrect" } set target_repodb_folder [punk::repo::fossil_get_repository_folder_for_project $pname2 -parentfolder $searchbase -askpath 1] #target_repodb_folder might be same as source folder - check for same file if name wasn't changed? if {![string length $target_repodb_folder]} { puts stderr "No usable repository database folder selected for $pname2.fossil file" return } set existing_target_repofile 0 if {[file exists $target_repodb_folder/$pname2.fossil]} { set existing_target_repofile 1 puts stdout "${ansiwarn}NOTICE: $target_repodb_folder/$pname2.fossil already exists${ansireset}" if {!$is_checkout_relink} { set finalquestion "${ansiprompt}Are you sure you want to switch the repository $repo_file for the open checkout(s) to the existing file $target_repodb_folder/$pname2.fossil? (Y|N)${ansireset}" } else { set finalquestion "${ansiprompt}Are you sure you want to attempt to linke the repository (previously linked with '$repo_file') for the open checkout(s) to the existing file $target_repodb_folder/$pname2.fossil? (Y|N)${ansireset}" } } else { if {!$is_checkout_relink} { set finalquestion "${ansiprompt}Proceed to move repository $repo_file to the new file $target_repodb_folder/$pname2.fossil? Y|N${ansireset}" } else { set finalquestion "${ansiprompt}Proceed to attempt link for missing repo db $repo_file to the new file $target_repodb_folder/$pname2.fossil? Y|N${ansireset}" } } set line "${ansiwarn}[string repeat - [string length $finalquestion]]${ansireset}" set finalprompt $line\n append finalprompt $finalquestion \n append finalprompt $line \n set answer [punk::repo::askuser $finalprompt] if {[string match y* [string tolower $answer]]} { if {!$existing_target_repofile && !$is_checkout_relink} { if {[catch { file copy $repo_file $target_repodb_folder/$pname2.fossil } errM]} { puts stderr "${ansiwarn}FAILED to copy $repo_file to $target_repodb_folder/$pname2.fossil - aborting${ansireset}" puts stderr "Error message was:\n $errM" return } if {$in_checkout} { #in_checkout means we can assume projectbase var exists #there may be other checkouts on the old repo #if so, we will remind the user of their existence if {[catch {exec fossil test-move-repository $target_repodb_folder/$pname2.fossil} errM]} { puts stderr "${ansiwarn}The fossil test-move-repository command appears to have failed${ansireset}" puts stderr "$errM" } else { sqlite3 oldrepo $repo_file set ckouts [oldrepo eval {select name from config where name like 'ckout:%'}] set pcode [oldrepo eval {select value from config where name = 'project-code'}] oldrepo close if {[string length $pcode] < 20} { puts stderr "WARNING: Failed to get project-code from repo db $repo_file" } set other_checkouts [list] set norm_projectbase [file normalize $projectbase] foreach ck $ckouts { set ckfolder [string trim [string range $ck 6 end]] if {![file isdirectory $ckfolder]} { #as the process was launched within a checkout - we won't bother user with reports of non-existant other checkouts continue } if {[file normalize $ckfolder] ne $norm_projectbase} { lappend other_checkouts $ckfolder } } if {[llength $other_checkouts]} { puts stderr "${ansiwarn}Other checkouts of $repo_file that may need consideration${ansireset}" foreach other $other_checkouts { puts stdout $other } } } } else { #we aren't in a checkout - moving a repo to a new db location and/or name so there's no reason to prefer one checkout over another.. presumably the user either wants to move them all - or be asked.. sqlite3 oldrepo $repo_file set ckouts [oldrepo eval {select name from config where name like 'ckout:%'}] oldrepo close if {[llength $ckouts] > 1} { puts stdout "There are [llength $ckouts] checkouts for the repository you are moving" puts stdout "You will be asked for each checkout if you want to adjust it to point to $target_repodb_folder/$pname2.folder" } set original_cwd [pwd] foreach ck $ckouts { set ckfolder [string trim [string range $ck 6 end]] if {![file isdirectory $ckfolder]} { puts stderr "old repo shows a checkout at $ckfolder - but it doesn't seem to exist. Ignoring" continue } cd $ckfolder puts stdout [exec fossil info] puts stdout [state] set answer [punk::repo::askuser "${ansiprompt}Do you want to point this checkout to $target_repodb_folder/$pname2.folder? (Y|N) Q to stop processing checkouts${ansireset}"] if {[string match q* [string tolower $answer]]} { puts stderr "User aborting loop" break } if {[string match y* [string tolower $answer]]} { if {[catch {exec fossil test-move-repository $target_repodb_folder/$pname2.fossil} moveresult]} { puts stderr "${ansiwarn}The fossil test-move-repository command appears to have failed${ansireset}" puts stderr "$moveresult" } else { puts stdout "OK - move performed with result:" puts stdout $moveresult } } } cd $original_cwd } } else { if {$is_checkout_relink} { #relinking a lost checkout to an existing repo.. we should probably check it's other checkouts and see if they point back if {[catch {exec fossil test-move-repository $target_repodb_folder/$pname2.fossil} errM]} { puts stderr "${ansiwarn}The fossil test-move-repository command appears to have failed${ansireset}" puts stderr "$errM" } } else { if {$in_checkout} { if {[catch {exec fossil test-move-repository $target_repodb_folder/$pname2.fossil} errM]} { puts stderr "${ansiwarn}The fossil test-move-repository command appears to have failed${ansireset}" puts stderr "$errM" } } else { #not in checkout - we're wanting what pointed to one repo to point to a different existing one - presumably for all checkouts sqlite3 newrepo $target_repodb_folder/$pname2.fossil set newpname [newrepo eval {select value from config where name = 'project-name'}] set newpcode [newrepo eval {select value from config where name = 'project-code'}] set newckouts [newrepo eval {select name from config where name like 'ckout:%'}] newrepo close sqlite3 oldrepo $repo_file set oldpname [oldrepo eval {select value from config where name = 'project-name'}] set oldpcode [oldrepo eval {select value from config where name = 'project-code'}] set oldckouts [oldrepo eval {select name from config where name like 'ckout:%'}] oldrepo close if {$newpname eq $oldpname} { set ansi_newpname [a+ green bold]$newpname[a] set ansi_oldpname [a+ green bold]$oldpname[a] } else { set ansi_newpname [a+ cyan bold]$newpname[a] set ansi_oldpname [a+ red bold]$oldpname[a] } if {$newpcode eq $oldpcode} { set ansi_newpcode [a+ green bold]$newpcode[a] set ansi_oldpcode [a+ green bold]$oldpcode[a] } else { set ansi_newpcode [a+ cyan bold]$newpcode[a] set ansi_oldpcode [a+ red bold]$oldpcode[a] } puts stdout "Target repository $target_repodb_folder/$pname2.fossil has project-name: $ansi_newpname and [llength $newckouts] existing checkouts" puts stdout "Target project code: $ansi_newpcode" puts stdout "Source repository $repo_file has project-name: $ansi_oldpname and [llength $oldckouts] existing checkouts" puts stdout "Source project code: $ansi_oldpcode" if {[llength $oldckouts] > 1} { puts stdout "You will be asked for each checkout if you want to adjust it to point to $target_repodb_folder/$pname2.folder" } set original_cwd [pwd] foreach ck $oldckouts { set ckfolder [string trim [string range $ck 6 end]] if {![file isdirectory $ckfolder]} { puts stderr "old repo shows a checkout at $ckfolder - but it doesn't seem to exist. Ignoring" continue } cd $ckfolder puts stdout [exec fossil info] puts stdout [state] set answer [punk::repo::askuser "${ansiprompt}Do you want to point this checkout to $target_repodb_folder/$pname2.folder? (Y|N) Q to stop processing checkouts${ansireset}"] if {[string match q* [string tolower $answer]]} { puts stderr "User aborting loop" break } if {[string match y* [string tolower $answer]]} { if {[catch {exec fossil test-move-repository $target_repodb_folder/$pname2.fossil} moveresult]} { puts stderr "${ansiwarn}The fossil test-move-repository command appears to have failed${ansireset}" puts stderr "$moveresult" } else { puts stdout "OK - move performed with result:" puts stdout $moveresult } } } cd $original_cwd } } } puts stdout "-done-" } else { puts stdout "-cancelled by user-" } } } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::mix::commandset::repo [namespace eval punk::mix::commandset::repo { variable version set version 0.1.0 }] return