Fossil SCM

First semi-complete app for import from CVS. Trunk only, wholesale only.

aku 2007-09-04 05:36 trunk
Commit df91d389d58f7e9f068e7866a568fae14a6b4282
Parent f166b0a63c5e759…
6 files changed +22 +180 -365 +28 +5 +2 +65 -9
~ ci_cvs.txt ~ tools/import-cvs.tcl + tools/lib/cvs.tcl + tools/lib/fossil.tcl ~ tools/lib/pkgIndex.tcl ~ tools/lib/rcsparser.tcl
M ci_cvs.txt
+22
--- ci_cvs.txt
+++ ci_cvs.txt
@@ -166,5 +166,27 @@
166166
167167
168168
 This algorithm has to be refined to also take Attic/ files into
169169
 account.
170170
171
+-------------------------------------------------------------------------
172
+
173
+Two archive files mapping to the same user file. How are they
174
+interleaved ?
175
+
176
+(a) sqlite/src/os_unix.h,v
177
+(b) sqlite/src/Attic/os_unix.h,v
178
+
179
+Problem: Max version of (a) is 1.9
180
+ Max version of (b) is 1.11
181
+ cvs co 1.10 -> no longer in the repository.
182
+
183
+This seems to indicate that the non-Attic file is relevant.
184
+
185
+--------------------------------------------------------------------------
186
+
187
+tcllib - more problems - tklib/pie.tcl,v -
188
+
189
+invalid change text in
190
+/home/aku/Projects/Tcl/Fossil/Devel/Examples/cvs-tcllib/tklib/modules/tkpiechart/pie.tcl,v
191
+
192
+Possibly braces ?
171193
--- ci_cvs.txt
+++ ci_cvs.txt
@@ -166,5 +166,27 @@
166
167
168 This algorithm has to be refined to also take Attic/ files into
169 account.
170
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
171
--- ci_cvs.txt
+++ ci_cvs.txt
@@ -166,5 +166,27 @@
166
167
168 This algorithm has to be refined to also take Attic/ files into
169 account.
170
171 -------------------------------------------------------------------------
172
173 Two archive files mapping to the same user file. How are they
174 interleaved ?
175
176 (a) sqlite/src/os_unix.h,v
177 (b) sqlite/src/Attic/os_unix.h,v
178
179 Problem: Max version of (a) is 1.9
180 Max version of (b) is 1.11
181 cvs co 1.10 -> no longer in the repository.
182
183 This seems to indicate that the non-Attic file is relevant.
184
185 --------------------------------------------------------------------------
186
187 tcllib - more problems - tklib/pie.tcl,v -
188
189 invalid change text in
190 /home/aku/Projects/Tcl/Fossil/Devel/Examples/cvs-tcllib/tklib/modules/tkpiechart/pie.tcl,v
191
192 Possibly braces ?
193
M tools/import-cvs.tcl
+180 -365
--- tools/import-cvs.tcl
+++ tools/import-cvs.tcl
@@ -1,370 +1,185 @@
11
 #!/bin/sh
22
 # -*- tcl -*- \
33
 exec tclsh "$0" ${1+"$@"}
44
55
 # -----------------------------------------------------------------------------
6
-# Make private packages accessible.
7
-
8
-lappend auto_path [file join [file dirname [info script]] lib]
9
-package require rcsparser
10
-package require fileutil
11
-
12
-# -----------------------------------------------------------------------------
13
-# Repository management (CVS)
14
-
15
-namespace eval ::cvs {
16
- variable base ; set base {} ; # Repository toplevel directory.
17
- variable npaths ; array set npaths {} ; # path -> actual path mapping.
18
- variable rpaths ; array set rpaths {} ; # path -> rcs file mapping.
19
- variable cmsg ; array set cmsg {} ; # Cache of commit messages.
20
-}
21
-
22
-proc ::cvs::hextime {hex} {
23
- set t 0
24
- foreach d [string map {
25
- a 10 b 11 c 12 d 13 e 14 f 15
26
- A 10 B 11 C 12 D 13 E 14 F 15
27
- } [split $hex {}]] {
28
- set t [expr {($t << 4) + $d}];#horner
29
- }
30
- return $t
31
-}
32
-
33
-proc ::cvs::at {path} {
34
- variable base $path
35
- return
36
-}
37
-
38
-proc ::cvs::cmsg {path rev} {
39
- variable cmsg
40
- set key [list $path $rev]
41
-
42
- if {![info exists cmsg($key)]} {
43
- set rcs [cvs::rcsfile $path]
44
-
45
- #puts stderr "scan $path => $rcs"
46
-
47
- array set p [::rcsparser::process $rcs]
48
-
49
- foreach {r msg} $p(commit) {
50
- set cmsg([list $path $r]) $msg
51
- }
52
-
53
- if {![info exists cmsg($key)]} {
54
- return -code error "Bogus revision $rev of file $path"
55
- }
56
- }
57
-
58
- return $cmsg($key)
59
-}
60
-
61
-proc ::cvs::norm {path} {
62
- variable npaths
63
- if {![info exists npaths($path)]} {
64
- set npaths($path) [NormFile $path]
65
- }
66
- return $npaths($path)
67
-}
68
-
69
-proc ::cvs::NormFile {path} {
70
- variable base
71
-
72
- set f $base/$path,v
73
- if {[::file exists $f]} {return $path}
74
-
75
- set hd [::file dirname $path]
76
- set tl [::file tail $path]
77
-
78
- set f $base/$hd/Attic/$tl,v
79
- if {[::file exists $f]} {return $path}
80
-
81
- # Bad. The dir can be truncated, i.e. it may not be an exact
82
- # subdirectory of base, but deeper inside, with parents between it
83
- # and base left out. Example (from the tcllib history file):
84
- #
85
- # M3f1d1245|afaupell|<remote>|ipentry|1.2|ChangeLog
86
- # The correct path is 'tklib/modules/ipentry'.
87
- # This we have to resolve too.
88
-
89
- # normalize dance - old fileutil, modern fileutil (cvs head) doesn't do that.
90
- set bx [file normalize $base]
91
- foreach c [fileutil::findByPattern $bx -glob $hd] {
92
- set cx [fileutil::stripPath $bx $c]
93
- set c $base/$cx
94
-
95
- set f $c/$tl,v
96
- if {[::file exists $f]} {return $cx/$tl}
97
- set f $c/Attic/$tl,v
98
- if {[::file exists $f]} {return $cx/$tl}
99
- }
100
-
101
- puts stderr <$f>
102
- return -code error "Unable to locate actual file for $path"
103
-}
104
-
105
-proc ::cvs::rcsfile {path} {
106
- variable rpaths
107
- if {![info exists rpaths($path)]} {
108
- set rpaths($path) [RcsFile $path]
109
- }
110
- return $rpaths($path)
111
-}
112
-
113
-proc ::cvs::RcsFile {path} {
114
- variable base
115
-
116
- set f $base/$path,v
117
- if {[::file exists $f]} {return $f}
118
-
119
- set hd [::file dirname $path]
120
- set tl [::file tail $path]
121
-
122
- set f $base/$hd/Attic/$tl,v
123
- if {[::file exists $f]} {return $f}
124
-
125
- # We do not have truncated directories here, assuming that only
126
- # norm paths are fed into this command.
127
-
128
- if 0 {
129
- # Bad. The dir can be truncated, i.e. it may not be an exact
130
- # subdirectory of base, but deeper inside, with parents
131
- # between it and base left out. Example (from the tcllib
132
- # history file):
133
- #
134
- # M3f1d1245|afaupell|<remote>|ipentry|1.2|ChangeLog The
135
- # correct path is 'tklib/modules/ipentry'. This we have to
136
- # resolve too.
137
-
138
- # normalize dance - old fileutil, modern fileutil (cvs head)
139
- # doesn't do that.
140
- set bx [file normalize $base]
141
- foreach c [fileutil::findByPattern $bx -glob $hd] {
142
- set c $base/[fileutil::stripPath $bx $c]
143
-
144
- set f $c/$tl,v
145
- if {[::file exists $f]} {return $f}
146
- set f $c/Attic/$tl,v
147
- if {[::file exists $f]} {return $f}
148
- }
149
- }
150
-
151
- puts stderr <$f>
152
- return -code error "Unable to locate rcs file for $path"
153
-}
154
-
155
-proc ::cvs::history {} {
156
- variable base
157
- return $base/CVSROOT/history
158
-}
159
-
160
-# -----------------------------------------------------------------------------
161
-
162
-# -----------------------------------------------------------------------------
163
-
164
-cvs::at [lindex $argv 0]
165
-
166
-#puts [::cvs::norm ipentry/ChangeLog]
167
-#exit
168
-
169
-#changeset state
170
-global cs csf
171
-array set cs {
172
- start {} end {} cm {}
173
- usr {} dt {}
174
-}
175
-array set csf {}
176
-
177
-proc rh {} {
178
- global argv cs csf repo
179
-
180
- set f [open [cvs::history] r]
181
-
182
- while {[gets $f line] >= 0} {
183
- # Decode line
184
- foreach {op usr _ dir rev file} [split [string trim $line] |] break
185
- set ts [cvs::hextime [string range $op 1 end]]
186
- set op [string index $op 0]
187
-
188
- # Filter out irrelevant parts
189
- if {$op eq "O"} continue ; # checkout
190
- if {$op eq "F"} continue ; # release
191
- if {$op eq "T"} continue ; # rtag
192
- if {$op eq "W"} continue ; # delete on update
193
- if {$op eq "U"} continue ; # update
194
- if {$op eq "P"} continue ; # update by patch
195
- #if {$op eq "G"} continue ; # merge on update - FUTURE - identifies mergepoints.
196
- if {$op eq "C"} continue ; # conflict on update - s.a.
197
- if {$op eq "E"} continue ; # export
198
- # left types
199
- # M: commit
200
- # A: addition
201
- # R: removal
202
-
203
- set df $dir/$file
204
- if {[newcs $op $usr $ts $rev df cause]} {
205
-
206
- # NOTE 1: ChangeSets containing CVSROOT => remove such files.
207
- # NOTE 2: Empty changesets, ignore.
208
-
209
- #commit
210
- csstats
211
-
212
- if {$cause eq "cmsg"} {
213
-set msg
214
- } else {
215
-set msg ""
216
- }
217
-
218
- if {$cs(end) ne ""} {
219
- puts =============================/$cause\ delta\ [expr {$ts - $cs(end)}]
220
- } else {
221
- puts =============================/$cause
222
- }
223
- csclear
224
- }
225
-
226
- # Note: newcs normalizes df, in case the log information is
227
- # bogus. So the df here may be different from before newcs
228
- csadd $op $usr $ts $rev $df
229
- # apply modification to workspace
230
- }
231
-}
232
-
233
-proc newcs {op usr ts rev dfv rv} {
234
- global cs csf
235
- upvar 1 $rv reason $dfv df
236
-
237
- # Logic to detect when a new change set begins. A new change sets
238
- # has started with the current entry when the entry
239
- #
240
- # 1. is for a different user than the last.
241
- # 2. tries to add a file to the changeset which is already part of it.
242
- # 3.is on the trunk, and the last on a branch, or vice versa.
243
- # 4. the current entry has a different commit message than the last.
244
-
245
- set df [cvs::norm $df]
246
-
247
- # User changed
248
- if {$usr ne $cs(usr)} {
249
- set reason user
250
- return 1
251
- }
252
-
253
- # File is already in the changeset
254
- if {[info exists csf($df)]} {
255
- set reason file
256
- return 1
257
- }
258
-
259
- # last/current are different regarding trunk/branch
260
- set depth [llength [split $rev .]]
261
- if {($cs(lastd) == 2) != ($depth == 2)} {
262
- set reason branch
263
- return 1
264
- }
265
-
266
- # Commit message changed
267
- if {[cvs::cmsg $cs(lastf) $cs(lastr)] ne [cvs::cmsg $df $rev]} {
268
- set reason cmsg
269
- return 1
270
- }
271
-
272
- # Same changeset
273
- return 0
274
-}
275
-
276
-proc csclear {} {
277
- global cs csf
278
- array set cs {start {} usr {} end {} dt {}}
279
- array unset csf *
280
- return
281
-}
282
-
283
-proc csadd {op usr ts rev df} {
284
- global cs csf
285
-
286
- if {$cs(usr) eq ""} {set cs(usr) $usr}
287
- if {$cs(start) eq ""} {
288
- set cs(start) $ts
289
- } else {
290
- lappend cs(dt) [expr {$ts - $cs(end)}]
291
- }
292
- set cs(end) $ts
293
-
294
- set csf($df) [list $op $rev]
295
- set cs(lastf) $df
296
- set cs(lastr) $rev
297
- set cs(lastd) [llength [split $rev .]]
298
-
299
- puts [list $op [clock format $ts] $usr $rev $df]
300
- return
301
-}
302
-
303
-proc csstats {} {
304
- global cs csf
305
-
306
- if {$cs(start) eq ""} return
307
-
308
- puts "files: [array size csf]"
309
- puts "delta: $cs(dt)"
310
- puts "range: [expr {$cs(end) - $cs(start)}] seconds"
311
- return
312
-}
313
-
314
-rh
315
-
316
-exit
317
-
318
-=========================================
319
-new fossil
320
-new fossil workspace
321
-
322
-open history
323
-
324
-foreach line {
325
- ignore unwanted lines
326
-
327
- accumulate changesets data
328
- new change-set => commit and continue
329
-
330
- current branch and branch of new change different ?
331
- => move fossil workspace to proper revision.
332
-
333
- apply change to workspace
334
- uncommitted
335
-}
336
-
337
-if uncommitted => commit
338
-delete workspace
339
-copy fossil repo to destination
340
-=========================================
341
-
342
-Not dealt with in outline: branches, tags, merging
343
-
344
-=========================================
345
-
346
-complexities
347
-- apply to workspace
348
- - remove simple, direct translation
349
- - add => requires extraction of indicated revision from ,v
350
- - modify => see above (without add following)
351
-
352
-- ,v file => Can be the either dir/file,v, or dir/Attic/file,v
353
- Both ? Priority ?
354
-
355
-- How to detect changes on branches ?
356
-
357
-- Have to keep knowledge of which branches went there.
358
- => save change-sets information, + uuid in fossil
359
- => need only the leaves of each branch, and of branch points.
360
- => better keep all until complete.
361
- => uuid can be gotten from 'manifest.uuid' in workspace.
362
-- keep tag information ? (symbolics)
363
-
364
-=========================================
365
-
366
-CVSROOT=ORIGIN
367
-
368
-cvs -d ORIGIN checkout -r REV FILE
369
-Extract specific revision of a specific file.
370
--q, -Q quietness
6
+
7
+# Import the trunk of a CVS repository wholesale into a fossil repository.
8
+
9
+# Limitations implicitly mentioned:
10
+# - No incremental import.
11
+# - No import of branches.
12
+
13
+# WIBNI features (beyond eliminating the limitations):
14
+# - Restrict import to specific directory subtrees (SF projects use
15
+# one repository for several independent modules. Examples: tcllib
16
+# -> tcllib, tklib, tclapps, etc.). The restriction would allow import
17
+# of only a specific module.
18
+# - Related to the previous, strip elements from the base path to keep
19
+# it short.
20
+# - Export to CVS, trunk, possibly branches. I.e. extend the system to be
21
+# a full bridge. Either Fossil or CVS could be the master repository.
22
+
23
+# HACKS. I.e. I do not know if the 'fixes' I use are the correct way
24
+# of handling the encountered situations.
25
+#
26
+# - File F has archives F,v and Attic/F,v. Currently I will ignore the
27
+# file in the Attic.
28
+# Examples: sqlite/os_unix.h
29
+#
30
+# - A specific revision of a file F cannot be checked out (reported
31
+# error is 'invalid change text'). This indicates a corrupt RCS
32
+# file, one or more delta are bad. We report but ignore the problem
33
+# in a best-effort attempt at getting as much history as possible.
34
+# Examples: tcllib/tklib/modules/tkpiechart/pie.tcl
35
+
36
+# -----------------------------------------------------------------------------
37
+# Make private packages accessible.
38
+
39
+lappend auto_path [file join [file dirname [info script]] lib]
40
+
41
+# -----------------------------------------------------------------------------
42
+# Requirements
43
+
44
+package Tcl 8.4
45
+package require cvs ; # Frontend, reading from source repository
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
57
+
58
+ cvs::at $cvs ; # Define location of CVS repository
59
+ cvs::scan ; # Gather revision data from the archives
60
+ cvs::csets ; # Group changes into sets
61
+ cvs::rtree ; # Build revision tree (trunk only right now).
62
+
63
+ set tot 0.0
64
+ set nto 0
65
+
66
+ Write info {Importing ...}
67
+ Write info { Setting up cvs workspace and temporary fossil repository}
68
+
69
+ cvs::workspace ; # cd's to workspace
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"}]"
80
+ Write info " Within [format %.2f $tot] seconds (avg [format %.2f [expr {$tot/$nto}]] seconds/changeset)"
81
+
82
+ Write info { Moving to final destination}
83
+
84
+ fossil::destination $fossil
85
+
86
+ Write info Ok.
87
+ return
88
+}
89
+
90
+
91
+# -----------------------------------------------------------------------------
92
+
93
+proc commandline {} {
94
+ global argv cvs fossil nosign log
95
+
96
+ set nosign 0
97
+ while {[string match "-*" [set opt [lindex $argv 0]]]} {
98
+ if {$opt eq "--nosign"} {
99
+ set nosign 1
100
+ set argv [lrange $argv 1 end]
101
+ continue
102
+ }
103
+ usage
104
+ }
105
+ if {[llength $argv] != 2} usage
106
+ foreach {cvs fossil} $argv break
107
+
108
+ if {
109
+ ![file exists $cvs] ||
110
+ ![file readable $cvs] ||
111
+ ![file isdirectory $cvs]
112
+ } {
113
+ usage "CVS directory missing, not readable, or not a directory."
114
+ } elseif {[file exists $fossil]} {
115
+ usage "Fossil destination repository exists already."
116
+ }
117
+
118
+ set log [open ${fossil}.log w]
119
+ return
120
+}
121
+
122
+proc usage {{text {}}} {
123
+ global argv0
124
+ puts stderr "Usage: $argv0 ?--nosign? cvs-repository fossil-rpeository"
125
+ if {$text eq ""} return
126
+ puts stderr " $text"
127
+ exit
128
+}
129
+
130
+proc import {cset} {
131
+ global tot nto nosign ntrunk
132
+ Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
133
+ Write info " At $nto/$ntrunk ([format %.2f [expr {double($nto)/$ntrunk}]]%)"
134
+
135
+ set usec [lindex [time {
136
+ foreach {uuid ad rm ch} [fossil::commit cvs2fossil $nosign \
137
+ [cvs::wssetup $cset] \
138
+ ::cvs::wsignore] break
139
+ } 1] 0]
140
+ cvs::uuid $cset $uuid
141
+
142
+ set sec [expr {$usec/1e6}]
143
+ set tot [expr {$tot + $sec}]
144
+ incr nto
145
+
146
+ Write info " == $uuid +${ad}-${rm}*${ch}"
147
+ Write info " in $sec seconds"
148
+
149
+ set avg [expr {$tot/$nto}]
150
+ set max [expr {$ntrunk * $avg}]
151
+ set rem [expr {$max - $tot}]
152
+
153
+ Write info " st avg [format %.2f $avg]"
154
+ Write info " st run [format %7.2f $tot] sec [format %6.2f [expr {$tot/60}]] min [format %5.2f [expr {$tot/3600}]] hr"
155
+ Write info " st end [format %7.2f $max] sec [format %6.2f [expr {$max/60}]] min [format %5.2f [expr {$max/3600}]] hr"
156
+ Write info " st rem [format %7.2f $rem] sec [format %6.2f [expr {$rem/60}]] min [format %5.2f [expr {$rem/3600}]] hr"
157
+ return
158
+}
159
+
160
+# -----------------------------------------------------------------------------
161
+
162
+array set fl {
163
+ debug {DEBUG }
164
+ info { }
165
+ warning {Warning}
166
+ error {ERROR }
167
+}
168
+
169
+proc Write {l t} {
170
+ global fl log
171
+
172
+ if {[string index $t 0] eq "\r"} {
173
+ puts -nonewline stdout "\r$fl($l) [string range $t 0 end-1]"
174
+ } else {
175
+ puts stdout "$fl($l) $t"
176
+ puts $log "$fl($l) $t"
177
+ }
178
+ flush stdout
179
+ return
180
+}
181
+
182
+# -----------------------------------------------------------------------------
183
+
184
+main
185
+exit
371186
372187
ADDED tools/lib/cvs.tcl
373188
ADDED tools/lib/fossil.tcl
--- tools/import-cvs.tcl
+++ tools/import-cvs.tcl
@@ -1,370 +1,185 @@
1 #!/bin/sh
2 # -*- tcl -*- \
3 exec tclsh "$0" ${1+"$@"}
4
5 # -----------------------------------------------------------------------------
6 # Make private packages accessible.
7
8 lappend auto_path [file join [file dirname [info script]] lib]
9 package require rcsparser
10 package require fileutil
11
12 # -----------------------------------------------------------------------------
13 # Repository management (CVS)
14
15 namespace eval ::cvs {
16 variable base ; set base {} ; # Repository toplevel directory.
17 variable npaths ; array set npaths {} ; # path -> actual path mapping.
18 variable rpaths ; array set rpaths {} ; # path -> rcs file mapping.
19 variable cmsg ; array set cmsg {} ; # Cache of commit messages.
20 }
21
22 proc ::cvs::hextime {hex} {
23 set t 0
24 foreach d [string map {
25 a 10 b 11 c 12 d 13 e 14 f 15
26 A 10 B 11 C 12 D 13 E 14 F 15
27 } [split $hex {}]] {
28 set t [expr {($t << 4) + $d}];#horner
29 }
30 return $t
31 }
32
33 proc ::cvs::at {path} {
34 variable base $path
35 return
36 }
37
38 proc ::cvs::cmsg {path rev} {
39 variable cmsg
40 set key [list $path $rev]
41
42 if {![info exists cmsg($key)]} {
43 set rcs [cvs::rcsfile $path]
44
45 #puts stderr "scan $path => $rcs"
46
47 array set p [::rcsparser::process $rcs]
48
49 foreach {r msg} $p(commit) {
50 set cmsg([list $path $r]) $msg
51 }
52
53 if {![info exists cmsg($key)]} {
54 return -code error "Bogus revision $rev of file $path"
55 }
56 }
57
58 return $cmsg($key)
59 }
60
61 proc ::cvs::norm {path} {
62 variable npaths
63 if {![info exists npaths($path)]} {
64 set npaths($path) [NormFile $path]
65 }
66 return $npaths($path)
67 }
68
69 proc ::cvs::NormFile {path} {
70 variable base
71
72 set f $base/$path,v
73 if {[::file exists $f]} {return $path}
74
75 set hd [::file dirname $path]
76 set tl [::file tail $path]
77
78 set f $base/$hd/Attic/$tl,v
79 if {[::file exists $f]} {return $path}
80
81 # Bad. The dir can be truncated, i.e. it may not be an exact
82 # subdirectory of base, but deeper inside, with parents between it
83 # and base left out. Example (from the tcllib history file):
84 #
85 # M3f1d1245|afaupell|<remote>|ipentry|1.2|ChangeLog
86 # The correct path is 'tklib/modules/ipentry'.
87 # This we have to resolve too.
88
89 # normalize dance - old fileutil, modern fileutil (cvs head) doesn't do that.
90 set bx [file normalize $base]
91 foreach c [fileutil::findByPattern $bx -glob $hd] {
92 set cx [fileutil::stripPath $bx $c]
93 set c $base/$cx
94
95 set f $c/$tl,v
96 if {[::file exists $f]} {return $cx/$tl}
97 set f $c/Attic/$tl,v
98 if {[::file exists $f]} {return $cx/$tl}
99 }
100
101 puts stderr <$f>
102 return -code error "Unable to locate actual file for $path"
103 }
104
105 proc ::cvs::rcsfile {path} {
106 variable rpaths
107 if {![info exists rpaths($path)]} {
108 set rpaths($path) [RcsFile $path]
109 }
110 return $rpaths($path)
111 }
112
113 proc ::cvs::RcsFile {path} {
114 variable base
115
116 set f $base/$path,v
117 if {[::file exists $f]} {return $f}
118
119 set hd [::file dirname $path]
120 set tl [::file tail $path]
121
122 set f $base/$hd/Attic/$tl,v
123 if {[::file exists $f]} {return $f}
124
125 # We do not have truncated directories here, assuming that only
126 # norm paths are fed into this command.
127
128 if 0 {
129 # Bad. The dir can be truncated, i.e. it may not be an exact
130 # subdirectory of base, but deeper inside, with parents
131 # between it and base left out. Example (from the tcllib
132 # history file):
133 #
134 # M3f1d1245|afaupell|<remote>|ipentry|1.2|ChangeLog The
135 # correct path is 'tklib/modules/ipentry'. This we have to
136 # resolve too.
137
138 # normalize dance - old fileutil, modern fileutil (cvs head)
139 # doesn't do that.
140 set bx [file normalize $base]
141 foreach c [fileutil::findByPattern $bx -glob $hd] {
142 set c $base/[fileutil::stripPath $bx $c]
143
144 set f $c/$tl,v
145 if {[::file exists $f]} {return $f}
146 set f $c/Attic/$tl,v
147 if {[::file exists $f]} {return $f}
148 }
149 }
150
151 puts stderr <$f>
152 return -code error "Unable to locate rcs file for $path"
153 }
154
155 proc ::cvs::history {} {
156 variable base
157 return $base/CVSROOT/history
158 }
159
160 # -----------------------------------------------------------------------------
161
162 # -----------------------------------------------------------------------------
163
164 cvs::at [lindex $argv 0]
165
166 #puts [::cvs::norm ipentry/ChangeLog]
167 #exit
168
169 #changeset state
170 global cs csf
171 array set cs {
172 start {} end {} cm {}
173 usr {} dt {}
174 }
175 array set csf {}
176
177 proc rh {} {
178 global argv cs csf repo
179
180 set f [open [cvs::history] r]
181
182 while {[gets $f line] >= 0} {
183 # Decode line
184 foreach {op usr _ dir rev file} [split [string trim $line] |] break
185 set ts [cvs::hextime [string range $op 1 end]]
186 set op [string index $op 0]
187
188 # Filter out irrelevant parts
189 if {$op eq "O"} continue ; # checkout
190 if {$op eq "F"} continue ; # release
191 if {$op eq "T"} continue ; # rtag
192 if {$op eq "W"} continue ; # delete on update
193 if {$op eq "U"} continue ; # update
194 if {$op eq "P"} continue ; # update by patch
195 #if {$op eq "G"} continue ; # merge on update - FUTURE - identifies mergepoints.
196 if {$op eq "C"} continue ; # conflict on update - s.a.
197 if {$op eq "E"} continue ; # export
198 # left types
199 # M: commit
200 # A: addition
201 # R: removal
202
203 set df $dir/$file
204 if {[newcs $op $usr $ts $rev df cause]} {
205
206 # NOTE 1: ChangeSets containing CVSROOT => remove such files.
207 # NOTE 2: Empty changesets, ignore.
208
209 #commit
210 csstats
211
212 if {$cause eq "cmsg"} {
213 set msg
214 } else {
215 set msg ""
216 }
217
218 if {$cs(end) ne ""} {
219 puts =============================/$cause\ delta\ [expr {$ts - $cs(end)}]
220 } else {
221 puts =============================/$cause
222 }
223 csclear
224 }
225
226 # Note: newcs normalizes df, in case the log information is
227 # bogus. So the df here may be different from before newcs
228 csadd $op $usr $ts $rev $df
229 # apply modification to workspace
230 }
231 }
232
233 proc newcs {op usr ts rev dfv rv} {
234 global cs csf
235 upvar 1 $rv reason $dfv df
236
237 # Logic to detect when a new change set begins. A new change sets
238 # has started with the current entry when the entry
239 #
240 # 1. is for a different user than the last.
241 # 2. tries to add a file to the changeset which is already part of it.
242 # 3.is on the trunk, and the last on a branch, or vice versa.
243 # 4. the current entry has a different commit message than the last.
244
245 set df [cvs::norm $df]
246
247 # User changed
248 if {$usr ne $cs(usr)} {
249 set reason user
250 return 1
251 }
252
253 # File is already in the changeset
254 if {[info exists csf($df)]} {
255 set reason file
256 return 1
257 }
258
259 # last/current are different regarding trunk/branch
260 set depth [llength [split $rev .]]
261 if {($cs(lastd) == 2) != ($depth == 2)} {
262 set reason branch
263 return 1
264 }
265
266 # Commit message changed
267 if {[cvs::cmsg $cs(lastf) $cs(lastr)] ne [cvs::cmsg $df $rev]} {
268 set reason cmsg
269 return 1
270 }
271
272 # Same changeset
273 return 0
274 }
275
276 proc csclear {} {
277 global cs csf
278 array set cs {start {} usr {} end {} dt {}}
279 array unset csf *
280 return
281 }
282
283 proc csadd {op usr ts rev df} {
284 global cs csf
285
286 if {$cs(usr) eq ""} {set cs(usr) $usr}
287 if {$cs(start) eq ""} {
288 set cs(start) $ts
289 } else {
290 lappend cs(dt) [expr {$ts - $cs(end)}]
291 }
292 set cs(end) $ts
293
294 set csf($df) [list $op $rev]
295 set cs(lastf) $df
296 set cs(lastr) $rev
297 set cs(lastd) [llength [split $rev .]]
298
299 puts [list $op [clock format $ts] $usr $rev $df]
300 return
301 }
302
303 proc csstats {} {
304 global cs csf
305
306 if {$cs(start) eq ""} return
307
308 puts "files: [array size csf]"
309 puts "delta: $cs(dt)"
310 puts "range: [expr {$cs(end) - $cs(start)}] seconds"
311 return
312 }
313
314 rh
315
316 exit
317
318 =========================================
319 new fossil
320 new fossil workspace
321
322 open history
323
324 foreach line {
325 ignore unwanted lines
326
327 accumulate changesets data
328 new change-set => commit and continue
329
330 current branch and branch of new change different ?
331 => move fossil workspace to proper revision.
332
333 apply change to workspace
334 uncommitted
335 }
336
337 if uncommitted => commit
338 delete workspace
339 copy fossil repo to destination
340 =========================================
341
342 Not dealt with in outline: branches, tags, merging
343
344 =========================================
345
346 complexities
347 - apply to workspace
348 - remove simple, direct translation
349 - add => requires extraction of indicated revision from ,v
350 - modify => see above (without add following)
351
352 - ,v file => Can be the either dir/file,v, or dir/Attic/file,v
353 Both ? Priority ?
354
355 - How to detect changes on branches ?
356
357 - Have to keep knowledge of which branches went there.
358 => save change-sets information, + uuid in fossil
359 => need only the leaves of each branch, and of branch points.
360 => better keep all until complete.
361 => uuid can be gotten from 'manifest.uuid' in workspace.
362 - keep tag information ? (symbolics)
363
364 =========================================
365
366 CVSROOT=ORIGIN
367
368 cvs -d ORIGIN checkout -r REV FILE
369 Extract specific revision of a specific file.
370 -q, -Q quietness
371
372 DDED tools/lib/cvs.tcl
373 DDED tools/lib/fossil.tcl
--- tools/import-cvs.tcl
+++ tools/import-cvs.tcl
@@ -1,370 +1,185 @@
1 #!/bin/sh
2 # -*- tcl -*- \
3 exec tclsh "$0" ${1+"$@"}
4
5 # -----------------------------------------------------------------------------
6
7 # Import the trunk of a CVS repository wholesale into a fossil repository.
8
9 # Limitations implicitly mentioned:
10 # - No incremental import.
11 # - No import of branches.
12
13 # WIBNI features (beyond eliminating the limitations):
14 # - Restrict import to specific directory subtrees (SF projects use
15 # one repository for several independent modules. Examples: tcllib
16 # -> tcllib, tklib, tclapps, etc.). The restriction would allow import
17 # of only a specific module.
18 # - Related to the previous, strip elements from the base path to keep
19 # it short.
20 # - Export to CVS, trunk, possibly branches. I.e. extend the system to be
21 # a full bridge. Either Fossil or CVS could be the master repository.
22
23 # HACKS. I.e. I do not know if the 'fixes' I use are the correct way
24 # of handling the encountered situations.
25 #
26 # - File F has archives F,v and Attic/F,v. Currently I will ignore the
27 # file in the Attic.
28 # Examples: sqlite/os_unix.h
29 #
30 # - A specific revision of a file F cannot be checked out (reported
31 # error is 'invalid change text'). This indicates a corrupt RCS
32 # file, one or more delta are bad. We report but ignore the problem
33 # in a best-effort attempt at getting as much history as possible.
34 # Examples: tcllib/tklib/modules/tkpiechart/pie.tcl
35
36 # -----------------------------------------------------------------------------
37 # Make private packages accessible.
38
39 lappend auto_path [file join [file dirname [info script]] lib]
40
41 # -----------------------------------------------------------------------------
42 # Requirements
43
44 package Tcl 8.4
45 package require cvs ; # Frontend, reading from source repository
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
57
58 cvs::at $cvs ; # Define location of CVS repository
59 cvs::scan ; # Gather revision data from the archives
60 cvs::csets ; # Group changes into sets
61 cvs::rtree ; # Build revision tree (trunk only right now).
62
63 set tot 0.0
64 set nto 0
65
66 Write info {Importing ...}
67 Write info { Setting up cvs workspace and temporary fossil repository}
68
69 cvs::workspace ; # cd's to workspace
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"}]"
80 Write info " Within [format %.2f $tot] seconds (avg [format %.2f [expr {$tot/$nto}]] seconds/changeset)"
81
82 Write info { Moving to final destination}
83
84 fossil::destination $fossil
85
86 Write info Ok.
87 return
88 }
89
90
91 # -----------------------------------------------------------------------------
92
93 proc commandline {} {
94 global argv cvs fossil nosign log
95
96 set nosign 0
97 while {[string match "-*" [set opt [lindex $argv 0]]]} {
98 if {$opt eq "--nosign"} {
99 set nosign 1
100 set argv [lrange $argv 1 end]
101 continue
102 }
103 usage
104 }
105 if {[llength $argv] != 2} usage
106 foreach {cvs fossil} $argv break
107
108 if {
109 ![file exists $cvs] ||
110 ![file readable $cvs] ||
111 ![file isdirectory $cvs]
112 } {
113 usage "CVS directory missing, not readable, or not a directory."
114 } elseif {[file exists $fossil]} {
115 usage "Fossil destination repository exists already."
116 }
117
118 set log [open ${fossil}.log w]
119 return
120 }
121
122 proc usage {{text {}}} {
123 global argv0
124 puts stderr "Usage: $argv0 ?--nosign? cvs-repository fossil-rpeository"
125 if {$text eq ""} return
126 puts stderr " $text"
127 exit
128 }
129
130 proc import {cset} {
131 global tot nto nosign ntrunk
132 Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
133 Write info " At $nto/$ntrunk ([format %.2f [expr {double($nto)/$ntrunk}]]%)"
134
135 set usec [lindex [time {
136 foreach {uuid ad rm ch} [fossil::commit cvs2fossil $nosign \
137 [cvs::wssetup $cset] \
138 ::cvs::wsignore] break
139 } 1] 0]
140 cvs::uuid $cset $uuid
141
142 set sec [expr {$usec/1e6}]
143 set tot [expr {$tot + $sec}]
144 incr nto
145
146 Write info " == $uuid +${ad}-${rm}*${ch}"
147 Write info " in $sec seconds"
148
149 set avg [expr {$tot/$nto}]
150 set max [expr {$ntrunk * $avg}]
151 set rem [expr {$max - $tot}]
152
153 Write info " st avg [format %.2f $avg]"
154 Write info " st run [format %7.2f $tot] sec [format %6.2f [expr {$tot/60}]] min [format %5.2f [expr {$tot/3600}]] hr"
155 Write info " st end [format %7.2f $max] sec [format %6.2f [expr {$max/60}]] min [format %5.2f [expr {$max/3600}]] hr"
156 Write info " st rem [format %7.2f $rem] sec [format %6.2f [expr {$rem/60}]] min [format %5.2f [expr {$rem/3600}]] hr"
157 return
158 }
159
160 # -----------------------------------------------------------------------------
161
162 array set fl {
163 debug {DEBUG }
164 info { }
165 warning {Warning}
166 error {ERROR }
167 }
168
169 proc Write {l t} {
170 global fl log
171
172 if {[string index $t 0] eq "\r"} {
173 puts -nonewline stdout "\r$fl($l) [string range $t 0 end-1]"
174 } else {
175 puts stdout "$fl($l) $t"
176 puts $log "$fl($l) $t"
177 }
178 flush stdout
179 return
180 }
181
182 # -----------------------------------------------------------------------------
183
184 main
185 exit
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
186
187 DDED tools/lib/cvs.tcl
188 DDED tools/lib/fossil.tcl
A tools/lib/cvs.tcl
+28
--- a/tools/lib/cvs.tcl
+++ b/tools/lib/cvs.tcl
@@ -0,0 +1,28 @@
1
+# -----------------------------------------------------------------------------
2
+# Repository management (CVS)
3
+
4
+# -----------------------------------------------------------------------------
5
+# Requirements
6
+
7
+package require Tcl 8.4
8
+package require fileutil ; # Tcllib (cat)epository managemrcsparserie files.
9
+package require struct::tree------------------------# -# -----------------------------------------------------------------------------
10
+# nce of
11
+ # changecvnce of
12
+ # changes. Grr. Six of one ...
13
+
14
+ continue
15
+ }
16
+ 8.4
17
+package applicaitory for rbasere vc:Define logging callback command
18
+
19
+p:feedback {logcmdH@1gW,s:lc $logcmd
20
+ ::rcsparser::feedback $logcmd
21
+ return3q@DG,Y:Log info "Scanning CVS tree $base"2L@Hk,N:Log info " Parsing at@KI,A:Log info "H@12W,N:=> Ignoring admin file"M@1RA,6o@MA,C: Log info "H@12W,L:=> Ignoring attic forBO@Te,P:Log info " => $f"97@dz,X:Log info " => Dead first"1s@na,8:Log infoZ@17A,A4@qA,8:Log info7b@~P,8:Log infou@17A,X@184,8:Log info9y@18l,8:Log infoAS@1It,8:Log info1L@1TV,8:Log info6a@1U~,O:Log info " Workspace:7e@1ax,I:Log info " r@1in,I:Log info " 12@1jq,O:Log info " -- $opJs@1l8,I:Log info " B_@24C,4:code6p@2GC,_w@2Ny,O@2QT,T:
22
+
23
+proc ::cvs::Log {level textH@1gW,l:lc
24
+ uplevel #0 [linsert $lc end $level $text]R@2Kx,C:Nop {args} {W@Bz,17:Logging callback. No logging by default.
25
+ variable lc ::cvs::Nop
26
+}
27
+
28
+1K@0,_@2xv,3LS70Y;
--- a/tools/lib/cvs.tcl
+++ b/tools/lib/cvs.tcl
@@ -0,0 +1,28 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/lib/cvs.tcl
+++ b/tools/lib/cvs.tcl
@@ -0,0 +1,28 @@
1 # -----------------------------------------------------------------------------
2 # Repository management (CVS)
3
4 # -----------------------------------------------------------------------------
5 # Requirements
6
7 package require Tcl 8.4
8 package require fileutil ; # Tcllib (cat)epository managemrcsparserie files.
9 package require struct::tree------------------------# -# -----------------------------------------------------------------------------
10 # nce of
11 # changecvnce of
12 # changes. Grr. Six of one ...
13
14 continue
15 }
16 8.4
17 package applicaitory for rbasere vc:Define logging callback command
18
19 p:feedback {logcmdH@1gW,s:lc $logcmd
20 ::rcsparser::feedback $logcmd
21 return3q@DG,Y:Log info "Scanning CVS tree $base"2L@Hk,N:Log info " Parsing at@KI,A:Log info "H@12W,N:=> Ignoring admin file"M@1RA,6o@MA,C: Log info "H@12W,L:=> Ignoring attic forBO@Te,P:Log info " => $f"97@dz,X:Log info " => Dead first"1s@na,8:Log infoZ@17A,A4@qA,8:Log info7b@~P,8:Log infou@17A,X@184,8:Log info9y@18l,8:Log infoAS@1It,8:Log info1L@1TV,8:Log info6a@1U~,O:Log info " Workspace:7e@1ax,I:Log info " r@1in,I:Log info " 12@1jq,O:Log info " -- $opJs@1l8,I:Log info " B_@24C,4:code6p@2GC,_w@2Ny,O@2QT,T:
22
23 proc ::cvs::Log {level textH@1gW,l:lc
24 uplevel #0 [linsert $lc end $level $text]R@2Kx,C:Nop {args} {W@Bz,17:Logging callback. No logging by default.
25 variable lc ::cvs::Nop
26 }
27
28 1K@0,_@2xv,3LS70Y;
A tools/lib/fossil.tcl
+5
--- a/tools/lib/fossil.tcl
+++ b/tools/lib/fossil.tcl
@@ -0,0 +1,5 @@
1
+# --------------------------------------------------------------}
2
+[catch {
3
+ if {$nosign --nosign
4
+ } else
5
+ }
--- a/tools/lib/fossil.tcl
+++ b/tools/lib/fossil.tcl
@@ -0,0 +1,5 @@
 
 
 
 
 
--- a/tools/lib/fossil.tcl
+++ b/tools/lib/fossil.tcl
@@ -0,0 +1,5 @@
1 # --------------------------------------------------------------}
2 [catch {
3 if {$nosign --nosign
4 } else
5 }
M tools/lib/pkgIndex.tcl
+2
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,2 +1,4 @@
11
 if {![package vsatisfies [package require Tcl] 8.4]} return
22
 package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
3
+package ifneeded cvs 1.0 [list source [file join $dir cvs.tcl]]
4
+package ifneeded fossil 1.0 [list source [file join $dir fossil.tcl]]
35
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,2 +1,4 @@
1 if {![package vsatisfies [package require Tcl] 8.4]} return
2 package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
 
 
3
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,2 +1,4 @@
1 if {![package vsatisfies [package require Tcl] 8.4]} return
2 package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
3 package ifneeded cvs 1.0 [list source [file join $dir cvs.tcl]]
4 package ifneeded fossil 1.0 [list source [file join $dir fossil.tcl]]
5
M tools/lib/rcsparser.tcl
+65 -9
--- tools/lib/rcsparser.tcl
+++ tools/lib/rcsparser.tcl
@@ -11,18 +11,49 @@
1111
1212
 namespace eval ::rcsparser {}
1313
1414
 # -----------------------------------------------------------------------------
1515
 # API
16
+
17
+proc ::rcsparser::feedback {logcmd} {
18
+ variable lc $logcmd
19
+ return
20
+}
1621
1722
 proc ::rcsparser::process {path} {
1823
 set data [fileutil::cat -encoding binary $path]
1924
 array set res {}
25
+ set res(size) [file size $path]
26
+ set res(done) 0
27
+ set res(nsize) [string length $res(size)]
28
+
2029
 Admin
2130
 Deltas
2231
 Description
2332
 DeltaTexts
33
+
34
+ Feedback \r
35
+
36
+ # Remove parser state
37
+ catch {unset res(id)}
38
+ catch {unset res(lastval)}
39
+ unset res(size)
40
+ unset res(nsize)
41
+ unset res(done)
42
+
43
+ # res: 'head' -> head revision
44
+ # 'branch' -> ?
45
+ # 'symbol' -> (sym -> revision)
46
+ # 'lock' -> (sym -> revision)
47
+ # 'comment' -> file comment
48
+ # 'expand' -> ?
49
+ # 'date' -> (revision -> date)
50
+ # 'author' -> (revision -> author)
51
+ # 'state' -> (revision -> state)
52
+ # 'parent' -> (revision -> parent revision)
53
+ # 'commit' -> (revision -> commit message)
54
+
2455
 return [array get res]
2556
 }
2657
2758
 # -----------------------------------------------------------------------------
2859
 # Internal helper commands
@@ -33,11 +64,11 @@
3364
 return
3465
 }
3566
3667
 proc ::rcsparser::Deltas {} {
3768
 upvar 1 data data res res
38
- while {[Num 0]} { Date ; Author ; State ; Branches ; NextRev }
69
+ while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
3970
 return
4071
 }
4172
4273
 proc ::rcsparser::Description {} {
4374
 upvar 1 data data res res
@@ -47,11 +78,11 @@
4778
 return
4879
 }
4980
5081
 proc ::rcsparser::DeltaTexts {} {
5182
 upvar 1 data data res res
52
- while {[Num 0]} { Log ; Text }
83
+ while {[Num 0]} { IsIdent ; Log ; Text }
5384
 return
5485
 }
5586
5687
 proc ::rcsparser::Head {} {
5788
 upvar 1 data data res res
@@ -114,22 +145,27 @@
114145
 }
115146
116147
 proc ::rcsparser::Date {} {
117148
 upvar 1 data data res res
118149
 Literal date ; Num 1 ; Literal \;
150
+
151
+ foreach {yr mo dy h m s} [split $res(lastval) .] break
152
+ if {$yr < 100} {incr yr 1900}
153
+ set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
154
+ Map date
119155
 return
120156
 }
121157
122158
 proc ::rcsparser::Author {} {
123159
 upvar 1 data data res res
124
- Literal author ; Skip ; Literal \;
160
+ Literal author ; Skip ; Literal \; ; Map author
125161
 return
126162
 }
127163
128164
 proc ::rcsparser::State {} {
129165
 upvar 1 data data res res
130
- Literal state ; Skip ; Literal \;
166
+ Literal state ; Skip ; Literal \; ; Map state
131167
 return
132168
 }
133169
134170
 proc ::rcsparser::Branches {} {
135171
 upvar 1 data data res res
@@ -137,25 +173,27 @@
137173
 return
138174
 }
139175
140176
 proc ::rcsparser::NextRev {} {
141177
 upvar 1 data data res res
142
- Literal next ; Skip ; Literal \;
178
+ Literal next ; Skip ; Literal \; ; Map parent
143179
 return
144180
 }
145181
146182
 proc ::rcsparser::Log {} {
147183
 upvar 1 data data res res
148
- IsIdent ; Literal log ; String 1 ; Map commit
184
+ Literal log ; String 1 ; Map commit
149185
 return
150186
 }
151187
152188
 proc ::rcsparser::Text {} {
153189
 upvar 1 data data res res
154190
 Literal text ; String 1
155191
 return
156192
 }
193
+
194
+# -----------------------------------------------------------------------------
157195
158196
 proc ::rcsparser::Ident {} {
159197
 upvar 1 data data res res
160198
161199
 #puts I@?<[string range $data 0 10]...>
@@ -213,11 +251,12 @@
213251
 return 1
214252
 }
215253
216254
 proc ::rcsparser::Skip {} {
217255
 upvar 1 data data res res
218
- regexp -indices -- {^\s*[^;]*\s*} $data match
256
+ regexp -indices -- {^\s*([^;]*)\s*} $data match val
257
+ Get $val
219258
 Next
220259
 return
221260
 }
222261
223262
 proc ::rcsparser::Def {key} {
@@ -230,11 +269,11 @@
230269
 proc ::rcsparser::Map {key} {
231270
 upvar 1 data data res res
232271
 lappend res($key) $res(id) $res(lastval)
233272
 #puts Map($res(id))=($res(lastval))
234273
 unset res(lastval)
235
- unset res(id)
274
+ #unset res(id);#Keep id for additional mappings.
236275
 return
237276
 }
238277
239278
 proc ::rcsparser::IsIdent {} {
240279
 upvar 1 data data res res
@@ -250,16 +289,33 @@
250289
 #puts G|$res(lastval)
251290
 return
252291
 }
253292
254293
 proc ::rcsparser::Next {} {
255
- upvar 1 match match data data
294
+ upvar 1 match match data data res res
256295
 foreach {s e} $match break ; incr e
257296
 set data [string range $data $e end]
297
+ set res(done) [expr {$res(size) - [string length $data]}]
298
+
299
+ Feedback "\r [format "%$res(nsize)s" $res(done)]/$res(size) "
300
+ return
301
+}
302
+
303
+# -----------------------------------------------------------------------------
304
+
305
+namespace eval ::rcsparser {
306
+ variable lc ::rcs::Nop
307
+}
308
+
309
+proc ::rcsparser::Feedback {text} {
310
+ variable lc
311
+ uplevel #0 [linsert $lc end info $text]
258312
 return
259313
 }
314
+
315
+proc ::rcsparser::Nop {args} {}
260316
261317
 # -----------------------------------------------------------------------------
262318
 # Ready
263319
264320
 package provide rcsparser 1.0
265321
 return
266322
--- tools/lib/rcsparser.tcl
+++ tools/lib/rcsparser.tcl
@@ -11,18 +11,49 @@
11
12 namespace eval ::rcsparser {}
13
14 # -----------------------------------------------------------------------------
15 # API
 
 
 
 
 
16
17 proc ::rcsparser::process {path} {
18 set data [fileutil::cat -encoding binary $path]
19 array set res {}
 
 
 
 
20 Admin
21 Deltas
22 Description
23 DeltaTexts
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
24 return [array get res]
25 }
26
27 # -----------------------------------------------------------------------------
28 # Internal helper commands
@@ -33,11 +64,11 @@
33 return
34 }
35
36 proc ::rcsparser::Deltas {} {
37 upvar 1 data data res res
38 while {[Num 0]} { Date ; Author ; State ; Branches ; NextRev }
39 return
40 }
41
42 proc ::rcsparser::Description {} {
43 upvar 1 data data res res
@@ -47,11 +78,11 @@
47 return
48 }
49
50 proc ::rcsparser::DeltaTexts {} {
51 upvar 1 data data res res
52 while {[Num 0]} { Log ; Text }
53 return
54 }
55
56 proc ::rcsparser::Head {} {
57 upvar 1 data data res res
@@ -114,22 +145,27 @@
114 }
115
116 proc ::rcsparser::Date {} {
117 upvar 1 data data res res
118 Literal date ; Num 1 ; Literal \;
 
 
 
 
 
119 return
120 }
121
122 proc ::rcsparser::Author {} {
123 upvar 1 data data res res
124 Literal author ; Skip ; Literal \;
125 return
126 }
127
128 proc ::rcsparser::State {} {
129 upvar 1 data data res res
130 Literal state ; Skip ; Literal \;
131 return
132 }
133
134 proc ::rcsparser::Branches {} {
135 upvar 1 data data res res
@@ -137,25 +173,27 @@
137 return
138 }
139
140 proc ::rcsparser::NextRev {} {
141 upvar 1 data data res res
142 Literal next ; Skip ; Literal \;
143 return
144 }
145
146 proc ::rcsparser::Log {} {
147 upvar 1 data data res res
148 IsIdent ; Literal log ; String 1 ; Map commit
149 return
150 }
151
152 proc ::rcsparser::Text {} {
153 upvar 1 data data res res
154 Literal text ; String 1
155 return
156 }
 
 
157
158 proc ::rcsparser::Ident {} {
159 upvar 1 data data res res
160
161 #puts I@?<[string range $data 0 10]...>
@@ -213,11 +251,12 @@
213 return 1
214 }
215
216 proc ::rcsparser::Skip {} {
217 upvar 1 data data res res
218 regexp -indices -- {^\s*[^;]*\s*} $data match
 
219 Next
220 return
221 }
222
223 proc ::rcsparser::Def {key} {
@@ -230,11 +269,11 @@
230 proc ::rcsparser::Map {key} {
231 upvar 1 data data res res
232 lappend res($key) $res(id) $res(lastval)
233 #puts Map($res(id))=($res(lastval))
234 unset res(lastval)
235 unset res(id)
236 return
237 }
238
239 proc ::rcsparser::IsIdent {} {
240 upvar 1 data data res res
@@ -250,16 +289,33 @@
250 #puts G|$res(lastval)
251 return
252 }
253
254 proc ::rcsparser::Next {} {
255 upvar 1 match match data data
256 foreach {s e} $match break ; incr e
257 set data [string range $data $e end]
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
258 return
259 }
 
 
260
261 # -----------------------------------------------------------------------------
262 # Ready
263
264 package provide rcsparser 1.0
265 return
266
--- tools/lib/rcsparser.tcl
+++ tools/lib/rcsparser.tcl
@@ -11,18 +11,49 @@
11
12 namespace eval ::rcsparser {}
13
14 # -----------------------------------------------------------------------------
15 # API
16
17 proc ::rcsparser::feedback {logcmd} {
18 variable lc $logcmd
19 return
20 }
21
22 proc ::rcsparser::process {path} {
23 set data [fileutil::cat -encoding binary $path]
24 array set res {}
25 set res(size) [file size $path]
26 set res(done) 0
27 set res(nsize) [string length $res(size)]
28
29 Admin
30 Deltas
31 Description
32 DeltaTexts
33
34 Feedback \r
35
36 # Remove parser state
37 catch {unset res(id)}
38 catch {unset res(lastval)}
39 unset res(size)
40 unset res(nsize)
41 unset res(done)
42
43 # res: 'head' -> head revision
44 # 'branch' -> ?
45 # 'symbol' -> (sym -> revision)
46 # 'lock' -> (sym -> revision)
47 # 'comment' -> file comment
48 # 'expand' -> ?
49 # 'date' -> (revision -> date)
50 # 'author' -> (revision -> author)
51 # 'state' -> (revision -> state)
52 # 'parent' -> (revision -> parent revision)
53 # 'commit' -> (revision -> commit message)
54
55 return [array get res]
56 }
57
58 # -----------------------------------------------------------------------------
59 # Internal helper commands
@@ -33,11 +64,11 @@
64 return
65 }
66
67 proc ::rcsparser::Deltas {} {
68 upvar 1 data data res res
69 while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
70 return
71 }
72
73 proc ::rcsparser::Description {} {
74 upvar 1 data data res res
@@ -47,11 +78,11 @@
78 return
79 }
80
81 proc ::rcsparser::DeltaTexts {} {
82 upvar 1 data data res res
83 while {[Num 0]} { IsIdent ; Log ; Text }
84 return
85 }
86
87 proc ::rcsparser::Head {} {
88 upvar 1 data data res res
@@ -114,22 +145,27 @@
145 }
146
147 proc ::rcsparser::Date {} {
148 upvar 1 data data res res
149 Literal date ; Num 1 ; Literal \;
150
151 foreach {yr mo dy h m s} [split $res(lastval) .] break
152 if {$yr < 100} {incr yr 1900}
153 set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
154 Map date
155 return
156 }
157
158 proc ::rcsparser::Author {} {
159 upvar 1 data data res res
160 Literal author ; Skip ; Literal \; ; Map author
161 return
162 }
163
164 proc ::rcsparser::State {} {
165 upvar 1 data data res res
166 Literal state ; Skip ; Literal \; ; Map state
167 return
168 }
169
170 proc ::rcsparser::Branches {} {
171 upvar 1 data data res res
@@ -137,25 +173,27 @@
173 return
174 }
175
176 proc ::rcsparser::NextRev {} {
177 upvar 1 data data res res
178 Literal next ; Skip ; Literal \; ; Map parent
179 return
180 }
181
182 proc ::rcsparser::Log {} {
183 upvar 1 data data res res
184 Literal log ; String 1 ; Map commit
185 return
186 }
187
188 proc ::rcsparser::Text {} {
189 upvar 1 data data res res
190 Literal text ; String 1
191 return
192 }
193
194 # -----------------------------------------------------------------------------
195
196 proc ::rcsparser::Ident {} {
197 upvar 1 data data res res
198
199 #puts I@?<[string range $data 0 10]...>
@@ -213,11 +251,12 @@
251 return 1
252 }
253
254 proc ::rcsparser::Skip {} {
255 upvar 1 data data res res
256 regexp -indices -- {^\s*([^;]*)\s*} $data match val
257 Get $val
258 Next
259 return
260 }
261
262 proc ::rcsparser::Def {key} {
@@ -230,11 +269,11 @@
269 proc ::rcsparser::Map {key} {
270 upvar 1 data data res res
271 lappend res($key) $res(id) $res(lastval)
272 #puts Map($res(id))=($res(lastval))
273 unset res(lastval)
274 #unset res(id);#Keep id for additional mappings.
275 return
276 }
277
278 proc ::rcsparser::IsIdent {} {
279 upvar 1 data data res res
@@ -250,16 +289,33 @@
289 #puts G|$res(lastval)
290 return
291 }
292
293 proc ::rcsparser::Next {} {
294 upvar 1 match match data data res res
295 foreach {s e} $match break ; incr e
296 set data [string range $data $e end]
297 set res(done) [expr {$res(size) - [string length $data]}]
298
299 Feedback "\r [format "%$res(nsize)s" $res(done)]/$res(size) "
300 return
301 }
302
303 # -----------------------------------------------------------------------------
304
305 namespace eval ::rcsparser {
306 variable lc ::rcs::Nop
307 }
308
309 proc ::rcsparser::Feedback {text} {
310 variable lc
311 uplevel #0 [linsert $lc end info $text]
312 return
313 }
314
315 proc ::rcsparser::Nop {args} {}
316
317 # -----------------------------------------------------------------------------
318 # Ready
319
320 package provide rcsparser 1.0
321 return
322

Keyboard Shortcuts

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