SHA1 Hash:	8469631cc98425258f1bb6e4c7c4fc999983f808
Date:	2007-09-08 03:48:40
User:	aku
Comment:	Extended import app with switch to stop execution just before a specific changeset, to aid in debugging problems.
Timelines:	ancestors | descendants | both | trunk
Other Links:	files | ZIP archive | manifest

• branch=trunk inherited from [a28c83647d]
• sym-trunk inherited from [a28c83647d]

Modified tools/import-cvs.tcl from [8b0ca8d137] to [f419734d96].

@@ -46,11 +46,11 @@
 package require fossil ; # Backend,  writing to destination repository.
 
 # -----------------------------------------------------------------------------
 
 proc main {} {
-    global argv tot nto cvs fossil ntrunk
+    global argv tot nto cvs fossil ntrunk stopat
 
     commandline
 
     fossil::feedback Write ; # Setup progress feedback from the libraries
     cvs::feedback    Write
@@ -70,10 +70,11 @@
     fossil::new    ; # Uses cwd as workspace to connect to.
 
     set ntrunk [cvs::ntrunk]
     cvs::foreach_cset cset [cvs::root] {
 	import $cset
+	if {$stopat == $cset} exit
     }
     cvs::wsclear
 
     Write info "    ========= [string repeat = 61]"
     Write info "    Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
@@ -89,14 +90,15 @@
 
 
 # -----------------------------------------------------------------------------
 
 proc commandline {} {
-    global argv cvs fossil nosign log debugcommit
+    global argv cvs fossil nosign log debugcommit stopat
 
     set nosign 0
     set debugcommit 0
+    set stopat {}
 
     while {[string match "-*" [set opt [lindex $argv 0]]]} {
 	if {$opt eq "--nosign"} {
 	    set nosign 1
 	    set argv [lrange $argv 1 end]
@@ -103,10 +105,15 @@
 	    continue
 	}
 	if {$opt eq "--debugcommit"} {
 	    set debugcommit 1
 	    set argv [lrange $argv 1 end]
+	    continue
+	}
+	if {$opt eq "--stopat"} {
+	    set stopat [lindex $argv 1]
+	    set argv   [lrange $argv 2 end]
 	    continue
 	}
 	usage
     }
     if {[llength $argv] != 2} usage
@@ -135,16 +142,24 @@
     puts stderr "       $text"
     exit
 }
 
 proc import {cset} {
-    global tot nto nosign ntrunk
+    global tot nto nosign ntrunk stopat
     Write info "    Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
     Write info "        At $nto/$ntrunk ([format %.2f [expr {$nto*100.0/$ntrunk}]]%)"
 
+    if {$stopat == $cset} {
+	fossil::commit 1 cvs2fossil $nosign \
+	    [cvs::wssetup $cset] \
+	    ::cvs::wsignore
+	Write info "        %% STOP"
+	return
+    }
+
     set usec [lindex [time {
-	foreach {uuid ad rm ch} [fossil::commit cvs2fossil $nosign \
+	foreach {uuid ad rm ch} [fossil::commit 0 cvs2fossil $nosign \
 				     [cvs::wssetup $cset] \
 				     ::cvs::wsignore] break
     } 1] 0]
     cvs::uuid $cset $uuid
 

Modified tools/lib/cvs.tcl from [abba347c2b] to [e89af18f22].

@@ -340,11 +340,23 @@
     upvar 1 $cv c
     variable rtree
 
     set c $node
     while {1} {
-	uplevel 1 $script
+	set code [catch {uplevel 1 $script} res]
+
+	# 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
+	switch -- $code {
+	    0 {}
+	    1 { return -errorcode $::errorcode -code error $res }
+	    2 {}
+	    3 { return }
+	    4 {}
+	    default {
+		return -code $code $result
+	    }
+	}
 
 	# Stop on reaching the head.
 	if {![llength [$rtree children $c]]} break
 
 	#puts <[$rtree children $c]>

Modified tools/lib/fossil.tcl from [4a2de34bc9] to [4c39a15ec8].

@@ -60,11 +60,11 @@
 	variable dcfile [file normalize cvs2fossil_commit.tcl]
     }
     return
 }
 
-proc ::fossil::commit {appname nosign meta ignore} {
+proc ::fossil::commit {break appname nosign meta ignore} {
     variable fossil
     variable lastuuid
     variable debugcommit
     variable dcfile
 
@@ -120,10 +120,13 @@
     }
 
     if {$debugcommit} {
 	fileutil::writeFile $dcfile "\#!tclsh\n$cmd\n"
     }
+
+    # Stop, do not actually commit.
+    if {$break} return
 
     if {[catch {
 	eval $cmd
     } line]} {
 	if {![string match "*nothing has changed*" $line]} {