|
1
|
## -*- tcl -*- |
|
2
|
# # ## ### ##### ######## ############# ##################### |
|
3
|
## Copyright (c) 2007-2008 Andreas Kupries. |
|
4
|
# |
|
5
|
# This software is licensed as described in the file LICENSE, which |
|
6
|
# you should have received as part of this distribution. |
|
7
|
# |
|
8
|
# This software consists of voluntary contributions made by many |
|
9
|
# individuals. For exact contribution history, see the revision |
|
10
|
# history and logs, available at http://fossil-scm.hwaci.com/fossil |
|
11
|
# # ## ### ##### ######## ############# ##################### |
|
12
|
|
|
13
|
## File, part of a project, part of a CVS repository. Multiple |
|
14
|
## instances are possible. |
|
15
|
|
|
16
|
# # ## ### ##### ######## ############# ##################### |
|
17
|
## Requirements |
|
18
|
|
|
19
|
package require Tcl 8.4 ; # Required runtime. |
|
20
|
package require snit ; # OO system. |
|
21
|
package require struct::set ; # Set operations. |
|
22
|
package require struct::list ; # Higher order operations. |
|
23
|
package require vc::fossil::import::cvs::blobstore ; # Blob storage. |
|
24
|
package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. |
|
25
|
package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols. |
|
26
|
package require vc::fossil::import::cvs::state ; # State storage. |
|
27
|
package require vc::fossil::import::cvs::integrity ; # State integrity checks. |
|
28
|
package require vc::fossil::import::cvs::gtcore ; # Graph traversal core. |
|
29
|
package require vc::tools::trouble ; # Error reporting. |
|
30
|
package require vc::tools::log ; # User feedback |
|
31
|
package require vc::tools::misc ; # Text formatting |
|
32
|
|
|
33
|
# # ## ### ##### ######## ############# ##################### |
|
34
|
## |
|
35
|
|
|
36
|
snit::type ::vc::fossil::import::cvs::file { |
|
37
|
# # ## ### ##### ######## ############# |
|
38
|
## Public API |
|
39
|
|
|
40
|
constructor {id path usrpath executable project} { |
|
41
|
set myid $id |
|
42
|
set mypath $path |
|
43
|
set myusrpath $usrpath |
|
44
|
set myexecutable $executable |
|
45
|
set myproject $project |
|
46
|
set mytrunk [$myproject trunk] |
|
47
|
set myblob [blobstore ${selfns}::%AUTO% $id] |
|
48
|
return |
|
49
|
} |
|
50
|
|
|
51
|
method setid {id} { |
|
52
|
integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'} |
|
53
|
set myid $id |
|
54
|
$myblob setid $id |
|
55
|
return |
|
56
|
} |
|
57
|
|
|
58
|
method id {} { return $myid } |
|
59
|
method path {} { return $mypath } |
|
60
|
method usrpath {} { return $myusrpath } |
|
61
|
method project {} { return $myproject } |
|
62
|
|
|
63
|
delegate method commitmessageof to myproject |
|
64
|
|
|
65
|
# # ## ### ##### ######## ############# |
|
66
|
## Methods required for the class to be a sink of the rcs parser |
|
67
|
|
|
68
|
#method begin {} {puts begin} |
|
69
|
#method sethead {h} {puts head=$h} |
|
70
|
#method setprincipalbranch {b} {puts pb=$b} |
|
71
|
#method deftag {s r} {puts $s=$r} |
|
72
|
#method setcomment {c} {puts comment=$c} |
|
73
|
#method admindone {} {puts admindone} |
|
74
|
#method def {rev date author state next branches} {puts "def $rev $date $author $state $next $branches"} |
|
75
|
#method defdone {} {puts def-done} |
|
76
|
#method setdesc {d} {puts desc=$d} |
|
77
|
#method extend {rev commitmsg deltarange} {puts "extend $commitmsg $deltarange"} |
|
78
|
#method done {} {puts done} |
|
79
|
|
|
80
|
# # ## ### ##### ######## ############# |
|
81
|
## Persistence (pass II) |
|
82
|
|
|
83
|
method persist {} { |
|
84
|
# First collect the reachable revisions and symbols, then |
|
85
|
# assign id's to all. They are sorted so that we will have ids |
|
86
|
# which sort in order of creation. Then we can save them. This |
|
87
|
# is done bottom up. Revisions, then symbols. __NOTE__ This |
|
88
|
# works only because sqlite is not checking foreign key |
|
89
|
# references during insert. This allows to have dangling |
|
90
|
# references which are fixed later. The longest dangling |
|
91
|
# references are for the project level symbols, these we do |
|
92
|
# not save here, but at the end of the pass. What we need are |
|
93
|
# the ids, hence the two phases. |
|
94
|
|
|
95
|
struct::list assign [$self Active] revisions symbols |
|
96
|
foreach rev $revisions { $rev defid } |
|
97
|
foreach sym $symbols { $sym defid } |
|
98
|
|
|
99
|
state transaction { |
|
100
|
foreach rev $revisions { $rev persist } |
|
101
|
foreach sym $symbols { $sym persist } |
|
102
|
$myblob persist |
|
103
|
} |
|
104
|
return |
|
105
|
} |
|
106
|
|
|
107
|
method drop {} { |
|
108
|
foreach {_ rev} [array get myrev] { $rev destroy } |
|
109
|
foreach {_ branch} [array get mybranches] { $branch destroy } |
|
110
|
foreach {_ taglist} [array get mytags] { |
|
111
|
foreach tag $taglist { $tag destroy } |
|
112
|
} |
|
113
|
return |
|
114
|
} |
|
115
|
|
|
116
|
# # ## ### ##### ######## ############# |
|
117
|
## Implement the sink |
|
118
|
|
|
119
|
method begin {} {#ignore} |
|
120
|
|
|
121
|
method sethead {revnr} { |
|
122
|
set myheadrevnr $revnr |
|
123
|
return |
|
124
|
} |
|
125
|
|
|
126
|
method setprincipalbranch {branchnr} { |
|
127
|
set myprincipal $branchnr |
|
128
|
return |
|
129
|
} |
|
130
|
|
|
131
|
method deftag {name revnr} { |
|
132
|
# FUTURE: Perform symbol transformation here. |
|
133
|
|
|
134
|
if {[struct::set contains $mysymbols $name]} { |
|
135
|
trouble fatal "Multiple definitions of the symbol '$name' in '$mypath'" |
|
136
|
return |
|
137
|
} |
|
138
|
|
|
139
|
struct::set add mysymbols $name |
|
140
|
|
|
141
|
if {[rev isbranchrevnr $revnr -> branchnr]} { |
|
142
|
$self AddBranch $name $branchnr |
|
143
|
} else { |
|
144
|
$self AddTag $name $revnr |
|
145
|
} |
|
146
|
return |
|
147
|
} |
|
148
|
|
|
149
|
method setcomment {c} {# ignore} |
|
150
|
|
|
151
|
method admindone {} { |
|
152
|
# We do nothing at the boundary of admin and revision data |
|
153
|
} |
|
154
|
|
|
155
|
method def {revnr date author state next branches} { |
|
156
|
$self RecordBranchCommits $branches |
|
157
|
|
|
158
|
if {[info exists myrev($revnr)]} { |
|
159
|
trouble fatal "File $mypath contains duplicate definitions for revision $revnr." |
|
160
|
return |
|
161
|
} |
|
162
|
|
|
163
|
set myaid($revnr) [$myproject defauthor $author] |
|
164
|
set myrev($revnr) [rev %AUTO% $revnr $date $state $self] |
|
165
|
|
|
166
|
$myblob add $revnr $myrev($revnr) |
|
167
|
|
|
168
|
if {$next ne ""} { |
|
169
|
# parent revision NEXT is a delta of current. |
|
170
|
$myblob delta $next $revnr |
|
171
|
} |
|
172
|
foreach b $branches { |
|
173
|
# branch child revision B is a delta of current. |
|
174
|
$myblob delta $b $revnr |
|
175
|
} |
|
176
|
|
|
177
|
$self RecordBasicDependencies $revnr $next |
|
178
|
return |
|
179
|
} |
|
180
|
|
|
181
|
method defdone {} { |
|
182
|
# This is all done after the revision tree has been extracted |
|
183
|
# from the file, before the commit mesages and delta texts are |
|
184
|
# processed. |
|
185
|
|
|
186
|
$self ProcessPrimaryDependencies |
|
187
|
$self ProcessBranchDependencies |
|
188
|
$self SortBranches |
|
189
|
$self ProcessTagDependencies |
|
190
|
$self DetermineTheRootRevision |
|
191
|
return |
|
192
|
} |
|
193
|
|
|
194
|
method setdesc {d} {# ignore} |
|
195
|
|
|
196
|
method extend {revnr commitmsg textrange} { |
|
197
|
set cmid [$myproject defcmessage [string trim $commitmsg]] |
|
198
|
|
|
199
|
set rev $myrev($revnr) |
|
200
|
|
|
201
|
if {[$rev hasmeta]} { |
|
202
|
# Apparently repositories exist in which the delta data |
|
203
|
# for revision 1.1 is provided several times, at least |
|
204
|
# twice. The actual cause of this duplication is not |
|
205
|
# known. Speculation centers on RCS/CVS bugs, or from |
|
206
|
# manual edits of the repository which borked the |
|
207
|
# internals. Whatever the cause, testing showed that both |
|
208
|
# cvs and rcs use the first definition when performing a |
|
209
|
# checkout, and we follow their lead. Side notes: 'cvs |
|
210
|
# log' fails on such a file, and 'cvs rlog' prints the log |
|
211
|
# message from the first delta, ignoring the second. |
|
212
|
|
|
213
|
log write 1 file "In file $mypath : Duplicate delta data for revision $revnr" |
|
214
|
log write 1 file "Ignoring the duplicate" |
|
215
|
return |
|
216
|
} |
|
217
|
|
|
218
|
# Determine the line of development for the revision (project |
|
219
|
# level). This gives us the branchid too, required for the |
|
220
|
# meta data group the revision is in. (Note: By putting both |
|
221
|
# branch/lod and project information into the group we ensure |
|
222
|
# that any cross-project and cross-branch commits are |
|
223
|
# separated into multiple commits, one in each of the projects |
|
224
|
# and/or branches). |
|
225
|
|
|
226
|
set lod [$self GetLOD $revnr] |
|
227
|
|
|
228
|
$rev setmeta [$myproject defmeta [$lod id] $myaid($revnr) $cmid] |
|
229
|
# Note: We keep settext on file::rev for the hastext queries |
|
230
|
# used by several checks. |
|
231
|
$rev settext $textrange |
|
232
|
$rev setlod $lod |
|
233
|
|
|
234
|
$myblob extend $revnr $textrange |
|
235
|
|
|
236
|
# If this is revision 1.1, we have to determine whether the |
|
237
|
# file seems to have been created through 'cvs add' instead of |
|
238
|
# 'cvs import'. This can be done by looking at the un- |
|
239
|
# adulterated commit message, as CVS uses a hardwired magic |
|
240
|
# message for the latter, i.e. "Initial revision\n", no |
|
241
|
# period. (This fact also helps us when the time comes to |
|
242
|
# determine whether this file might have had a default branch |
|
243
|
# in the past.) |
|
244
|
|
|
245
|
if {$revnr eq "1.1"} { |
|
246
|
set myimported [expr {$commitmsg eq "Initial revision\n"}] |
|
247
|
} |
|
248
|
|
|
249
|
# Here we also keep track of the order in which the revisions |
|
250
|
# were added to the file. |
|
251
|
|
|
252
|
lappend myrevisions $rev |
|
253
|
return |
|
254
|
} |
|
255
|
|
|
256
|
method done {} { |
|
257
|
# Complete the revisions, branches, and tags. This includes |
|
258
|
# looking for a non-trunk default branch, marking its members |
|
259
|
# and linking them into the trunk, possibly excluding |
|
260
|
# non-trunk data, and collecting aggregate symbol statistics. |
|
261
|
|
|
262
|
$self DetermineRevisionOperations |
|
263
|
$self DetermineLinesOfDevelopment |
|
264
|
$self HandleNonTrunkDefaultBranch |
|
265
|
$self RemoveIrrelevantDeletions |
|
266
|
$self RemoveInitialBranchDeletions |
|
267
|
|
|
268
|
if {[$myproject trunkonly]} { |
|
269
|
$self ExcludeNonTrunkInformation |
|
270
|
} |
|
271
|
|
|
272
|
$self AggregateSymbolData |
|
273
|
return |
|
274
|
} |
|
275
|
|
|
276
|
# # ## ### ##### ######## ############# |
|
277
|
## Pass XII (Import). |
|
278
|
|
|
279
|
method pushto {repository} { |
|
280
|
log write 2 file {Importing file "$mypath"} |
|
281
|
|
|
282
|
set ws [$repository workspace] |
|
283
|
struct::list assign [$self Expand $ws] filemap revmap |
|
284
|
# filemap = dict (path -> uuid) |
|
285
|
# revmap = dict (path -> rid) |
|
286
|
|
|
287
|
array set idmap [$repository importfiles $filemap] |
|
288
|
|
|
289
|
# Wipe workspace clean of the imported files. |
|
290
|
foreach x [glob -directory $ws r*] { ::file delete $x } |
|
291
|
|
|
292
|
foreach {path rid} $revmap { |
|
293
|
set uuid $idmap($path) |
|
294
|
state run { |
|
295
|
INSERT INTO revuuid (rid, uuid) |
|
296
|
VALUES ($rid, $uuid) |
|
297
|
} |
|
298
|
} |
|
299
|
return |
|
300
|
} |
|
301
|
|
|
302
|
method Expand {dir} { |
|
303
|
set ex [struct::graph ex] ; # Expansion graph. |
|
304
|
set zp [struct::graph zp] ; # Zip/Import graph. |
|
305
|
|
|
306
|
close [open $dir/r__empty__ w];# Base for detached roots on branches. |
|
307
|
|
|
308
|
# Phase I: Pull blobs and referenced revisions from the state |
|
309
|
# and fill the graphs with them... |
|
310
|
|
|
311
|
# Note: We use the blobs for expansion because we need them |
|
312
|
# all, even those without revision, for both proper |
|
313
|
# ordering and exact patch application. |
|
314
|
|
|
315
|
set earcs {} ; # Arcs for expansion graph |
|
316
|
set zarcs {} ; # Arcs for zip graph |
|
317
|
set revmap {} ; # path -> rid map to later merge uuid information |
|
318
|
|
|
319
|
state foreachrow { |
|
320
|
SELECT B.rid AS xrid, |
|
321
|
R.rev AS revnr, |
|
322
|
R.child AS xchild, |
|
323
|
B.coff AS xcoff, |
|
324
|
B.clen AS xclen, |
|
325
|
B.bid AS cid, |
|
326
|
B.pid AS cparent |
|
327
|
FROM blob B |
|
328
|
LEFT OUTER JOIN revision R |
|
329
|
ON B.rid = R.rid |
|
330
|
WHERE B.fid = $myid |
|
331
|
} { |
|
332
|
# Main data are blobs, most will have revisions, but not |
|
333
|
# all. The expansion graph is blob based, whereas the |
|
334
|
# recompression graph is revision based. |
|
335
|
|
|
336
|
if {$revnr ne ""} { |
|
337
|
# Blob has revision, extend recompression graph. |
|
338
|
|
|
339
|
lappend revmap r$revnr $xrid |
|
340
|
|
|
341
|
$zp node insert $xrid |
|
342
|
$zp node set $xrid revnr $revnr |
|
343
|
$zp node set $xrid label <$revnr> |
|
344
|
|
|
345
|
if {$xchild ne ""} { |
|
346
|
lappend zarcs $xchild $xrid |
|
347
|
} |
|
348
|
} else { |
|
349
|
# We fake a revnr for the blobs which have no |
|
350
|
# revision, for use in the expansion graph. |
|
351
|
set revnr ghost$cid |
|
352
|
} |
|
353
|
|
|
354
|
# Now the expansion graph. |
|
355
|
|
|
356
|
$ex node insert $cid |
|
357
|
$ex node set $cid text [list $xcoff $xclen] |
|
358
|
$ex node set $cid revnr $revnr |
|
359
|
$ex node set $cid label <$revnr> |
|
360
|
|
|
361
|
if {$cparent ne ""} { |
|
362
|
# The expansion arcs go from baseline to delta |
|
363
|
# descendant, based on the blob information. |
|
364
|
lappend earcs $cparent $cid |
|
365
|
} |
|
366
|
} |
|
367
|
|
|
368
|
# Phase II: Insert the accumulated dependencies |
|
369
|
|
|
370
|
foreach {from to} $earcs { $ex arc insert $from $to } |
|
371
|
foreach {from to} $zarcs { $zp arc insert $from $to } |
|
372
|
|
|
373
|
# Phase III: Traverse the graphs, expand the file, and |
|
374
|
# generate import instructions. |
|
375
|
|
|
376
|
set archive [::file join [$myproject fullpath] $mypath] |
|
377
|
set ac [open $archive r] |
|
378
|
fconfigure $ac -translation binary |
|
379
|
|
|
380
|
# First traverse the expansion graph, this gives us the |
|
381
|
# revisions in the order we have to expand them, which we do. |
|
382
|
|
|
383
|
set max [llength [$ex nodes]] |
|
384
|
set myimport 0 |
|
385
|
|
|
386
|
gtcore datacmd [mymethod ExpandData] |
|
387
|
gtcore formatcmd [mymethod ExpandFormat] |
|
388
|
gtcore sortcmd [mymethod ExpandSort] |
|
389
|
gtcore savecmd [mymethod Expand1 $ac $dir $max] |
|
390
|
|
|
391
|
gtcore traverse $ex {Expanding revisions...} |
|
392
|
close $ac |
|
393
|
|
|
394
|
# Now traverse the import graph, this builds the instruction |
|
395
|
# map for the fossil deltas. |
|
396
|
|
|
397
|
gtcore datacmd [mymethod ExpandData] |
|
398
|
gtcore formatcmd [mymethod ExpandFormat] |
|
399
|
gtcore sortcmd [mymethod ExpandSort] |
|
400
|
gtcore savecmd [mymethod Expand2] |
|
401
|
|
|
402
|
set myimport {} |
|
403
|
gtcore traverse $zp {Generating revision order for import...} |
|
404
|
set filemap $myimport |
|
405
|
unset myimport |
|
406
|
|
|
407
|
# And back to import control |
|
408
|
|
|
409
|
$ex destroy |
|
410
|
$zp destroy |
|
411
|
|
|
412
|
return [list $filemap $revmap] |
|
413
|
} |
|
414
|
|
|
415
|
method ExpandData {graph node} { return [$graph node get $node revnr] } |
|
416
|
method ExpandFormat {graph item} { return <[lindex $item 1]> } ; # revnr |
|
417
|
method ExpandSort {graph candidates} { |
|
418
|
# candidates = list(item), item = list(node revnr) |
|
419
|
# Sort by node and revnr -> Trunk revisions come first. |
|
420
|
return [lsort -index 1 -dict [lsort -index 0 -dict $candidates]] |
|
421
|
} |
|
422
|
method Expand1 {chan dir max graph node} { |
|
423
|
log progress 3 file $myimport $max ; incr myimport |
|
424
|
|
|
425
|
set revnr [$graph node get $node revnr] |
|
426
|
set fname r$revnr |
|
427
|
struct::list assign [$graph node get $node text] offset length |
|
428
|
|
|
429
|
if {$length < 0} { |
|
430
|
set data "" |
|
431
|
} else { |
|
432
|
seek $chan $offset start |
|
433
|
set data [string map {@@ @} [read $chan $length]] |
|
434
|
} |
|
435
|
|
|
436
|
if {![$graph node keyexists $node __base__]} { |
|
437
|
# Full text node. Get the data, decode it, and save. |
|
438
|
|
|
439
|
log write 8 file {Expanding <$revnr>, full text} |
|
440
|
|
|
441
|
fileutil::writeFile -translation binary $dir/$fname $data |
|
442
|
} else { |
|
443
|
# Delta node. __base__ is the name of the file containing |
|
444
|
# the baseline. The patch is at the specified location of |
|
445
|
# the archive file. |
|
446
|
|
|
447
|
set fbase [$graph node get $node __base__] |
|
448
|
log write 8 file {Expanding <$revnr>, is delta of <$fbase>} |
|
449
|
|
|
450
|
set base [fileutil::cat -translation binary $dir/$fbase] |
|
451
|
|
|
452
|
# Writing the patch to disk is just for better |
|
453
|
# debugging. It is not used otherwise. |
|
454
|
fileutil::writeFile $dir/rpatch $data |
|
455
|
fileutil::writeFile -translation binary $dir/$fname \ |
|
456
|
[Apply $base $data] |
|
457
|
} |
|
458
|
|
|
459
|
# Post to all successors that the just generated file is their |
|
460
|
# baseline. |
|
461
|
|
|
462
|
foreach out [$graph nodes -out $node] { |
|
463
|
$graph node set $out __base__ $fname |
|
464
|
} |
|
465
|
return |
|
466
|
} |
|
467
|
|
|
468
|
proc Apply {base delta} { |
|
469
|
# base = base text. |
|
470
|
# delta = delta in rcs format. |
|
471
|
# |
|
472
|
# Both strings are unencoded, i.e. things like @@, etc. have |
|
473
|
# already been replaced with their proper characters. |
|
474
|
# |
|
475
|
# Return value is the patched text. |
|
476
|
|
|
477
|
set base [split $base \n] |
|
478
|
set blen [llength $base] |
|
479
|
set ooff 0 |
|
480
|
set res "" |
|
481
|
|
|
482
|
set lines [split $delta \n] |
|
483
|
set nlines [llength $lines] |
|
484
|
|
|
485
|
log write 11 file {Base lines = $blen} |
|
486
|
log write 11 file {Delta lines = $nlines} |
|
487
|
|
|
488
|
for {set i 0} {$i < $nlines} {} { |
|
489
|
log write 11 file { @ $i = [lindex $lines $i]} |
|
490
|
log write 11 file { ooff $ooff} |
|
491
|
|
|
492
|
if {![regexp {^([ad])(\d+)\s(\d+)$} [lindex $lines $i] -> cmd sl cn]} { |
|
493
|
trouble internal "Bad ed command '[lindex $lines $i]'" |
|
494
|
} |
|
495
|
|
|
496
|
log write 11 file { cmd $cmd} |
|
497
|
log write 11 file { sl $sl} |
|
498
|
log write 11 file { cn $cn} |
|
499
|
|
|
500
|
incr i |
|
501
|
set el [expr {$sl + $cn}] |
|
502
|
|
|
503
|
log write 11 file { el $el} |
|
504
|
|
|
505
|
switch -exact -- $cmd { |
|
506
|
d { |
|
507
|
incr sl -1 |
|
508
|
incr el -1 |
|
509
|
if {$sl < $ooff} { trouble internal {Deletion before last edit} } |
|
510
|
if {$sl > $blen} { trouble internal {Deletion past file end} } |
|
511
|
if {$el > $blen} { trouble internal {Deletion beyond file end} } |
|
512
|
foreach x [lrange $base $ooff [expr {$sl - 1}]] { |
|
513
|
log write 15 file {.|$x|} |
|
514
|
lappend res $x |
|
515
|
} |
|
516
|
set ooff $el |
|
517
|
} |
|
518
|
a { |
|
519
|
if {$sl < $ooff} { trouble internal {Insert before last edit} } |
|
520
|
if {$sl > $blen} { trouble internal {Insert past file end} } |
|
521
|
|
|
522
|
foreach x [lrange $base $ooff [expr {$sl - 1}]] { |
|
523
|
log write 15 file {.|$x|} |
|
524
|
lappend res $x |
|
525
|
} |
|
526
|
foreach x [lrange $lines $i [expr {$i + $cn - 1}]] { |
|
527
|
log write 15 file {+|$x|} |
|
528
|
lappend res $x |
|
529
|
} |
|
530
|
set ooff $sl |
|
531
|
incr i $cn |
|
532
|
} |
|
533
|
} |
|
534
|
} |
|
535
|
foreach x [lrange $base $ooff end] { lappend res $x } |
|
536
|
return [join $res \n] |
|
537
|
} |
|
538
|
|
|
539
|
method Expand2 {graph node} { |
|
540
|
set revnr [$graph node get $node revnr] |
|
541
|
|
|
542
|
# First import the file. |
|
543
|
lappend myimport [list A r$revnr {}] |
|
544
|
|
|
545
|
if {[$graph node keyexists $node __base__]} { |
|
546
|
# Delta node. __base__ is the name of the file containing |
|
547
|
# the baseline. Generate instruction to make the delta as |
|
548
|
# well. |
|
549
|
|
|
550
|
set fbase [$graph node get $node __base__] |
|
551
|
lappend myimport [list D r$revnr r$fbase] |
|
552
|
} |
|
553
|
|
|
554
|
# Post to all successors that the just generated file is their |
|
555
|
# baseline. Exception: Those which ave already a baseline set. |
|
556
|
# Together with the sorting of trunk revisions first the trunk |
|
557
|
# should one uninterupted line, with branch roots _not_ delta |
|
558
|
# compressed per their branches. |
|
559
|
|
|
560
|
foreach out [$graph nodes -out $node] { |
|
561
|
if {[$graph node keyexists $out __base__]} continue |
|
562
|
$graph node set $out __base__ $revnr |
|
563
|
} |
|
564
|
return |
|
565
|
} |
|
566
|
|
|
567
|
variable myimport |
|
568
|
|
|
569
|
# # ## ### ##### ######## ############# |
|
570
|
## State |
|
571
|
|
|
572
|
variable myid {} ; # File id in the persistent state. |
|
573
|
variable mypath {} ; # Path of the file's rcs archive. |
|
574
|
variable myusrpath {} ; # Path of the file as seen by users. |
|
575
|
variable myexecutable 0 ; # Boolean flag 'file executable'. |
|
576
|
variable myproject {} ; # Reference to the project object |
|
577
|
# the file belongs to. |
|
578
|
variable myrev -array {} ; # Maps revision number to the |
|
579
|
# associated revision object. |
|
580
|
variable myrevisions {} ; # Same as myrev, but a list, |
|
581
|
# giving us the order of |
|
582
|
# revisions. |
|
583
|
variable myaid -array {} ; # Map revision numbers to the id |
|
584
|
# of the author who committed |
|
585
|
# it. This is later aggregated |
|
586
|
# with commit message, branch name |
|
587
|
# and project id for a meta id. |
|
588
|
variable myheadrevnr {} ; # Head revision (revision number) |
|
589
|
variable myprincipal {} ; # Principal branch (branch number). |
|
590
|
# Contrary to the name this is the |
|
591
|
# default branch. |
|
592
|
variable mydependencies {} ; # Dictionary parent -> child, |
|
593
|
# records primary dependencies. |
|
594
|
variable myimported 0 ; # Boolean flag. Set if and only if |
|
595
|
# rev 1.1 of the file seemingly |
|
596
|
# was imported instead of added |
|
597
|
# normally. |
|
598
|
variable myroot {} ; # Reference to the revision object |
|
599
|
# holding the root revision. Its |
|
600
|
# number usually is '1.1'. Can be |
|
601
|
# a different number, because of |
|
602
|
# gaps created via 'cvsadmin -o'. |
|
603
|
variable mybranches -array {} ; # Maps branch number to the symbol |
|
604
|
# object handling the branch. |
|
605
|
variable mytags -array {} ; # Maps revision number to the list |
|
606
|
# of symbol objects for the tags |
|
607
|
# associated with the revision. |
|
608
|
variable mysymbols {} ; # Set of the symbol names found in |
|
609
|
# this file. |
|
610
|
|
|
611
|
variable mybranchcnt 0 ; # Counter for branches, to record their |
|
612
|
# order of definition. This also defines |
|
613
|
# their order of creation, which is the |
|
614
|
# reverse of definition. I.e. a smaller |
|
615
|
# number means 'Defined earlier', means |
|
616
|
# 'Created later'. |
|
617
|
|
|
618
|
variable mytrunk {} ; # Direct reference to myproject -> trunk. |
|
619
|
variable myroots {} ; # List of roots in the forest of |
|
620
|
# lod's. Object references to revisions and |
|
621
|
# branches. The latter can appear when they |
|
622
|
# are severed from their parent. |
|
623
|
|
|
624
|
variable myblob {} ; # Reference to the object managing the blob |
|
625
|
# information (textrange of revisions, and |
|
626
|
# delta dependencies) of this file. |
|
627
|
|
|
628
|
# # ## ### ##### ######## ############# |
|
629
|
## Internal methods |
|
630
|
|
|
631
|
method RecordBranchCommits {branches} { |
|
632
|
foreach branchrevnr $branches { |
|
633
|
if {[catch { |
|
634
|
set branch [$self Rev2Branch $branchrevnr] |
|
635
|
}]} { |
|
636
|
set branch [$self AddUnlabeledBranch [rev 2branchnr $branchrevnr]] |
|
637
|
} |
|
638
|
|
|
639
|
# Record the commit, just as revision number for |
|
640
|
# now. ProcesBranchDependencies will extend that ito a |
|
641
|
# proper object reference. |
|
642
|
|
|
643
|
$branch setchildrevnr $branchrevnr |
|
644
|
} |
|
645
|
return |
|
646
|
} |
|
647
|
|
|
648
|
method Rev2Branch {revnr} { |
|
649
|
integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number} |
|
650
|
return $mybranches([rev 2branchnr $revnr]) |
|
651
|
} |
|
652
|
|
|
653
|
method AddUnlabeledBranch {branchnr} { |
|
654
|
return [$self AddBranch unlabeled-$branchnr $branchnr] |
|
655
|
} |
|
656
|
|
|
657
|
method AddBranch {name branchnr} { |
|
658
|
if {[info exists mybranches($branchnr)]} { |
|
659
|
log write 1 file "In '$mypath': Branch '$branchnr' named '[$mybranches($branchnr) name]'" |
|
660
|
log write 1 file "Cannot have second name '$name', ignoring it" |
|
661
|
return |
|
662
|
} |
|
663
|
set branch [sym %AUTO% branch $branchnr [$myproject getsymbol $name] $self] |
|
664
|
$branch setposition [incr mybranchcnt] |
|
665
|
set mybranches($branchnr) $branch |
|
666
|
return $branch |
|
667
|
} |
|
668
|
|
|
669
|
method AddTag {name revnr} { |
|
670
|
set tag [sym %AUTO% tag $revnr [$myproject getsymbol $name] $self] |
|
671
|
lappend mytags($revnr) $tag |
|
672
|
return $tag |
|
673
|
} |
|
674
|
|
|
675
|
method RecordBasicDependencies {revnr next} { |
|
676
|
# Handle the revision dependencies. Record them for now, do |
|
677
|
# nothing with them yet. |
|
678
|
|
|
679
|
# On the trunk the 'next' field points to the previous |
|
680
|
# revision, i.e. the _parent_ of the current one. Example: |
|
681
|
# 1.6's next is 1.5 (modulo cvs admin -o). |
|
682
|
|
|
683
|
# Contrarily on a branch the 'next' field points to the |
|
684
|
# primary _child_ of the current revision. As example, |
|
685
|
# 1.1.3.2's 'next' will be 1.1.3.3. |
|
686
|
|
|
687
|
# The 'next' field actually always refers to the revision |
|
688
|
# containing the delta needed to retrieve that revision. |
|
689
|
|
|
690
|
# The dependencies needed here are the logical structure, |
|
691
|
# parent/child, and not the implementation dependent delta |
|
692
|
# pointers. |
|
693
|
|
|
694
|
if {$next eq ""} return |
|
695
|
# parent -> child |
|
696
|
if {[rev istrunkrevnr $revnr]} { |
|
697
|
lappend mydependencies $next $revnr |
|
698
|
} else { |
|
699
|
lappend mydependencies $revnr $next |
|
700
|
} |
|
701
|
return |
|
702
|
} |
|
703
|
|
|
704
|
method ProcessPrimaryDependencies {} { |
|
705
|
foreach {parentrevnr childrevnr} $mydependencies { |
|
706
|
set parent $myrev($parentrevnr) |
|
707
|
set child $myrev($childrevnr) |
|
708
|
$parent setchild $child |
|
709
|
$child setparent $parent |
|
710
|
} |
|
711
|
return |
|
712
|
} |
|
713
|
|
|
714
|
method ProcessBranchDependencies {} { |
|
715
|
foreach {branchnr branch} [array get mybranches] { |
|
716
|
set revnr [$branch parentrevnr] |
|
717
|
|
|
718
|
if {![info exists myrev($revnr)]} { |
|
719
|
log write 1 file "In '$mypath': The branch '[$branch name]' references" |
|
720
|
log write 1 file "the bogus revision '$revnr' and will be ignored." |
|
721
|
$branch destroy |
|
722
|
unset mybranches($branchnr) |
|
723
|
} else { |
|
724
|
set rev $myrev($revnr) |
|
725
|
$rev addbranch $branch |
|
726
|
$branch setparent $rev |
|
727
|
|
|
728
|
# If revisions were committed on the branch we store a |
|
729
|
# reference to the branch there, and further declare |
|
730
|
# the first child's parent to be branch's parent, and |
|
731
|
# list this child in the parent revision. |
|
732
|
|
|
733
|
if {[$branch haschildrev]} { |
|
734
|
set childrevnr [$branch childrevnr] |
|
735
|
set child $myrev($childrevnr) |
|
736
|
$branch setchild $child |
|
737
|
|
|
738
|
$child setparentbranch $branch |
|
739
|
$child setparent $rev |
|
740
|
$rev addchildonbranch $child |
|
741
|
} |
|
742
|
} |
|
743
|
} |
|
744
|
return |
|
745
|
} |
|
746
|
|
|
747
|
method SortBranches {} { |
|
748
|
foreach {revnr rev} [array get myrev] { $rev sortbranches } |
|
749
|
return |
|
750
|
} |
|
751
|
|
|
752
|
method ProcessTagDependencies {} { |
|
753
|
foreach {revnr taglist} [array get mytags] { |
|
754
|
if {![info exists myrev($revnr)]} { |
|
755
|
set n [llength $taglist] |
|
756
|
log write 1 file "In '$mypath': The following [nsp $n tag] reference" |
|
757
|
log write 1 file "the bogus revision '$revnr' and will be ignored." |
|
758
|
foreach tag $taglist { |
|
759
|
log write 1 file " [$tag name]" |
|
760
|
$tag destroy |
|
761
|
} |
|
762
|
unset mytags($revnr) |
|
763
|
} else { |
|
764
|
set rev $myrev($revnr) |
|
765
|
foreach tag $taglist { |
|
766
|
$rev addtag $tag |
|
767
|
$tag settagrev $rev |
|
768
|
} |
|
769
|
} |
|
770
|
} |
|
771
|
return |
|
772
|
} |
|
773
|
|
|
774
|
method DetermineTheRootRevision {} { |
|
775
|
# The root is the one revision which has no parent. By |
|
776
|
# checking all revisions we ensure that we can detect and |
|
777
|
# report the case of multiple roots. Without that we could |
|
778
|
# simply take one revision and follow the parent links to |
|
779
|
# their root (sic!). |
|
780
|
|
|
781
|
foreach {revnr rev} [array get myrev] { |
|
782
|
if {[$rev hasparent]} continue |
|
783
|
integrity assert {$myroot eq ""} {Multiple root revisions found} |
|
784
|
set myroot $rev |
|
785
|
} |
|
786
|
|
|
787
|
# In the future we also need a list, as branches can become |
|
788
|
# severed from their parent, making them their own root. |
|
789
|
set myroots [list $myroot] |
|
790
|
return |
|
791
|
} |
|
792
|
|
|
793
|
method DetermineRevisionOperations {} { |
|
794
|
foreach rev $myrevisions { $rev determineoperation } |
|
795
|
return |
|
796
|
} |
|
797
|
|
|
798
|
method DetermineLinesOfDevelopment {} { |
|
799
|
# For revisions this has been done already, in 'extend'. Now |
|
800
|
# we do this for the branches and tags. |
|
801
|
|
|
802
|
foreach {_ branch} [array get mybranches] { |
|
803
|
$branch setlod [$self GetLOD [$branch parentrevnr]] |
|
804
|
} |
|
805
|
|
|
806
|
foreach {_ taglist} [array get mytags] { |
|
807
|
foreach tag $taglist { |
|
808
|
$tag setlod [$self GetLOD [$tag tagrevnr]] |
|
809
|
} |
|
810
|
} |
|
811
|
return |
|
812
|
} |
|
813
|
|
|
814
|
method GetLOD {revnr} { |
|
815
|
if {[rev istrunkrevnr $revnr]} { |
|
816
|
return $mytrunk |
|
817
|
} else { |
|
818
|
return [$self Rev2Branch $revnr] |
|
819
|
} |
|
820
|
} |
|
821
|
|
|
822
|
method HandleNonTrunkDefaultBranch {} { |
|
823
|
set revlist [$self NonTrunkDefaultRevisions] |
|
824
|
if {![llength $revlist]} return |
|
825
|
|
|
826
|
$self AdjustNonTrunkDefaultBranch $revlist |
|
827
|
$self CheckLODs |
|
828
|
return |
|
829
|
} |
|
830
|
|
|
831
|
method NonTrunkDefaultRevisions {} { |
|
832
|
# From cvs2svn the following explanation (with modifications |
|
833
|
# for our algorithm): |
|
834
|
|
|
835
|
# Determine whether there are any non-trunk default branch |
|
836
|
# revisions. |
|
837
|
|
|
838
|
# If a non-trunk default branch is determined to have existed, |
|
839
|
# return a list of objects for all revisions that were once |
|
840
|
# non-trunk default revisions, in dependency order (i.e. root |
|
841
|
# first). |
|
842
|
|
|
843
|
# There are two cases to handle: |
|
844
|
|
|
845
|
# One case is simple. The RCS file lists a default branch |
|
846
|
# explicitly in its header, such as '1.1.1'. In this case, we |
|
847
|
# know that every revision on the vendor branch is to be |
|
848
|
# treated as head of trunk at that point in time. |
|
849
|
|
|
850
|
# But there's also a degenerate case. The RCS file does not |
|
851
|
# currently have a default branch, yet we can deduce that for |
|
852
|
# some period in the past it probably *did* have one. For |
|
853
|
# example, the file has vendor revisions 1.1.1.1 -> 1.1.1.96, |
|
854
|
# all of which are dated before 1.2, and then it has 1.1.1.97 |
|
855
|
# -> 1.1.1.100 dated after 1.2. In this case, we should |
|
856
|
# record 1.1.1.96 as the last vendor revision to have been the |
|
857
|
# head of the default branch. |
|
858
|
|
|
859
|
if {$myprincipal ne ""} { |
|
860
|
# There is still a default branch; that means that all |
|
861
|
# revisions on that branch get marked. |
|
862
|
|
|
863
|
log write 5 file "Found explicitly marked NTDB" |
|
864
|
|
|
865
|
set rnext [$myroot child] |
|
866
|
if {$rnext ne ""} { |
|
867
|
trouble fatal "File with default branch $myprincipal also has revision [$rnext revnr]" |
|
868
|
return |
|
869
|
} |
|
870
|
|
|
871
|
set rev [$mybranches($myprincipal) child] |
|
872
|
set res {} |
|
873
|
|
|
874
|
while {$rev ne ""} { |
|
875
|
lappend res $rev |
|
876
|
set rev [$rev child] |
|
877
|
} |
|
878
|
|
|
879
|
return $res |
|
880
|
|
|
881
|
} elseif {$myimported} { |
|
882
|
# No default branch, but the file appears to have been |
|
883
|
# imported. So our educated guess is that all revisions |
|
884
|
# on the '1.1.1' branch with timestamps prior to the |
|
885
|
# timestamp of '1.2' were non-trunk default branch |
|
886
|
# revisions. |
|
887
|
|
|
888
|
# This really only processes standard '1.1.1.*'-style |
|
889
|
# vendor revisions. One could conceivably have a file |
|
890
|
# whose default branch is 1.1.3 or whatever, or was that |
|
891
|
# at some point in time, with vendor revisions 1.1.3.1, |
|
892
|
# 1.1.3.2, etc. But with the default branch gone now, |
|
893
|
# we'd have no basis for assuming that the non-standard |
|
894
|
# vendor branch had ever been the default branch anyway. |
|
895
|
|
|
896
|
# Note that we rely on comparisons between the timestamps |
|
897
|
# of the revisions on the vendor branch and that of |
|
898
|
# revision 1.2, even though the timestamps might be |
|
899
|
# incorrect due to clock skew. We could do a slightly |
|
900
|
# better job if we used the changeset timestamps, as it is |
|
901
|
# possible that the dependencies that went into |
|
902
|
# determining those timestamps are more accurate. But |
|
903
|
# that would require an extra pass or two. |
|
904
|
|
|
905
|
if {![info exists mybranches(1.1.1)]} { return {} } |
|
906
|
|
|
907
|
log write 5 file "Deduced existence of NTDB" |
|
908
|
|
|
909
|
set rev [$mybranches(1.1.1) child] |
|
910
|
set res {} |
|
911
|
set stop [$myroot child] |
|
912
|
|
|
913
|
if {$stop eq ""} { |
|
914
|
# Get everything on the branch |
|
915
|
while {$rev ne ""} { |
|
916
|
lappend res $rev |
|
917
|
set rev [$rev child] |
|
918
|
} |
|
919
|
} else { |
|
920
|
# Collect everything on the branch which seems to have |
|
921
|
# been committed before the first primary child of the |
|
922
|
# root revision. |
|
923
|
set stopdate [$stop date] |
|
924
|
while {$rev ne ""} { |
|
925
|
if {[$rev date] >= $stopdate} break |
|
926
|
lappend res $rev |
|
927
|
set rev [$rev child] |
|
928
|
} |
|
929
|
} |
|
930
|
|
|
931
|
return $res |
|
932
|
|
|
933
|
} else { |
|
934
|
return {} |
|
935
|
} |
|
936
|
} |
|
937
|
|
|
938
|
# General note: In the following methods we only modify the links |
|
939
|
# between revisions and symbols to restructure the revision |
|
940
|
# tree. We do __not__ destroy the objects. Given the complex links |
|
941
|
# GC is difficult at this level. It is much easier to drop |
|
942
|
# everything when we we are done. This happens in 'drop', using |
|
943
|
# the state variable 'myrev', 'mybranches', and 'mytags'. What we |
|
944
|
# have to persist, performed by 'persist', we know will be |
|
945
|
# reachable through the revisions listed in 'myroots' and their |
|
946
|
# children and symbols. |
|
947
|
|
|
948
|
method AdjustNonTrunkDefaultBranch {revlist} { |
|
949
|
set stop [$myroot child] ;# rev '1.2' |
|
950
|
|
|
951
|
log write 5 file "Adjusting NTDB containing [nsp [llength $revlist] revision]" |
|
952
|
|
|
953
|
# From cvs2svn the following explanation (with modifications |
|
954
|
# for our algorithm): |
|
955
|
|
|
956
|
# Adjust the non-trunk default branch revisions found in the |
|
957
|
# 'revlist'. |
|
958
|
|
|
959
|
# 'myimported' is a boolean flag indicating whether this file |
|
960
|
# appears to have been imported, which also means that |
|
961
|
# revision 1.1 has a generated log message that need not be |
|
962
|
# preserved. 'revlist' is a list of object references for the |
|
963
|
# revisions that have been determined to be non-trunk default |
|
964
|
# branch revisions. |
|
965
|
|
|
966
|
# Note that the first revision on the default branch is |
|
967
|
# handled strangely by CVS. If a file is imported (as opposed |
|
968
|
# to being added), CVS creates a 1.1 revision, then creates a |
|
969
|
# vendor branch 1.1.1 based on 1.1, then creates a 1.1.1.1 |
|
970
|
# revision that is identical to the 1.1 revision (i.e., its |
|
971
|
# deltatext is empty). The log message that the user typed |
|
972
|
# when importing is stored with the 1.1.1.1 revision. The 1.1 |
|
973
|
# revision always contains a standard, generated log message, |
|
974
|
# 'Initial revision\n'. |
|
975
|
|
|
976
|
# When we detect a straightforward import like this, we want |
|
977
|
# to handle it by deleting the 1.1 revision (which doesn't |
|
978
|
# contain any useful information) and making 1.1.1.1 into an |
|
979
|
# independent root in the file's dependency tree. In SVN, |
|
980
|
# 1.1.1.1 will be added directly to the vendor branch with its |
|
981
|
# initial content. Then in a special 'post-commit', the |
|
982
|
# 1.1.1.1 revision is copied back to trunk. |
|
983
|
|
|
984
|
# If the user imports again to the same vendor branch, then CVS |
|
985
|
# creates revisions 1.1.1.2, 1.1.1.3, etc. on the vendor branch, |
|
986
|
# *without* counterparts in trunk (even though these revisions |
|
987
|
# effectively play the role of trunk revisions). So after we add |
|
988
|
# such revisions to the vendor branch, we also copy them back to |
|
989
|
# trunk in post-commits. |
|
990
|
|
|
991
|
# We mark the revisions found in 'revlist' as default branch |
|
992
|
# revisions. Also, if the root revision has a primary child |
|
993
|
# we set that revision to depend on the last non-trunk default |
|
994
|
# branch revision and possibly adjust its type accordingly. |
|
995
|
|
|
996
|
set first [lindex $revlist 0] |
|
997
|
|
|
998
|
log write 6 file "<[$first revnr]> [expr {$myimported ? "imported" : "not imported"}], [$first operation], [expr {[$first hastext] ? "has text" : "no text"}]" |
|
999
|
|
|
1000
|
if {$myimported && |
|
1001
|
[$first revnr] eq "1.1.1.1" && |
|
1002
|
[$first operation] eq "change" && |
|
1003
|
![$first hastext]} { |
|
1004
|
|
|
1005
|
set rev11 [$first parent] ; # Assert: Should be myroot. |
|
1006
|
log write 3 file "Removing irrelevant revision [$rev11 revnr]" |
|
1007
|
|
|
1008
|
# Cut out the old myroot revision. |
|
1009
|
|
|
1010
|
ldelete myroots $rev11 ; # Not a root any longer. |
|
1011
|
|
|
1012
|
$first cutfromparent ; # Sever revision from parent revision. |
|
1013
|
if {$stop ne ""} { |
|
1014
|
$stop cutfromparent |
|
1015
|
lappend myroots $stop ; # New root, after vendor branch |
|
1016
|
} |
|
1017
|
|
|
1018
|
# Cut out the vendor branch symbol |
|
1019
|
|
|
1020
|
set vendor [$first parentbranch] |
|
1021
|
integrity assert {$vendor ne ""} {First NTDB revision has no branch} |
|
1022
|
if {[$vendor parent] eq $rev11} { |
|
1023
|
$rev11 removebranch $vendor |
|
1024
|
$rev11 removechildonbranch $first |
|
1025
|
$vendor cutbranchparent ;# bp = rev11, about to be gone |
|
1026
|
$first cutfromparentbranch ;# pb = vendor, to be a detached LOD |
|
1027
|
lappend myroots $first |
|
1028
|
} |
|
1029
|
|
|
1030
|
# Change the type of first (typically from Change to Add): |
|
1031
|
$first retype add |
|
1032
|
|
|
1033
|
# Move any tags and branches from the old to the new root. |
|
1034
|
$rev11 movesymbolsto $first |
|
1035
|
} |
|
1036
|
|
|
1037
|
# Mark all the special revisions as such |
|
1038
|
foreach rev $revlist { |
|
1039
|
log write 3 file "Revision on default branch: [$rev revnr]" |
|
1040
|
$rev setondefaultbranch 1 |
|
1041
|
} |
|
1042
|
|
|
1043
|
if {$stop ne ""} { |
|
1044
|
# Revision 1.2 logically follows the imported revisions, |
|
1045
|
# not 1.1. Accordingly, connect it to the last NTDBR and |
|
1046
|
# possibly change its type. |
|
1047
|
|
|
1048
|
set last [lindex $revlist end] |
|
1049
|
$stop setdefaultbranchparent $last ; # Retypes the revision too. |
|
1050
|
$last setdefaultbranchchild $stop |
|
1051
|
} |
|
1052
|
return |
|
1053
|
} |
|
1054
|
|
|
1055
|
method CheckLODs {} { |
|
1056
|
foreach {_ branch} [array get mybranches] { $branch checklod } |
|
1057
|
foreach {_ taglist} [array get mytags] { |
|
1058
|
foreach tag $taglist { $tag checklod } |
|
1059
|
} |
|
1060
|
return |
|
1061
|
} |
|
1062
|
|
|
1063
|
method RemoveIrrelevantDeletions {} { |
|
1064
|
# From cvs2svn: If a file is added on a branch, then a trunk |
|
1065
|
# revision is added at the same time in the 'Dead' state. |
|
1066
|
# This revision doesn't do anything useful, so delete it. |
|
1067
|
|
|
1068
|
foreach root $myroots { |
|
1069
|
if {[$root isneeded]} continue |
|
1070
|
log write 2 file "Removing unnecessary dead revision [$root revnr]" |
|
1071
|
|
|
1072
|
# Remove as root, make its child new root after |
|
1073
|
# disconnecting it from the revision just going away. |
|
1074
|
|
|
1075
|
ldelete myroots $root |
|
1076
|
if {[$root haschild]} { |
|
1077
|
set child [$root child] |
|
1078
|
$child cutfromparent |
|
1079
|
lappend myroots $child |
|
1080
|
} |
|
1081
|
|
|
1082
|
# Cut out the branches spawned by the revision to be |
|
1083
|
# deleted. If the branch has revisions they should already |
|
1084
|
# use operation 'add', no need to change that. The first |
|
1085
|
# revision on each branch becomes a new and disconnected |
|
1086
|
# root. |
|
1087
|
|
|
1088
|
foreach branch [$root branches] { |
|
1089
|
$branch cutbranchparent |
|
1090
|
if {![$branch haschild]} continue |
|
1091
|
set first [$branch child] |
|
1092
|
$first cutfromparent |
|
1093
|
lappend myroots $first |
|
1094
|
} |
|
1095
|
$root removeallbranches |
|
1096
|
|
|
1097
|
# Tagging a dead revision doesn't do anything, so remove |
|
1098
|
# any tags that were set on it. |
|
1099
|
|
|
1100
|
$root removealltags |
|
1101
|
|
|
1102
|
# This can only happen once per file, and we might have |
|
1103
|
# just changed myroots, so end the loop |
|
1104
|
break |
|
1105
|
} |
|
1106
|
return |
|
1107
|
} |
|
1108
|
|
|
1109
|
method RemoveInitialBranchDeletions {} { |
|
1110
|
# From cvs2svn: If the first revision on a branch is an |
|
1111
|
# unnecessary delete, remove it. |
|
1112
|
# |
|
1113
|
# If a file is added on a branch (whether or not it already |
|
1114
|
# existed on trunk), then new versions of CVS add a first |
|
1115
|
# branch revision in the 'dead' state (to indicate that the |
|
1116
|
# file did not exist on the branch when the branch was |
|
1117
|
# created) followed by the second branch revision, which is an |
|
1118
|
# add. When we encounter this situation, we sever the branch |
|
1119
|
# from trunk and delete the first branch revision. |
|
1120
|
|
|
1121
|
# At this point we may have already multiple roots in myroots, |
|
1122
|
# we have to process them all. |
|
1123
|
|
|
1124
|
foreach root [$self LinesOfDevelopment] { |
|
1125
|
if {[$root isneededbranchdel]} continue |
|
1126
|
log write 2 file "Removing unnecessary initial branch delete [$root revnr]" |
|
1127
|
|
|
1128
|
set branch [$root parentbranch] |
|
1129
|
set parent [$root parent] |
|
1130
|
set child [$root child] |
|
1131
|
|
|
1132
|
ldelete myroots $root |
|
1133
|
lappend myroots $child |
|
1134
|
|
|
1135
|
$branch cutbranchparent |
|
1136
|
$branch cutchild |
|
1137
|
$child cutfromparent |
|
1138
|
|
|
1139
|
$branch setchild $child |
|
1140
|
$child setparentbranch $branch |
|
1141
|
|
|
1142
|
$parent removebranch $branch |
|
1143
|
$parent removechildonbranch $root |
|
1144
|
} |
|
1145
|
return |
|
1146
|
} |
|
1147
|
|
|
1148
|
method LinesOfDevelopment {} { |
|
1149
|
# Determine all lines of development for the file. This are |
|
1150
|
# the known roots, and the root of all branches found on the |
|
1151
|
# line of primary children. |
|
1152
|
|
|
1153
|
set lodroots {} |
|
1154
|
foreach root $myroots { |
|
1155
|
$self AddBranchedLinesOfDevelopment lodroots $root |
|
1156
|
lappend lodroots $root |
|
1157
|
} |
|
1158
|
return $lodroots |
|
1159
|
} |
|
1160
|
|
|
1161
|
method AddBranchedLinesOfDevelopment {lv root} { |
|
1162
|
upvar 1 $lv lodroots |
|
1163
|
while {$root ne ""} { |
|
1164
|
foreach branch [$root branches] { |
|
1165
|
if {![$branch haschild]} continue |
|
1166
|
set child [$branch child] |
|
1167
|
# Recurse into the branch for deeper branches. |
|
1168
|
$self AddBranchedLinesOfDevelopment lodroots $child |
|
1169
|
lappend lodroots $child |
|
1170
|
} |
|
1171
|
set root [$root child] |
|
1172
|
} |
|
1173
|
return |
|
1174
|
} |
|
1175
|
|
|
1176
|
method ExcludeNonTrunkInformation {} { |
|
1177
|
# Remove all non-trunk branches, revisions, and tags. We do |
|
1178
|
# keep the tags which are on the trunk. |
|
1179
|
|
|
1180
|
set ntdbroot "" |
|
1181
|
foreach root [$self LinesOfDevelopment] { |
|
1182
|
# Note: Here the order of the roots is important, |
|
1183
|
# i.e. that we get them in depth first order. This ensures |
|
1184
|
# that the removal of a branch happens only after the |
|
1185
|
# branches spawned from it were removed. Otherwise the |
|
1186
|
# system might try to access deleted objects. |
|
1187
|
|
|
1188
|
# Do not exclude the trunk. |
|
1189
|
if {[[$root lod] istrunk]} continue |
|
1190
|
$self ExcludeBranch $root ntdbroot |
|
1191
|
} |
|
1192
|
|
|
1193
|
if {$ntdbroot ne ""} { |
|
1194
|
$self GraftNTDB2Trunk $ntdbroot |
|
1195
|
} |
|
1196
|
return |
|
1197
|
} |
|
1198
|
|
|
1199
|
method ExcludeBranch {root nv} { |
|
1200
|
# Exclude the branch/lod starting at root, a revision. |
|
1201
|
# |
|
1202
|
# If the LOD starts with non-trunk default branch revisions, |
|
1203
|
# we leave them in place and do not delete the branch. In that |
|
1204
|
# case the command sets the variable in NV so that we can |
|
1205
|
# later rework these revisons to be purely trunk. |
|
1206
|
|
|
1207
|
if {[$root isondefaultbranch]} { |
|
1208
|
# Handling a NTDB. This branch may consists not only of |
|
1209
|
# NTDB revisions, but also some non-NTDB. The latter are |
|
1210
|
# truly on a branch and have to be excluded. The following |
|
1211
|
# loop determines if there are such revisions. |
|
1212
|
|
|
1213
|
upvar 1 $nv ntdbroot |
|
1214
|
set ntdbroot $root |
|
1215
|
$root cutfromparentbranch |
|
1216
|
|
|
1217
|
set rev $root |
|
1218
|
while {$rev ne ""} { |
|
1219
|
$rev removeallbranches |
|
1220
|
# See note [x]. |
|
1221
|
|
|
1222
|
if {[$rev isondefaultbranch]} { |
|
1223
|
set rev [$rev child] |
|
1224
|
} else { |
|
1225
|
break |
|
1226
|
} |
|
1227
|
} |
|
1228
|
|
|
1229
|
# rev now contains the first non-NTDB revision after the |
|
1230
|
# NTDB, or is empty if there is no such. If we have some |
|
1231
|
# they have to removed. |
|
1232
|
|
|
1233
|
if {$rev ne ""} { |
|
1234
|
set lastntdb [$rev parent] |
|
1235
|
$lastntdb cutfromchild |
|
1236
|
while {$rev ne ""} { |
|
1237
|
$rev removealltags |
|
1238
|
$rev removeallbranches |
|
1239
|
# Note [x]: We may still have had branches on the |
|
1240
|
# revision. Branches without revisions committed |
|
1241
|
# on them do not show up in the list of roots aka |
|
1242
|
# lines of development. |
|
1243
|
set rev [$rev child] |
|
1244
|
} |
|
1245
|
} |
|
1246
|
return |
|
1247
|
} |
|
1248
|
|
|
1249
|
# No NTDB stuff to deal with. First delete the branch object |
|
1250
|
# itself, after cutting all the various connections. |
|
1251
|
|
|
1252
|
set branch [$root parentbranch] |
|
1253
|
if {$branch ne ""} { |
|
1254
|
set branchparent [$branch parent] |
|
1255
|
$branchparent removebranch $branch |
|
1256
|
$branchparent removechildonbranch $root |
|
1257
|
} |
|
1258
|
|
|
1259
|
# The root is no such any longer either. |
|
1260
|
ldelete myroots $root |
|
1261
|
|
|
1262
|
# Now go through the line and remove all its revisions. |
|
1263
|
|
|
1264
|
while {$root ne ""} { |
|
1265
|
$root removealltags |
|
1266
|
$root removeallbranches |
|
1267
|
# Note: See the note [x]. |
|
1268
|
|
|
1269
|
# From cvs2svn: If this is the last default revision on a |
|
1270
|
# non-trunk default branch followed by a 1.2 revision, |
|
1271
|
# then the 1.2 revision depends on this one. FIXME: It is |
|
1272
|
# questionable whether this handling is correct, since the |
|
1273
|
# non-trunk default branch revisions affect trunk and |
|
1274
|
# should therefore not just be discarded even if |
|
1275
|
# --trunk-only. |
|
1276
|
|
|
1277
|
if {[$root hasdefaultbranchchild]} { |
|
1278
|
set ntdbchild [$root defaultbranchchild] |
|
1279
|
integrity assert { |
|
1280
|
[$ntdbchild defaultbranchparent] eq $ntdbchild |
|
1281
|
} {ntdb - trunk linkage broken} |
|
1282
|
$ntdbchild cutdefaultbranchparent |
|
1283
|
if {[$ntdbchild hasparent]} { |
|
1284
|
lappend myroots [$ntdbchild parent] |
|
1285
|
} |
|
1286
|
} |
|
1287
|
|
|
1288
|
set root [$root child] |
|
1289
|
} |
|
1290
|
|
|
1291
|
return |
|
1292
|
} |
|
1293
|
|
|
1294
|
method GraftNTDB2Trunk {root} { |
|
1295
|
# We can now graft the non-trunk default branch revisions to |
|
1296
|
# trunk. They should already be alone on a CVSBranch-less |
|
1297
|
# branch. |
|
1298
|
|
|
1299
|
integrity assert {![$root hasparentbranch]} {NTDB root still has its branch symbol} |
|
1300
|
integrity assert {![$root hasbranches]} {NTDB root still has spawned branches} |
|
1301
|
|
|
1302
|
set last $root |
|
1303
|
while {[$last haschild]} {set last [$last child]} |
|
1304
|
|
|
1305
|
if {[$last hasdefaultbranchchild]} { |
|
1306
|
|
|
1307
|
set rev12 [$last defaultbranchchild] |
|
1308
|
$rev12 cutdefaultbranchparent |
|
1309
|
$last cutdefaultbranchchild |
|
1310
|
|
|
1311
|
$rev12 changeparent $last |
|
1312
|
$last changechild $rev12 |
|
1313
|
|
|
1314
|
ldelete myroots $rev12 |
|
1315
|
|
|
1316
|
# Note and remember that the type of rev12 was already |
|
1317
|
# adjusted by AdjustNonTrunkDefaultBranch, so we don't |
|
1318
|
# have to change its type here. |
|
1319
|
} |
|
1320
|
|
|
1321
|
while {$root ne ""} { |
|
1322
|
$root setondefaultbranch 0 |
|
1323
|
$root setlod $mytrunk |
|
1324
|
foreach tag [$root tags] { |
|
1325
|
$tag setlod $mytrunk |
|
1326
|
} |
|
1327
|
set root [$root child] |
|
1328
|
} |
|
1329
|
|
|
1330
|
return |
|
1331
|
} |
|
1332
|
|
|
1333
|
method Active {} { |
|
1334
|
set revisions {} |
|
1335
|
set symbols {} |
|
1336
|
|
|
1337
|
foreach root [$self LinesOfDevelopment] { |
|
1338
|
if {[$root hasparentbranch]} { lappend symbols [$root parentbranch] } |
|
1339
|
while {$root ne ""} { |
|
1340
|
lappend revisions $root |
|
1341
|
foreach tag [$root tags] { lappend symbols $tag } |
|
1342
|
foreach branch [$root branches] { |
|
1343
|
integrity assert { |
|
1344
|
[$branch parent] eq $root |
|
1345
|
} {Backreference branch to its root is missing or wrong} |
|
1346
|
lappend symbols $branch |
|
1347
|
} |
|
1348
|
set lod [$root lod] |
|
1349
|
if {![$lod istrunk]} { |
|
1350
|
integrity assert { |
|
1351
|
[$lod haschild] |
|
1352
|
} {Branch is LOD symbol without revisions} |
|
1353
|
lappend symbols $lod |
|
1354
|
} |
|
1355
|
set root [$root child] |
|
1356
|
} |
|
1357
|
} |
|
1358
|
|
|
1359
|
return [list [lsort -unique -dict $revisions] [lsort -unique -dict $symbols]] |
|
1360
|
} |
|
1361
|
|
|
1362
|
|
|
1363
|
method AggregateSymbolData {} { |
|
1364
|
# Now that the exact set of revisions (and through that |
|
1365
|
# branches and tags) is known we can update the aggregate |
|
1366
|
# symbol statistics. |
|
1367
|
|
|
1368
|
foreach root [$self LinesOfDevelopment] { |
|
1369
|
set lod [$root lod] |
|
1370
|
|
|
1371
|
# Note: If the LOD is the trunk the count*, etc. methods |
|
1372
|
# will do nothing, as it is always present (cannot be |
|
1373
|
# excluded), and is always a branch too. |
|
1374
|
|
|
1375
|
# Lines of development count as branches and have a commit |
|
1376
|
# on them (root). If they are still attached to a tree we |
|
1377
|
# have to compute and register possible parents. |
|
1378
|
|
|
1379
|
$lod countasbranch |
|
1380
|
$lod countacommit |
|
1381
|
|
|
1382
|
if {[$root hasparentbranch]} { |
|
1383
|
# Note lod == [$root parentbranch] |
|
1384
|
$lod possibleparents |
|
1385
|
} elseif {![$lod istrunk] && [$root isondefaultbranch]} { |
|
1386
|
# This is the root revision of a detached NTDB. We |
|
1387
|
# have to manually set the only possible parent for |
|
1388
|
# this LOD, the trunk itself. |
|
1389
|
|
|
1390
|
[$lod symbol] possibleparent $mytrunk |
|
1391
|
} |
|
1392
|
|
|
1393
|
# For the revisions in the line we register their branches |
|
1394
|
# and tags as blockers for the lod, and update the type |
|
1395
|
# counters as well. As branch symbols without commits on |
|
1396
|
# them are not listed as lines of development, we have to |
|
1397
|
# count them here as well, as plain branches. At last we |
|
1398
|
# have to compute and register the possible parents of the |
|
1399
|
# tags, in case they are later converted as branches. |
|
1400
|
|
|
1401
|
while {$root ne ""} { |
|
1402
|
foreach branch [$root branches] { |
|
1403
|
$lod blockedby $branch |
|
1404
|
$branch possibleparents |
|
1405
|
if {[$branch haschild]} continue |
|
1406
|
$branch countasbranch |
|
1407
|
} |
|
1408
|
|
|
1409
|
foreach tag [$root tags] { |
|
1410
|
$lod blockedby $tag |
|
1411
|
$tag possibleparents |
|
1412
|
$tag countastag |
|
1413
|
} |
|
1414
|
|
|
1415
|
set root [$root child] |
|
1416
|
} |
|
1417
|
} |
|
1418
|
|
|
1419
|
return |
|
1420
|
} |
|
1421
|
|
|
1422
|
# # ## ### ##### ######## ############# |
|
1423
|
## Configuration |
|
1424
|
|
|
1425
|
pragma -hastypeinfo no ; # no type introspection |
|
1426
|
pragma -hasinfo no ; # no object introspection |
|
1427
|
pragma -hastypemethods no ; # type is not relevant. |
|
1428
|
|
|
1429
|
# # ## ### ##### ######## ############# |
|
1430
|
} |
|
1431
|
|
|
1432
|
namespace eval ::vc::fossil::import::cvs { |
|
1433
|
namespace export file |
|
1434
|
namespace eval file { |
|
1435
|
# Import not required, already a child namespace. |
|
1436
|
# namespace import ::vc::fossil::import::cvs::file::rev |
|
1437
|
# namespace import ::vc::fossil::import::cvs::file::sym |
|
1438
|
namespace import ::vc::tools::misc::* |
|
1439
|
namespace import ::vc::tools::trouble |
|
1440
|
namespace import ::vc::tools::log |
|
1441
|
namespace import ::vc::fossil::import::cvs::blobstore |
|
1442
|
namespace import ::vc::fossil::import::cvs::state |
|
1443
|
namespace import ::vc::fossil::import::cvs::integrity |
|
1444
|
namespace import ::vc::fossil::import::cvs::gtcore |
|
1445
|
} |
|
1446
|
} |
|
1447
|
|
|
1448
|
# # ## ### ##### ######## ############# ##################### |
|
1449
|
## Ready |
|
1450
|
|
|
1451
|
package provide vc::fossil::import::cvs::file 1.0 |
|
1452
|
return |
|
1453
|
|