Posted to tcl by patthoyts at Fri May 12 22:54:53 GMT 2006view raw

  1. # cvsmod.tcl - Copyright (c) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>
  2. #
  3. # Walk a directory tree looking for CVS control files and modify them
  4. # appropriately. Useful for changing the CVS root (esp. when the cvs tree
  5. # has changed hosts.)
  6. #
  7. # Usage: cvsmod ?-tree "root of working dir"? -root "new cvs root"
  8. # eg: cvsmod -tree . -root :ext:luser@tcllib.cvs.sourceforge.net:/cvsroot/tcllib
  9. #
  10. # $Id$
  11.  
  12. namespace eval cvsmod {
  13. variable opts
  14. }
  15.  
  16. proc cvsmod::cvsmod {args} {
  17. variable opts
  18. array set opts [list tree [pwd] root {} repository {}]
  19. while {[string match -* [set option [lindex $args 0]]]} {
  20. switch -glob -- $option {
  21. -tree { set opts(tree) [Pop args 1] }
  22. -rep* { set opts(repository) [Pop args 1] }
  23. -root { set opts(root) [Pop args 1] }
  24. -- {Pop args ; break }
  25. default {
  26. set err [join [array names opts] ", -"]
  27. return -code error "invalid option \"$option\":\
  28. should be one of -$err"
  29. }
  30. }
  31. Pop args
  32. }
  33.  
  34. if {$opts(root) == {} && $opts(repository) == {}} {
  35. return -code error "duh: cvsmod -root NewRoot"
  36. }
  37.  
  38. return [search $opts(tree)]
  39. }
  40.  
  41. # Look for CVS subdirectories
  42. proc cvsmod::search {Path} {
  43. set r {}
  44. set dirs [glob -nocomplain -types d -join $Path *]
  45. # With CVSNT, the CVS dir may be hidden
  46. if {[file exists [file join $Path CVS]]} {
  47. lappend dirs [file join $Path CVS]
  48. }
  49. set dirs [lsort -unique $dirs]
  50.  
  51. foreach path $dirs {
  52. if {[file isdirectory $path]} {
  53. if {[string equal [file tail $path] "CVS"]} {
  54. set r [concat $r [modify $path]]
  55. } else {
  56. set r [concat $r [search $path]]
  57. }
  58. }
  59. }
  60. return $r
  61. }
  62.  
  63. proc cvsmod::modify {path} {
  64. variable opts
  65. set mod {}
  66. if {$opts(root) != {} && [file exists [file join $path Root]]} {
  67. set mod [file join $path Root]
  68. set f [open $mod r]
  69. set data [string trim [read $f]]
  70. close $f
  71.  
  72. set f [open $mod w]
  73. puts $f $opts(root)
  74. close $f
  75.  
  76. Log $mod
  77. }
  78. return $mod
  79. }
  80.  
  81. proc cvsmod::Pop {varname {nth 0}} {
  82. upvar $varname args
  83. set r [lindex $args $nth]
  84. set args [lreplace $args $nth $nth]
  85. return $r
  86. }
  87.  
  88. proc cvsmod::Log {s} {
  89. puts $s
  90. }
  91.  
  92. if {!$::tcl_interactive} {
  93.  
  94. if {[package provide Tk] == {}} {
  95. eval [list cvsmod::cvsmod] $argv
  96. } else {
  97. set t [text .t -background white -yscrollcommand {.s set}]
  98. set s [scrollbar .s -command [list $t yview]]
  99. set b [button .b -text Dismiss -command {destroy .}]
  100. grid $t $s -sticky news
  101. grid $b - -sticky ns
  102. grid rowconfigure . 0 -weight 1
  103. grid columnconfigure . 0 -weight 1
  104.  
  105. proc cvsmod::Log {s} {
  106. .t insert end "$s\n"
  107. }
  108.  
  109. eval [list cvsmod::cvsmod] $::argv
  110.  
  111. tkwait window .
  112. }
  113.  
  114. exit
  115. }
  116.