Last active
August 29, 2015 14:24
-
-
Save dahu/697a5c4da2fb9864b58f to your computer and use it in GitHub Desktop.
multi repos command-line tool in Tcl
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env tclsh | |
package require cmdline | |
package require struct::set | |
oo::class create tclmr { | |
constructor {} { | |
namespace path [list {*}[namespace path] ::cmdline ::struct::set] | |
} | |
method register {args} { | |
set usage ": register \[options] directory ...\nTag one or more directories with the given tags.\noptions:" | |
set opts [getoptions args { | |
{tag.arg default {Tags to register}} | |
{append {Append given tags to existing tags}} | |
} $usage] | |
foreach dir $args { | |
set new_tags [dict get $opts tag] | |
set tclmr_file [file join $dir .tclmr] | |
if { [dict get $opts append] && [file exists $tclmr_file] } { | |
set old_tags [my Read $tclmr_file] | |
set new_tags [lsort -uniq [concat $new_tags $old_tags]] | |
} | |
my Write $tclmr_file $new_tags | |
} | |
} | |
method run {args} { | |
set usage ": run \[options] command ...\nRun the given command in every directory beneath basepath with the given tag.\noptions:" | |
set opts [getoptions args { | |
{basepath.arg . {Directory to begin search for .tclmr files}} | |
{tag.arg default {Tags to match against}} | |
{dryrun {Display but don't execute commands}} | |
} $usage] | |
set command $args | |
foreach path [glob [file join [file normalize [dict get $opts basepath]] ** .tclmr]] { | |
set tags [my Read $path] | |
if { [struct::set intersect $tags [dict get $opts tag]] ne {} } { | |
set dir [file dirname $path] | |
if { [dict get $opts dryrun] != 0 } { | |
puts "cd $dir ; $command" | |
} else { | |
cd $dir | |
puts [exec {*}$command] | |
} | |
} | |
} | |
} | |
method Read {path} { | |
set fh [open $path r] | |
set tags [gets $fh] | |
close $fh | |
return $tags | |
} | |
method Write {path tags} { | |
set fh [open $path w] | |
puts $fh $tags | |
close $fh | |
} | |
method unknown {subcmd args} { | |
puts [format [join { | |
{Unknown command: %s} | |
{Usage: %s command [options] args} | |
{Commands: regsiter, run} | |
{See command -help for more details.}} "\n"] $subcmd [namespace tail [info object class [self object]]]] | |
} | |
} | |
try { | |
[tclmr create mr] {*}$argv | |
} on error {result options} { | |
puts $result | |
exit 1 | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment