Fossil SCM

fossil-scm / tools / cvs2fossil / lib / c2f_frev.tcl
Blame History Raw 553 lines
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
## Revisions per file.
14
15
# # ## ### ##### ######## ############# #####################
16
## Requirements
17
18
package require Tcl 8.4 ; # Required runtime.
19
package require snit ; # OO system.
20
package require vc::tools::misc ; # Text formatting
21
package require vc::fossil::import::cvs::state ; # State storage.
22
package require vc::fossil::import::cvs::integrity ; # State integrity checks.
23
24
# # ## ### ##### ######## ############# #####################
25
##
26
27
snit::type ::vc::fossil::import::cvs::file::rev {
28
# # ## ### ##### ######## #############
29
## Public API
30
31
constructor {revnr date state thefile} {
32
set myrevnr $revnr
33
set mydate $date
34
set myorigdate $date
35
set mystate $state
36
set myfile $thefile
37
return
38
}
39
40
method defid {} {
41
set myid [incr myidcounter]
42
return
43
}
44
45
method id {} { return $myid }
46
method file {} { return $myfile }
47
48
# Basic pieces ________________________
49
50
method hasmeta {} { return [expr {$mymetaid ne ""}] }
51
method hastext {} {
52
return [expr {$mytextstart <= $mytextend}]
53
}
54
55
method setmeta {meta} { set mymetaid $meta ; return }
56
method settext {text} {
57
struct::list assign $text mytextstart mytextend
58
return
59
}
60
method setlod {lod} { set mylod $lod ; return }
61
62
method revnr {} { return $myrevnr }
63
method state {} { return $mystate }
64
method lod {} { return $mylod }
65
method date {} { return $mydate }
66
67
method isneeded {} {
68
if {$myoperation ne "nothing"} {return 1}
69
if {$myrevnr ne "1.1"} {return 1}
70
if {![$mylod istrunk]} {return 1}
71
if {![llength $mybranches]} {return 1}
72
set firstbranch [lindex $mybranches 0]
73
if {![$firstbranch haschild]} {return 1}
74
if {$myisondefaultbranch} {return 1}
75
76
# FIX: This message will not match if the RCS file was renamed
77
# manually after it was created.
78
79
set gen "file [file tail [$myfile usrpath]] was initially added on branch [$firstbranch name]."
80
set log [$myfile commitmessageof $mymetaid]
81
82
return [expr {$log ne $gen}]
83
}
84
85
method isneededbranchdel {} {
86
if {$myparentbranch eq ""} {return 1} ; # not first on a branch, needed
87
set base [$myparentbranch parent]
88
if {$base eq ""} {return 1} ; # branch has parent lod, needed
89
if {[$self LODLength] < 2} {return 1} ; # our lod contains only ourselves, needed.
90
if {$myoperation ne "delete"} {return 1} ; # Not a deletion, needed
91
if {[llength $mytags]} {return 1} ; # Have tags, needed
92
if {[llength $mybranches]} {return 1} ; # Have other branches, needed
93
if {abs($mydate - [$base date]) > 2} {return 1} ; # Next rev > 2 seconds apart, needed
94
95
# FIXME: This message will not match if the RCS file was
96
# renamed manually after it was created.
97
98
set qfile [string map {
99
. \\. ? \\? * \\* \\ \\\\ + \\+ ^ \\^ $ \\$
100
\[ \\\[ \] \\\] ( \\( ) \\) \{ \\\{ \} \\\}
101
} [file tail [$myfile usrpath]]]
102
set pattern "file $qfile was added on branch .* on \\d{4}-\\d{2}-\\d{2} \\d{2}:\\d{2}:\\d{2}( \[+-\]\\d{4})?"
103
set log [$myfile commitmessageof $mymetaid]
104
105
# Not the special message, needed
106
if {![regexp -- $pattern $log]} {return 1}
107
108
# This is an unneeded initial branch delete.
109
return 0
110
}
111
112
method LODLength {} {
113
set n 1 ; # count self
114
set rev $mychild
115
while {$rev ne ""} {
116
incr n
117
set rev [$rev child]
118
}
119
return $n
120
}
121
122
# Basic parent/child linkage __________
123
124
method hasparent {} { return [expr {$myparent ne ""}] }
125
method haschild {} { return [expr {$mychild ne ""}] }
126
127
method setparent {parent} {
128
integrity assert {$myparent eq ""} {Parent already defined}
129
set myparent $parent
130
return
131
}
132
133
method cutfromparent {} { set myparent "" ; return }
134
method cutfromchild {} { set mychild "" ; return }
135
136
method setchild {child} {
137
integrity assert {$mychild eq ""} {Child already defined}
138
set mychild $child
139
return
140
}
141
142
method changeparent {parent} { set myparent $parent ; return }
143
method changechild {child} { set mychild $child ; return }
144
145
method parent {} { return $myparent }
146
method child {} { return $mychild }
147
148
# Branch linkage ______________________
149
150
method setparentbranch {branch} {
151
integrity assert {$myparentbranch eq ""} {Branch parent already defined}
152
set myparentbranch $branch
153
return
154
}
155
156
method hasparentbranch {} { return [expr {$myparentbranch ne ""}] }
157
method hasbranches {} { return [llength $mybranches] }
158
159
method parentbranch {} { return $myparentbranch }
160
method branches {} { return $mybranches }
161
162
method addbranch {branch} {
163
lappend mybranches $branch
164
return
165
}
166
167
method addchildonbranch {child} {
168
lappend mybranchchildren $child
169
return
170
}
171
172
method cutfromparentbranch {} { set myparentbranch "" ; return }
173
174
method removebranch {branch} {
175
ldelete mybranches $branch
176
return
177
}
178
179
method removechildonbranch {rev} {
180
ldelete mybranchchildren $rev
181
return
182
}
183
184
method sortbranches {} {
185
# Pass 2: CollectRev
186
187
if {[llength $mybranches] < 2} return
188
189
# Sort the branches spawned by this revision in creation
190
# order. To help in this our file gave all branches a position
191
# id, in order of their definition by the RCS archive.
192
#
193
# The creation order is (apparently) the reverse of the
194
# definition order. (If a branch is created then deleted, a
195
# later branch can be assigned the recycled branch number;
196
# therefore branch numbers are not an indication of creation
197
# order.)
198
199
set tmp {}
200
foreach branch $mybranches {
201
lappend tmp [list $branch [$branch position]]
202
}
203
204
set mybranches {}
205
foreach item [lsort -index 1 -decreasing $tmp] {
206
struct::list assign $item branch position
207
lappend mybranches $branch
208
}
209
return
210
}
211
212
method movebranchesto {rev} {
213
set revlod [$rev lod]
214
foreach branch $mybranches {
215
$rev addbranch $branch
216
$branch setparent $rev
217
$branch setlod $revlod
218
}
219
foreach branchrev $mybranchchildren {
220
$rev addchildonbranch $branchrev
221
$branchrev cutfromparent
222
$branchrev setparent $rev
223
}
224
set mybranches {}
225
set mybranchchildren {}
226
return
227
}
228
229
method removeallbranches {} {
230
set mybranches {}
231
set mybranchchildren {}
232
return
233
}
234
235
# Tag linkage _________________________
236
237
method addtag {tag} {
238
lappend mytags $tag
239
return
240
}
241
242
method tags {} { return $mytags }
243
244
method removealltags {} {
245
set mytags {}
246
return
247
}
248
249
method movetagsto {rev} {
250
set revlod [$rev lod]
251
foreach tag $mytags {
252
$rev addtag $tag
253
$tag settagrev $rev
254
$tag setlod $revlod
255
}
256
set mytags {}
257
return
258
}
259
260
# general symbol operations ___________
261
262
method movesymbolsto {rev} {
263
# Move the tags and branches attached to this revision to the
264
# destination and fix all pointers.
265
266
$self movetagsto $rev
267
$self movebranchesto $rev
268
return
269
}
270
271
# Derived stuff _______________________
272
273
method determineoperation {} {
274
# Look at the state of both this revision and its parent to
275
# determine the type opf operation which was performed (add,
276
# modify, delete, none).
277
#
278
# The important information is dead vs not-dead for both,
279
# giving rise to four possible types.
280
281
set sdead [expr {$mystate eq "dead"}]
282
set pdead [expr {$myparent eq "" || [$myparent state] eq "dead"}]
283
284
set myoperation $myopstate([list $pdead $sdead])
285
return
286
}
287
288
method operation {} { return $myoperation }
289
method retype {x} { set myoperation $x ; return }
290
291
method isondefaultbranch {} { return $myisondefaultbranch }
292
293
method setondefaultbranch {x} { set myisondefaultbranch $x ; return }
294
295
method setdefaultbranchchild {rev} { set mydbchild $rev ; return }
296
method setdefaultbranchparent {rev} {
297
set mydbparent $rev
298
299
# Retype the revision (may change from 'add' to 'change').
300
301
set sdead [expr {$myoperation ne "change"}]
302
set pdead [expr {[$rev operation] ne "change"}]
303
set myoperation $myopstate([list $pdead $sdead])
304
return
305
}
306
307
method cutdefaultbranchparent {} { set mydbparent "" ; return }
308
method cutdefaultbranchchild {} { set mydbchild "" ; return }
309
310
method defaultbranchchild {} { return $mydbchild }
311
method defaultbranchparent {} { return $mydbparent }
312
313
method hasdefaultbranchchild {} { return [expr {$mydbchild ne ""}] }
314
method hasdefaultbranchparent {} { return [expr {$mydbparent ne ""}] }
315
316
# # ## ### ##### ######## #############
317
## Type API
318
319
typemethod istrunkrevnr {revnr} {
320
return [expr {[llength [split $revnr .]] == 2}]
321
}
322
323
typemethod isbranchrevnr {revnr _ bv} {
324
if {[regexp $mybranchpattern $revnr -> head tail]} {
325
upvar 1 $bv branchnr
326
set branchnr ${head}$tail
327
return 1
328
}
329
return 0
330
}
331
332
typemethod 2branchnr {revnr} {
333
# Input is a branch revision number, i.e. a revision number
334
# with an even number of components; for example '2.9.2.1'
335
# (never '2.9.2' nor '2.9.0.2'). The return value is the
336
# branch number (for example, '2.9.2'). For trunk revisions,
337
# like '3.4', we return the empty string.
338
339
if {[$type istrunkrevnr $revnr]} {
340
return ""
341
}
342
return [join [lrange [split $revnr .] 0 end-1] .]
343
}
344
345
typemethod 2branchparentrevnr {branchnr} {
346
# Chop the last segment off
347
return [join [lrange [split $branchnr .] 0 end-1] .]
348
}
349
350
# # ## ### ##### ######## #############
351
352
method persist {} {
353
set fid [$myfile id]
354
set lod [$mylod id]
355
set op $myopcode($myoperation)
356
set idb $myisondefaultbranch
357
358
lappend map @P@ [expr { ($myparent eq "") ? "NULL" : [$myparent id] }]
359
lappend map @C@ [expr { ($mychild eq "") ? "NULL" : [$mychild id] }]
360
lappend map @DP [expr { ($mydbparent eq "") ? "NULL" : [$mydbparent id] }]
361
lappend map @DC [expr { ($mydbchild eq "") ? "NULL" : [$mydbchild id] }]
362
lappend map @BP [expr { ($myparentbranch eq "") ? "NULL" : [$myparentbranch id] }]
363
364
set cmd {
365
INSERT INTO revision ( rid, fid, rev, lod, parent, child, isdefault, dbparent, dbchild, bparent, op, date, state, mid)
366
VALUES ($myid, $fid, $myrevnr, $lod, @P@, @C@, $idb, @DP, @DC, @BP , $op, $mydate, $mystate, $mymetaid);
367
}
368
369
state transaction {
370
state run [string map $map $cmd]
371
372
# And the branch children as well, for pass 5.
373
foreach bc $mybranchchildren {
374
set bcid [$bc id]
375
state run {
376
INSERT INTO revisionbranchchildren (rid, brid)
377
VALUES ($myid, $bcid);
378
}
379
}
380
}
381
return
382
}
383
384
# # ## ### ##### ######## #############
385
## State
386
387
# Persistent: myid - revision.rid
388
# myfile - revision.fid
389
# mylod - revision.lod
390
# myrevnr - revision.rev
391
# mydate - revision.date
392
# mystate - revision.state
393
# mymetaid - revision.mid
394
# mytext{start,end} - revision.{cs,ce}
395
# myparent - revision.parent
396
# mychild - revision.child
397
# myparentbranch - revision.bparent
398
# myoperation - revision.op
399
# myisondefaultbranch - revision.isdefault
400
# mydbparent - revision.dbparent
401
# mydbchild - revision.dbchild
402
403
method DUMP {label} {
404
puts "$label = $self <$myrevnr> (NTDB=$myisondefaultbranch) \{"
405
puts "\tP\t$myparent"
406
puts "\tC\t$mychild"
407
puts "\tPB\t$myparentbranch"
408
puts "\tdbP\t$mydbparent"
409
puts "\tdbC\t$mydbchild"
410
foreach b $mybranches {
411
puts \t\tB\t$b
412
}
413
foreach b $mybranchchildren {
414
puts \t\tBC\t$b
415
}
416
puts "\}"
417
return
418
}
419
420
typevariable mybranchpattern {^((?:\d+\.\d+\.)+)(?:0\.)?(\d+)$}
421
# First a nonzero even number of digit groups with trailing dot
422
# CVS then sticks an extra 0 in here; RCS does not.
423
# And the last digit group.
424
425
typevariable myidcounter 0 ; # Counter for revision ids.
426
variable myid {} ; # Revision id.
427
428
variable myrevnr {} ; # Revision number of the revision.
429
variable mydate {} ; # Timestamp of the revision, seconds since epoch
430
variable myorigdate {} ; # Original unmodified timestamp.
431
variable mystate {} ; # State of the revision.
432
variable myfile {} ; # Ref to the file object the revision belongs to.
433
variable mytextstart {} ; # Start of the range of the (delta) text
434
# for this revision in the file.
435
variable mytextend {} ; # End of the range of the (delta) text
436
# for this revision in the file.
437
variable mymetaid {} ; # Id of the meta data group the revision
438
# belongs to. This is later used to put
439
# the file revisions into preliminary
440
# changesets (aka project revisions).
441
# This id encodes 4 pieces of data,
442
# namely: the project and branch the
443
# revision was committed to, the author
444
# who did the commit, and the message
445
# used.
446
variable mylod {} ; # Reference to the line-of-development
447
# object the revision belongs to. An
448
# alternative idiom would be to call it
449
# the branch the revision is on. This
450
# reference is to either project-level
451
# trunk or file-level symbol.
452
453
# Basic parent/child linkage (lines of development)
454
455
variable myparent {} ; # Ref to parent revision object. Link required because of
456
# ; # 'cvsadmin -o', which can create arbitrary gaps in the
457
# ; # numbering sequence. This is in the same line of development
458
# ; # Note: For the first revision on a branch the revision
459
# ; # it was spawned from is the parent. Only the root revision
460
# ; # of myfile's revision tree has nothing set here.
461
# ; #
462
463
variable mychild {} ; # Ref to the primary child revision object, i.e. the next
464
# ; # revision in the same line of development.
465
466
# Branch linkage ____________________
467
468
variable mybranches {} ; # List of the branches (objs) spawned by this revision.
469
variable myparentbranch {} ; # For the first revision on a branch the relevant
470
# ; # branch object. This also allows us to determine if
471
# ; # myparent is in the same LOD, or the revision the
472
# ; # branch spawned from.
473
474
# List of the revision objects of the first commits on any
475
# branches spawned by this revision on which commits occurred.
476
# This dependency is kept explicitly because otherwise a
477
# revision-only topological sort would miss the dependency that
478
# exists via -> mybranches.
479
480
variable mybranchchildren {} ; # List of the revisions (objs) which are the first
481
# ; # commits on any of the branches spawned from this
482
# ; # revision. The dependency is kept explicitly to
483
# ; # ensure that a revision-only topological sort will
484
# ; # not miss it, as it otherwise exists only via
485
# ; # mybranches.
486
487
# Tag linkage ________________________
488
489
variable mytags {} ; # List of tags (objs) associated with this revision.
490
491
# More derived data
492
493
variable myoperation {} ; # One of 'add', 'change', 'delete', or
494
# 'nothing'. Derived from our and
495
# its parent's state.
496
variable myisondefaultbranch 0 ; # Boolean flag, set if the
497
# revision is on the non-trunk
498
# default branch, aka vendor
499
# branch.
500
variable mydbparent {} ; # Reference to the last revision
501
# on the vendor branch if this is
502
# the primary child of the
503
# regular root.
504
variable mydbchild {} ; # Reference to the primary child
505
# of the regular root if this is
506
# the last revision on the vendor
507
# branch.
508
509
# dead(self) x dead(parent) -> operation
510
typevariable myopstate -array {
511
{0 0} change
512
{0 1} delete
513
{1 0} add
514
{1 1} nothing
515
}
516
517
typemethod getopcodes {} {
518
state foreachrow {
519
SELECT oid, name FROM optype;
520
} { set myopcode($name) $oid }
521
return
522
}
523
524
typevariable myopcode -array {}
525
526
# # ## ### ##### ######## #############
527
## Internal methods
528
529
# # ## ### ##### ######## #############
530
## Configuration
531
532
pragma -hastypeinfo no ; # no type introspection
533
pragma -hasinfo no ; # no object introspection
534
pragma -simpledispatch yes ; # simple fast dispatch
535
536
# # ## ### ##### ######## #############
537
}
538
539
namespace eval ::vc::fossil::import::cvs::file {
540
namespace export rev
541
namespace eval rev {
542
namespace import ::vc::tools::misc::*
543
namespace import ::vc::fossil::import::cvs::state
544
namespace import ::vc::fossil::import::cvs::integrity
545
}
546
}
547
548
# # ## ### ##### ######## ############# #####################
549
## Ready
550
551
package provide vc::fossil::import::cvs::file::rev 1.0
552
return
553

Keyboard Shortcuts

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