initial commitHEADmaster

1 files changed, 579 insertions, 0 deletions

diff --git a/tools/cvs2fossil/lib/c2f_cyclebreaker.tcl b/tools/cvs2fossil/lib/c2f_cyclebreaker.tcl
new file mode 100644
index 0000000..3d8a21c
--- /dev/null
+++ b/tools/cvs2fossil/lib/c2f_cyclebreaker.tcl
@@ -0,0 +1,579 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2007 Andreas Kupries.
+#
+# This software is licensed as described in the file LICENSE, which
+# you should have received as part of this distribution.
+#
+# This software consists of voluntary contributions made by many
+# individuals.  For exact contribution history, see the revision
+# history and logs, available at http://fossil-scm.hwaci.com/fossil
+# # ## ### ##### ######## ############# #####################
+
+## This file provides a helper package for the passes 6 and 7 which
+## contains the common code of the cycle breaking algorithm.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.4                                   ; # Required runtime.
+package require snit                                      ; # OO system.
+package require struct::graph                             ; # Graph handling.
+package require struct::list                              ; # Higher order list operations.
+package require vc::tools::dot                            ; # User feedback. DOT export.
+package require vc::tools::log                            ; # User feedback.
+package require vc::tools::trouble                        ; # Error reporting.
+package require vc::tools::misc                           ; # Text formatting.
+package require vc::fossil::import::cvs::project::rev     ; # Project level changesets
+package require vc::fossil::import::cvs::project::revlink ; # Cycle links.
+package require vc::fossil::import::cvs::integrity        ; # State integrity checks.
+
+# # ## ### ##### ######## ############# #####################
+##
+
+snit::type ::vc::fossil::import::cvs::cyclebreaker {
+    # # ## ### ##### ######## #############
+    ## Public API
+
+    typemethod precmd {cmd} {
+	::variable myprecmd $cmd
+	return
+    }
+
+    typemethod savecmd {cmd} {
+	::variable mysavecmd $cmd
+	return
+    }
+
+    typemethod breakcmd {cmd} {
+	::variable mybreakcmd $cmd
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    typemethod dotsto {path} {
+	::variable mydotdestination $path
+	return
+    }
+
+    typemethod watch {id} {
+	::variable mywatchids
+	lappend mywatchids $id
+    }
+
+    typemethod dot {label changesets} {
+	::variable mydotprefix $label
+	::variable mydotid     0
+
+	set dg [Setup $changesets 0]
+	Mark $dg
+	$dg destroy
+	return
+    }
+
+    typemethod mark {graph suffix {subgraph {}}} {
+	Mark $graph $suffix $subgraph
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    typemethod run {label changesetcmd} {
+	::variable myat        0
+	::variable mydotprefix $label
+	::variable mydotid     0
+
+	# We create a graph of the revision changesets, using the file
+	# level dependencies to construct a first approximation of the
+	# dependencies at the project level. Then we look for cycles
+	# in that graph and break them.
+
+	# 1. Create nodes for all relevant changesets and a mapping
+	#    from the revisions to their changesets/nodes.
+
+	set changesets [uplevel #0 $changesetcmd]
+	set dg [Setup $changesets]
+
+	# 3. Lastly we iterate the graph topologically. We mark off
+	#    the nodes which have no predecessors, in order from
+	#    oldest to youngest, saving and removing dependencies. If
+	#    we find no nodes without predecessors we have a cycle,
+	#    and work on breaking it.
+
+	log write 3 cyclebreaker {Traverse changesets}
+
+	InitializeCandidates $dg
+
+	set k   0
+	set max [llength [$dg nodes]]
+	while {1} {
+	    while {[WithoutPredecessor $dg n]} {
+		log progress 2 cyclebreaker $k $max ; incr k
+		MarkWatch $dg
+		ProcessedHook $dg $n $myat
+		$dg node delete $n
+		incr myat
+		ShowPendingNodes
+	    }
+
+	    if {![llength [$dg nodes]]} break
+
+	    BreakCycleHook       $dg
+	    InitializeCandidates $dg
+	    MarkWatch            $dg
+	}
+
+	$dg destroy
+
+	log write 3 cyclebreaker Done.
+	ClearHooks
+
+	# Reread the graph and dump its final form, if graph export
+	# was activated.
+
+	::variable mydotdestination
+	if {$mydotdestination eq ""} return
+
+	set   dg [Setup [uplevel #0 $changesetcmd] 0]
+	Mark $dg -done
+	$dg destroy
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    typemethod break-segment {graph} {
+	BreakSegment $graph $path "segment ([project::rev strlist $path])"
+	return
+    }
+
+    typemethod break {graph} {
+	set cycle [FindCycle $graph]
+	set label "cycle ([project::rev strlist $cycle])"
+
+	# NOTE: cvs2svn uses the sequence "end-1, cycle, 0" to create
+	#       the path from the cycle. The only effect I can see is
+	#       that this causes the link-triples to be generated in a
+	#       sightly different order, i.e. one link rotated to the
+	#       right. This should have no effect on the search for
+	#       the best of all.
+
+	lappend cycle [lindex $cycle 0] [lindex $cycle 1]
+	BreakSegment $graph $cycle $label
+	return
+    }
+
+    typemethod replace {graph n replacements} {
+	Replace $graph $n $replacements
+	return
+    }
+
+    # # ## ### ##### ######## #############
+    ## Internal methods
+
+    proc Setup {changesets {log 1}} {
+	if {$log} {
+	    log write 3 cyclebreaker "Creating graph of changesets"
+	}
+
+	set dg [struct::graph dg]
+
+	set n 0
+	set max [llength $changesets]
+
+	foreach cset $changesets {
+	    log progress 2 cyclebreaker $n $max
+	    set tr [$cset timerange]
+	    $dg node insert $cset
+	    $dg node set    $cset timerange $tr
+	    $dg node set    $cset label     "[$cset str]\\n[join [struct::list map $tr {::clock format}] "\\n"]"
+	    $dg node set    $cset __id__    [$cset id]
+	    $dg node set    $cset shape     [expr {[$cset bysymbol]
+						   ? "ellipse"
+						   : "box"}]
+	    incr n
+	}
+
+	if {$log} {
+	    log write 3 cyclebreaker "Has [nsp [llength $changesets] changeset]"
+	}
+
+	# 2. Find for all relevant changeset their revisions and their
+	#    dependencies. Map the latter back to changesets and
+	#    construct the corresponding arcs.
+
+	set n 0
+	foreach cset $changesets {
+	    log progress 2 cyclebreaker $n $max
+	    foreach succ [$cset successors] {
+		# Changesets may have dependencies outside of the
+		# chosen set. These are ignored
+		if {![$dg node exists $succ]} continue
+		$dg arc insert $cset $succ
+		integrity assert {
+		    $succ ne $cset
+		} {[$cset reportloop 0]Changeset loop was not detected during creation}
+	    }
+	    incr n
+	}
+
+	if {$log} {
+	    log write 3 cyclebreaker "Has [nsp [llength [$dg arcs]] dependency dependencies]"
+	}
+
+	# Run the user hook to manipulate the graph before
+	# consummation.
+
+	if {$log} { Mark $dg -start }
+	MarkWatch $dg
+	PreHook   $dg
+	MarkWatch $dg
+	return  $dg
+    }
+
+    # Instead of searching the whole graph for the degree-0 nodes in
+    # each iteration we compute the list once to start, and then only
+    # update it incrementally based on the outgoing neighbours of the
+    # node chosen for commit.
+
+    proc InitializeCandidates {dg} {
+	# bottom = list (list (node, range min, range max))
+	::variable mybottom
+	foreach n [$dg nodes] {
+	    if {[$dg node degree -in $n]} continue
+	    lappend mybottom [linsert [$dg node get $n timerange] 0 $n]
+	}
+	ScheduleCandidates
+	ShowPendingNodes
+	return
+    }
+
+    proc WithoutPredecessor {dg nv} {
+	::variable mybottom
+
+	upvar 1 $nv n
+	if {![llength $mybottom]} { return 0 }
+
+	set n [lindex [lindex $mybottom 0] 0]
+	set mybottom [lrange $mybottom 1 end]
+	set changed 0
+
+	# Update list of nodes without predecessor, based on the
+	# outgoing neighbours of the chosen node. This should be
+	# faster than iterating of the whole set of nodes, finding all
+	# without predecessors, sorting them by time, etc. pp.
+	foreach out [$dg nodes -out $n] {
+	    if {[$dg node degree -in $out] > 1} continue
+	    # Degree-1 neighbour, will have no predecessors after the
+	    # removal of n. Put on the list.
+	    lappend mybottom [linsert [$dg node get $out timerange] 0 $out]
+	    set changed 1
+	}
+	if {$changed} {
+	    ScheduleCandidates
+	}
+
+	# We do not delete the node immediately, to allow the Save
+	# procedure to save the dependencies as well (encoded in the
+	# arcs).
+	return 1
+    }
+
+    proc ScheduleCandidates {} {
+	::variable mybottom
+	# Sort by cset object name, lower border of timerange, at last
+	# by the upper border.
+	set mybottom [lsort -index 2 -integer [lsort -index 1 -integer [lsort -index 0 -dict $mybottom]]]
+	return
+    }
+
+    proc ShowPendingNodes {} {
+	if {[log verbosity?] < 10} return
+	::variable mybottom
+	log write 10 cyclebreaker "Pending..............................."
+	foreach item [struct::list map $mybottom [myproc FormatPendingItem]] {
+	    log write 10 cyclebreaker "Pending:     $item"
+	}
+	return
+    }
+
+    proc FormatPendingItem {item} {
+	join [list [[lindex $item 0] str] [clock format [lindex $item 1]] [clock format [lindex $item 2]]]
+    }
+
+    proc FindCycle {dg} {
+	# This procedure is run if and only the graph is not empty and
+	# all nodes have predecessors. This means that each node is
+	# either part of a cycle or (indirectly) depending on a node
+	# in a cycle. We can start at an arbitrary node, follow its
+	# incoming edges to its predecessors until we see a node a
+	# second time. That node closes the cycle and the beginning is
+	# its first occurence. Note that we can choose an arbitrary
+	# predecessor of each node as well, we do not have to search.
+
+	# We record for each node the index of the first appearance in
+	# the path, making it easy at the end to cut the cycle from
+	# it.
+
+	# Choose arbitrary node to start our search at.
+	set start [lindex [$dg nodes] 0]
+
+	# Initialize state, path of seen nodes, and when seen.
+	set       path {}
+	array set seen {}
+
+	while {1} {
+	    # Stop searching when we have seen the current node
+	    # already, the circle has been closed.
+	    if {[info exists seen($start)]} break
+	    lappend path $start
+	    set seen($start) [expr {[llength $path]-1}]
+	    # Choose arbitrary predecessor
+	    set start [lindex [$dg nodes -in $start] 0]
+	}
+
+	return [struct::list reverse [lrange $path $seen($start) end]]
+    }
+
+    proc BreakSegment {dg path label} {
+	# The path, usually a cycle, we have gotten is broken by
+	# breaking apart one or more of the changesets in the
+	# cycle. This causes us to create one or more changesets which
+	# are to be committed, added to the graph, etc. pp.
+
+	set bestlink {}
+	set bestnode {}
+
+	foreach \
+	    prev [lrange $path 0 end-2] \
+	    cset [lrange $path 1 end-1] \
+	    next [lrange $path 2 end] {
+
+		# Each triple PREV -> CSET -> NEXT of changesets, a
+		# 'link' in the cycle, is analysed and the best
+		# location where to at least weaken the cycle is
+		# chosen for further processing.
+
+		set link [project::revlink %AUTO% $prev $cset $next]
+		if {$bestlink eq ""} {
+		    set bestlink $link
+		    set bestnode $cset
+		} elseif {[$link betterthan $bestlink]} {
+		    $bestlink destroy
+		    set bestlink $link
+		    set bestnode $cset
+		} else {
+		    $link destroy
+		}
+	    }
+
+	log write 5 cyclebreaker "Breaking $label by splitting changeset [$bestnode str]"
+	set ID [$bestnode id]
+	Mark $dg -${ID}-before
+
+	set newcsets [$bestlink break]
+	$bestlink destroy
+
+        # At this point the old changeset (BESTNODE) is gone
+        # already. We remove it from the graph as well and then enter
+        # the fragments generated for it.
+
+	Replace $dg $bestnode $newcsets
+
+	Mark $dg -${ID}-after
+	return
+    }
+
+    # TODO: This should be a graph method.
+    proc HasArc {dg a b} {
+	#8.5: return [expr {$b in [$dg nodes -out $a]}]
+	if {[lsearch -exact [$dg nodes -out $a] $b] < 0} { return 0 }
+	return 1
+    }
+
+    proc Mark {dg {suffix {}} {subgraph {}}} {
+	::variable mydotdestination
+	if {$mydotdestination eq ""} return
+	::variable mydotprefix
+	::variable mydotid
+	set fname $mydotdestination/${mydotprefix}${mydotid}${suffix}.dot
+	file mkdir [file dirname $fname]
+	dot write $dg $mydotprefix$suffix $fname $subgraph
+	incr mydotid
+
+	log write 5 cyclebreaker ".dot export $fname"
+	return
+    }
+
+    proc Replace {dg n replacements} {
+	# NOTE. We have to get the list of incoming neighbours and
+	# recompute their successors after the new nodes have been
+	# inserted. Their outgoing arcs will now go to one or both of
+	# the new nodes, and not redoing them may cause us to forget
+	# circles, leaving them in, unbroken.
+
+	set pre [$dg nodes -in $n]
+
+        $dg node delete $n
+
+	foreach cset $replacements {
+	    set tr [$cset timerange]
+	    $dg node insert $cset
+	    $dg node set    $cset timerange $tr
+	    $dg node set    $cset label     "[$cset str]\\n[join [struct::list map $tr {::clock format}] "\\n"]"
+	    $dg node set    $cset __id__    [$cset id]
+	    $dg node set    $cset shape     [expr {[$cset bysymbol]
+						   ? "ellipse"
+						   : "box"}]
+	}
+
+	foreach cset $replacements {
+	    foreach succ [$cset successors] {
+		# The new changesets may have dependencies outside of
+		# the chosen set. These are ignored
+		if {![$dg node exists $succ]} continue
+		$dg arc insert $cset $succ
+		integrity assert {
+		    $succ ne $cset
+		} {[$cset reportloop 0]Changeset loop was not detected during creation}
+	    }
+	}
+	foreach cset $pre {
+	    foreach succ [$cset successors] {
+		# Note that the arc may already exist in the graph. If
+		# so ignore it. The new changesets may have
+		# dependencies outside of the chosen set. These are
+		# ignored
+		if {![$dg node exists $succ]} continue
+		if {[HasArc $dg $cset $succ]} continue;# TODO should be graph method.
+		$dg arc insert $cset $succ
+	    }
+	}
+
+	return
+    }
+
+    # # ## ### ##### ######## #############
+    ## Callback invokation ...
+
+    proc PreHook {graph} {
+	# Give the user of the cycle breaker the opportunity to work
+	# with the graph between setup and consummation.
+
+	::variable myprecmd
+	if {![llength $myprecmd]} return
+
+	uplevel #0 [linsert $myprecmd end $graph]
+	Mark $graph -pre-done
+	return
+    }
+
+    proc ProcessedHook {dg cset pos} {
+	# Give the user of the cycle breaker the opportunity to work
+	# with the changeset before it is removed from the graph.
+
+	::variable mysavecmd
+	if {![llength $mysavecmd]} return
+
+	uplevel #0 [linsert $mysavecmd end $dg $pos $cset]
+	return
+    }
+
+    proc BreakCycleHook {graph} {
+	# Call out to the chosen algorithm for cycle breaking. Finding
+	# a cycle if no breaker was chosen is an error.
+
+	::variable mybreakcmd
+	if {![llength $mybreakcmd]} {
+	    trouble fatal "Found a cycle, expecting none."
+	    exit 1
+	}
+
+	uplevel #0 [linsert $mybreakcmd end $graph]
+	return
+    }
+
+    proc ClearHooks {} {
+	::variable myprecmd   {}
+	::variable mysavecmd  {}
+	::variable mybreakcmd {}
+	return
+    }
+
+    # # ## ### ##### ######## #############
+
+    proc MarkWatch {graph} {
+	::variable mywatchids
+	set watched [Watched $graph $mywatchids]
+	if {![llength $watched]} return
+	set neighbours [eval [linsert $watched 0 $graph nodes -adj]]
+	#foreach n $neighbours { log write 6 cyclebreaker "Neighbor [$n id] => $n" }
+	Mark $graph watched [concat $watched $neighbours]
+	return
+    }
+
+    proc Watched {graph watchids} {
+	set res {}
+	foreach id $watchids {
+	    set nl [$graph nodes -key __id__ -value $id]
+	    if {![llength $nl]} continue
+	    lappend res $nl
+	    #log write 6 breakrcycle "Watching $id => $nl"
+	    $graph node set $nl fontcolor red
+	}
+	return $res
+    }
+
+    # # ## ### ##### ######## #############
+
+
+    typevariable myat      0 ; # Counter for commit ids for the
+			       # changesets.
+    typevariable mybottom {} ; # List of the candidate nodes for
+			       # committing.
+
+    typevariable myprecmd   {} ; # Callback, change graph before walk.
+    typevariable mysavecmd  {} ; # Callback, for each processed node.
+    typevariable mybreakcmd {} ; # Callback, for each found cycle.
+
+    typevariable mydotdestination {} ; # Destination directory for the
+				       # generated .dot files.
+    typevariable mydotprefix      {} ; # Prefix for dot files when
+				       # exporting the graphs.
+    typevariable mydotid           0 ; # Counter for dot file name
+				       # generation.
+    typevariable mywatchids       {} ; # Changesets to watch the
+				       # neighbourhood of.
+
+    # # ## ### ##### ######## #############
+    ## Configuration
+
+    pragma -hasinstances   no ; # singleton
+    pragma -hastypeinfo    no ; # no introspection
+    pragma -hastypedestroy no ; # immortal
+
+    # # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::fossil::import::cvs {
+    namespace export cyclebreaker
+    namespace eval cyclebreaker {
+	namespace import ::vc::fossil::import::cvs::integrity
+	namespace eval project {
+	    namespace import ::vc::fossil::import::cvs::project::rev
+	    namespace import ::vc::fossil::import::cvs::project::revlink
+	}
+	namespace import ::vc::tools::misc::*
+	namespace import ::vc::tools::log
+	namespace import ::vc::tools::trouble
+	namespace import ::vc::tools::dot
+	log register cyclebreaker
+    }
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
+
+package provide vc::fossil::import::cvs::cyclebreaker 1.0
+return