Differences From:
File
tools/cvs2fossil/lib/c2f_prev.tcl
part of check-in
[5f7acef887]
- Completed pass 5, computing the initial set of changesets. Defined persistent structure and filled out the long-existing placeholder class (project::rev).
by
aku on
2007-11-10 07:46:20.
[view]
To:
File
tools/cvs2fossil/lib/c2f_prev.tcl
part of check-in
[95af789e1f]
- Oops. pass 5 is not complete. Missed the breaking of internal dependencies, this is done in this pass already. Extended pass _2_ and file revisions with code to save the branchchildren (possible dependencies), and pass 5 and changesets with the proper algorithm. From cvs2svn, works, do not truly like it, as it throws away and recomputes a lot of state after each split of a cset. Could update and reuse the state to perform all splits in one go. Will try that next, for now we have a working form in the code base.
by
aku on
2007-11-10 20:40:06.
[view]
@@ -17,8 +17,9 @@
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
+package require vc::tools::log ; # User feedback.
package require vc::fossil::import::cvs::state ; # State storage.
# # ## ### ##### ######## ############# #####################
##
@@ -33,8 +34,172 @@
set mytype $cstype
set mysrcid $srcid
set myrevisions $revisions
return
+ }
+
+ method id {} { return $myid }
+
+ method breakinternaldependencies {cv} {
+ upvar 2 $cv csets ; # simple-dispatch!
+
+ # This method inspects the changesets for internal
+ # dependencies. Nothing is done if there are no
+ # such. Otherwise the changeset is split into a set of
+ # fragments without internal dependencies, transforming the
+ # internal dependencies into external ones. The new changesets
+ # are added to the list of all changesets.
+
+ # Actually at most one split is performed, resulting in at
+ # most one additional fragment. It is the caller's
+ # responsibility to spli the resulting fragments further.
+
+ # The code checks only sucessor dependencies, automatically
+ # covering the predecessor dependencies as well (A sucessor
+ # dependency a -> b is a predecessor dependency b -> a).
+
+ # Array of dependencies (parent -> child). This is pulled from
+ # the state, and limited to successors within the changeset.
+ array set dependencies {}
+
+ set theset ('[join $myrevisions {','}]')
+
+ foreach {rid child} [state run "
+ SELECT R.rid, R.child
+ FROM revision R
+ WHERE R.rid IN $theset
+ AND R.child IS NOT NULL
+ AND R.child IN $theset
+ UNION
+ SELECT R.rid, R.dbchild
+ FROM revision R
+ WHERE R.rid IN $theset
+ AND R.dbchild IS NOT NULL
+ AND R.dbchild IN $theset
+ UNION
+ SELECT R.rid, B.brid
+ FROM revision R, revisionbranchchildren B
+ WHERE R.rid IN $theset
+ AND R.rid = B.rid
+ AND B.brid IN $theset
+ "] {
+ # Consider moving this to the integrity module.
+ if {$rid == $child} {
+ trouble internal "Revision $rid depends on itself."
+ }
+ set dependencies($rid) $child
+ }
+
+ if {![array size dependencies]} {return 0} ; # Nothing to break.
+
+ # We have internal dependencies to break. We now iterate over
+ # all positions in the list (which is chronological, at least
+ # as far as the timestamps are correct and unique) and
+ # determine the best position for the break, by trying to
+ # break as many dependencies as possible in one go.
+
+ # First we create a map of positions to make it easier to
+ # determine whether a dependency cross a particular index.
+
+ array set pos {}
+ array set crossing {}
+ set n 0
+ foreach rev $myrevisions {
+ set pos($rev) $n
+ set crossing($n) 0
+ incr n
+ }
+
+ # Secondly we count the crossings per position, by iterating
+ # over the recorded internal dependencies.
+
+ foreach {rid child} [array get dependencies] {
+ set start $pos($rid)
+ set end $pos($child)
+
+ # Note: If the timestamps are badly out of order it is
+ # possible to have a backward successor dependency,
+ # i.e. with start > end. We may have to swap the
+ # indices to ensure that the following loop runs
+ # correctly.
+ #
+ # Note 2: start == end is not possible. It indicates a
+ # self-dependency due to the uniqueness of
+ # positions, and that is something we have ruled
+ # out already.
+
+ if {$start > $end} {
+ while {$end < $start} { incr crossing($end) ; incr end }
+ } else {
+ while {$start < $end} { incr crossing($start) ; incr start }
+ }
+ }
+
+ # Now we can determine the best break location. First we look
+ # for the locations with the maximal number of crossings. If
+ # there are several we look for the shortest time interval
+ # among them. If we still have multiple possibilities after
+ # that we select the smallest index among these.
+
+ set max -1
+ set best {}
+
+ foreach key [array names crossing] {
+ set now $crossing($key)
+ if {$now > $max} {
+ set max $now
+ set best $key
+ continue
+ } elseif {$now == $max} {
+ lappend best $key
+ }
+ }
+
+ if {[llength $best] > 1} {
+ set min -1
+ set newbest {}
+ foreach at $best {
+ set rat [lindex $myrevisions $at] ; incr at
+ set rnext [lindex $myrevisions $at] ; incr at -1
+ set tat [lindex [state run {SELECT R.date FROM revision R WHERE R.rid = $rat }] 0]
+ set tnext [lindex [state run {SELECT R.date FROM revision R WHERE R.rid = $rnext}] 0]
+ set delta [expr {$tnext - $tat}]
+ if {($min < 0) || ($delta < $min)} {
+ set min $delta
+ set newbest $at
+ } elseif {$delta == $min} {
+ lappend newbest $at
+ }
+ }
+ set best $newbest
+ }
+
+ if {[llength $best] > 1} {
+ set best [lindex [lsort -integer -increasing $best] 0]
+ }
+
+ # Now we can split off a fragment.
+
+ set bnext $best ; incr bnext
+ set revbefore [lrange $myrevisions 0 $best]
+ set revafter [lrange $myrevisions $bnext end]
+
+ if {![llength $revbefore]} {
+ trouble internal "Tried to split off a zero-length fragment at the beginning"
+ }
+ if {![llength $revafter]} {
+ trouble internal "Tried to split off a zero-length fragment at the end"
+ }
+
+ lappend csets [set new [$type %AUTO% $myproject $mytype $mysrcid $revafter]]
+ set myrevisions $revbefore
+
+ log write 4 csets "Breaking <$myid> @$best, making <[$new id]>, cutting $crossing($best)"
+
+ #puts "\tKeeping <$revbefore>"
+ #puts "\tSplit off <$revafter>"
+
+ return 1
}
method persist {} {
set tid $mycstype($mytype)
@@ -93,8 +258,10 @@
namespace eval ::vc::fossil::import::cvs::project {
namespace export rev
namespace eval rev {
namespace import ::vc::fossil::import::cvs::state
+ namespace import ::vc::tools::log
+ log register csets
}
}
# # ## ### ##### ######## ############# #####################