Fossil SCM

Extended import app with switch to stop execution just before a specific changeset, to aid in debugging problems.

aku 2007-09-08 03:48 trunk
Commit 8469631cc98425258f1bb6e4c7c4fc999983f808
Parent 734febe649058cf…
3 files changed +19 -4 +13 -1 +4 -1
~ tools/import-cvs.tcl ~ tools/lib/cvs.tcl ~ tools/lib/fossil.tcl
M tools/import-cvs.tcl
+19 -4
--- tools/import-cvs.tcl
+++ tools/import-cvs.tcl
@@ -46,11 +46,11 @@
4646
 package require fossil ; # Backend, writing to destination repository.
4747
4848
 # -----------------------------------------------------------------------------
4949
5050
 proc main {} {
51
- global argv tot nto cvs fossil ntrunk
51
+ global argv tot nto cvs fossil ntrunk stopat
5252
5353
 commandline
5454
5555
 fossil::feedback Write ; # Setup progress feedback from the libraries
5656
 cvs::feedback Write
@@ -70,10 +70,11 @@
7070
 fossil::new ; # Uses cwd as workspace to connect to.
7171
7272
 set ntrunk [cvs::ntrunk]
7373
 cvs::foreach_cset cset [cvs::root] {
7474
 import $cset
75
+ if {$stopat == $cset} exit
7576
 }
7677
 cvs::wsclear
7778
7879
 Write info " ========= [string repeat = 61]"
7980
 Write info " Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
@@ -89,14 +90,15 @@
8990
9091
9192
 # -----------------------------------------------------------------------------
9293
9394
 proc commandline {} {
94
- global argv cvs fossil nosign log debugcommit
95
+ global argv cvs fossil nosign log debugcommit stopat
9596
9697
 set nosign 0
9798
 set debugcommit 0
99
+ set stopat {}
98100
99101
 while {[string match "-*" [set opt [lindex $argv 0]]]} {
100102
 if {$opt eq "--nosign"} {
101103
 set nosign 1
102104
 set argv [lrange $argv 1 end]
@@ -104,10 +106,15 @@
104106
 }
105107
 if {$opt eq "--debugcommit"} {
106108
 set debugcommit 1
107109
 set argv [lrange $argv 1 end]
108110
 continue
111
+ }
112
+ if {$opt eq "--stopat"} {
113
+ set stopat [lindex $argv 1]
114
+ set argv [lrange $argv 2 end]
115
+ continue
109116
 }
110117
 usage
111118
 }
112119
 if {[llength $argv] != 2} usage
113120
 foreach {cvs fossil} $argv break
@@ -135,16 +142,24 @@
135142
 puts stderr " $text"
136143
 exit
137144
 }
138145
139146
 proc import {cset} {
140
- global tot nto nosign ntrunk
147
+ global tot nto nosign ntrunk stopat
141148
 Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
142149
 Write info " At $nto/$ntrunk ([format %.2f [expr {$nto*100.0/$ntrunk}]]%)"
150
+
151
+ if {$stopat == $cset} {
152
+ fossil::commit 1 cvs2fossil $nosign \
153
+ [cvs::wssetup $cset] \
154
+ ::cvs::wsignore
155
+ Write info " %% STOP"
156
+ return
157
+ }
143158
144159
 set usec [lindex [time {
145
- foreach {uuid ad rm ch} [fossil::commit cvs2fossil $nosign \
160
+ foreach {uuid ad rm ch} [fossil::commit 0 cvs2fossil $nosign \
146161
 [cvs::wssetup $cset] \
147162
 ::cvs::wsignore] break
148163
 } 1] 0]
149164
 cvs::uuid $cset $uuid
150165
151166
--- tools/import-cvs.tcl
+++ tools/import-cvs.tcl
@@ -46,11 +46,11 @@
46 package require fossil ; # Backend, writing to destination repository.
47
48 # -----------------------------------------------------------------------------
49
50 proc main {} {
51 global argv tot nto cvs fossil ntrunk
52
53 commandline
54
55 fossil::feedback Write ; # Setup progress feedback from the libraries
56 cvs::feedback Write
@@ -70,10 +70,11 @@
70 fossil::new ; # Uses cwd as workspace to connect to.
71
72 set ntrunk [cvs::ntrunk]
73 cvs::foreach_cset cset [cvs::root] {
74 import $cset
 
75 }
76 cvs::wsclear
77
78 Write info " ========= [string repeat = 61]"
79 Write info " Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
@@ -89,14 +90,15 @@
89
90
91 # -----------------------------------------------------------------------------
92
93 proc commandline {} {
94 global argv cvs fossil nosign log debugcommit
95
96 set nosign 0
97 set debugcommit 0
 
98
99 while {[string match "-*" [set opt [lindex $argv 0]]]} {
100 if {$opt eq "--nosign"} {
101 set nosign 1
102 set argv [lrange $argv 1 end]
@@ -104,10 +106,15 @@
104 }
105 if {$opt eq "--debugcommit"} {
106 set debugcommit 1
107 set argv [lrange $argv 1 end]
108 continue
 
 
 
 
 
109 }
110 usage
111 }
112 if {[llength $argv] != 2} usage
113 foreach {cvs fossil} $argv break
@@ -135,16 +142,24 @@
135 puts stderr " $text"
136 exit
137 }
138
139 proc import {cset} {
140 global tot nto nosign ntrunk
141 Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
142 Write info " At $nto/$ntrunk ([format %.2f [expr {$nto*100.0/$ntrunk}]]%)"
 
 
 
 
 
 
 
 
143
144 set usec [lindex [time {
145 foreach {uuid ad rm ch} [fossil::commit cvs2fossil $nosign \
146 [cvs::wssetup $cset] \
147 ::cvs::wsignore] break
148 } 1] 0]
149 cvs::uuid $cset $uuid
150
151
--- tools/import-cvs.tcl
+++ tools/import-cvs.tcl
@@ -46,11 +46,11 @@
46 package require fossil ; # Backend, writing to destination repository.
47
48 # -----------------------------------------------------------------------------
49
50 proc main {} {
51 global argv tot nto cvs fossil ntrunk stopat
52
53 commandline
54
55 fossil::feedback Write ; # Setup progress feedback from the libraries
56 cvs::feedback Write
@@ -70,10 +70,11 @@
70 fossil::new ; # Uses cwd as workspace to connect to.
71
72 set ntrunk [cvs::ntrunk]
73 cvs::foreach_cset cset [cvs::root] {
74 import $cset
75 if {$stopat == $cset} exit
76 }
77 cvs::wsclear
78
79 Write info " ========= [string repeat = 61]"
80 Write info " Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
@@ -89,14 +90,15 @@
90
91
92 # -----------------------------------------------------------------------------
93
94 proc commandline {} {
95 global argv cvs fossil nosign log debugcommit stopat
96
97 set nosign 0
98 set debugcommit 0
99 set stopat {}
100
101 while {[string match "-*" [set opt [lindex $argv 0]]]} {
102 if {$opt eq "--nosign"} {
103 set nosign 1
104 set argv [lrange $argv 1 end]
@@ -104,10 +106,15 @@
106 }
107 if {$opt eq "--debugcommit"} {
108 set debugcommit 1
109 set argv [lrange $argv 1 end]
110 continue
111 }
112 if {$opt eq "--stopat"} {
113 set stopat [lindex $argv 1]
114 set argv [lrange $argv 2 end]
115 continue
116 }
117 usage
118 }
119 if {[llength $argv] != 2} usage
120 foreach {cvs fossil} $argv break
@@ -135,16 +142,24 @@
142 puts stderr " $text"
143 exit
144 }
145
146 proc import {cset} {
147 global tot nto nosign ntrunk stopat
148 Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
149 Write info " At $nto/$ntrunk ([format %.2f [expr {$nto*100.0/$ntrunk}]]%)"
150
151 if {$stopat == $cset} {
152 fossil::commit 1 cvs2fossil $nosign \
153 [cvs::wssetup $cset] \
154 ::cvs::wsignore
155 Write info " %% STOP"
156 return
157 }
158
159 set usec [lindex [time {
160 foreach {uuid ad rm ch} [fossil::commit 0 cvs2fossil $nosign \
161 [cvs::wssetup $cset] \
162 ::cvs::wsignore] break
163 } 1] 0]
164 cvs::uuid $cset $uuid
165
166
M tools/lib/cvs.tcl
+13 -1
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -340,11 +340,23 @@
340340
 upvar 1 $cv c
341341
 variable rtree
342342
343343
 set c $node
344344
 while {1} {
345
- uplevel 1 $script
345
+ set code [catch {uplevel 1 $script} res]
346
+
347
+ # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
348
+ switch -- $code {
349
+ 0 {}
350
+ 1 { return -errorcode $::errorcode -code error $res }
351
+ 2 {}
352
+ 3 { return }
353
+ 4 {}
354
+ default {
355
+ return -code $code $result
356
+ }
357
+ }
346358
347359
 # Stop on reaching the head.
348360
 if {![llength [$rtree children $c]]} break
349361
350362
 #puts <[$rtree children $c]>
351363
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -340,11 +340,23 @@
340 upvar 1 $cv c
341 variable rtree
342
343 set c $node
344 while {1} {
345 uplevel 1 $script
 
 
 
 
 
 
 
 
 
 
 
 
346
347 # Stop on reaching the head.
348 if {![llength [$rtree children $c]]} break
349
350 #puts <[$rtree children $c]>
351
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -340,11 +340,23 @@
340 upvar 1 $cv c
341 variable rtree
342
343 set c $node
344 while {1} {
345 set code [catch {uplevel 1 $script} res]
346
347 # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue
348 switch -- $code {
349 0 {}
350 1 { return -errorcode $::errorcode -code error $res }
351 2 {}
352 3 { return }
353 4 {}
354 default {
355 return -code $code $result
356 }
357 }
358
359 # Stop on reaching the head.
360 if {![llength [$rtree children $c]]} break
361
362 #puts <[$rtree children $c]>
363
M tools/lib/fossil.tcl
+4 -1
--- tools/lib/fossil.tcl
+++ tools/lib/fossil.tcl
@@ -60,11 +60,11 @@
6060
 variable dcfile [file normalize cvs2fossil_commit.tcl]
6161
 }
6262
 return
6363
 }
6464
65
-proc ::fossil::commit {appname nosign meta ignore} {
65
+proc ::fossil::commit {break appname nosign meta ignore} {
6666
 variable fossil
6767
 variable lastuuid
6868
 variable debugcommit
6969
 variable dcfile
7070
@@ -120,10 +120,13 @@
120120
 }
121121
122122
 if {$debugcommit} {
123123
 fileutil::writeFile $dcfile "\#!tclsh\n$cmd\n"
124124
 }
125
+
126
+ # Stop, do not actually commit.
127
+ if {$break} return
125128
126129
 if {[catch {
127130
 eval $cmd
128131
 } line]} {
129132
 if {![string match "*nothing has changed*" $line]} {
130133
--- tools/lib/fossil.tcl
+++ tools/lib/fossil.tcl
@@ -60,11 +60,11 @@
60 variable dcfile [file normalize cvs2fossil_commit.tcl]
61 }
62 return
63 }
64
65 proc ::fossil::commit {appname nosign meta ignore} {
66 variable fossil
67 variable lastuuid
68 variable debugcommit
69 variable dcfile
70
@@ -120,10 +120,13 @@
120 }
121
122 if {$debugcommit} {
123 fileutil::writeFile $dcfile "\#!tclsh\n$cmd\n"
124 }
 
 
 
125
126 if {[catch {
127 eval $cmd
128 } line]} {
129 if {![string match "*nothing has changed*" $line]} {
130
--- tools/lib/fossil.tcl
+++ tools/lib/fossil.tcl
@@ -60,11 +60,11 @@
60 variable dcfile [file normalize cvs2fossil_commit.tcl]
61 }
62 return
63 }
64
65 proc ::fossil::commit {break appname nosign meta ignore} {
66 variable fossil
67 variable lastuuid
68 variable debugcommit
69 variable dcfile
70
@@ -120,10 +120,13 @@
120 }
121
122 if {$debugcommit} {
123 fileutil::writeFile $dcfile "\#!tclsh\n$cmd\n"
124 }
125
126 # Stop, do not actually commit.
127 if {$break} return
128
129 if {[catch {
130 eval $cmd
131 } line]} {
132 if {![string match "*nothing has changed*" $line]} {
133

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button