72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: package require struct::set 72dac950c3 2007-09-26 aku: package require vc::cvs::ws::branch 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: namespace eval ::vc::cvs::ws::sig::branch { 72dac950c3 2007-09-26 aku: namespace import ::vc::cvs::ws::branch::* 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: # Save the mapping from changesets to file/rev signatures, and further 72dac950c3 2007-09-26 aku: # remember all the csets a specific file/rev combination belongs to. 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: proc ::vc::cvs::ws::sig::def {id parent added changed removed} { 72dac950c3 2007-09-26 aku: variable sig 72dac950c3 2007-09-26 aku: variable csl 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: array set new $sig($parent) 72dac950c3 2007-09-26 aku: array set new $added 72dac950c3 2007-09-26 aku: array set new $changed 72dac950c3 2007-09-26 aku: foreach {f r} $removed {catch {unset new($f)}} 72dac950c3 2007-09-26 aku: set sig($id) [DictSort [array get new]] 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: foreach {f r} [array get new] { 72dac950c3 2007-09-26 aku: lappend csl($f,$r) $id 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: return 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: proc ::vc::cvs::ws::sig::next {id added changed removed tag ts} { 72dac950c3 2007-09-26 aku: variable sig 72dac950c3 2007-09-26 aku: array set rev $sig($id) 72dac950c3 2007-09-26 aku: 7a64b9e738 2007-09-27 aku: #puts sig::next/$ts 72dac950c3 2007-09-26 aku: foreach {f r} [concat $changed $removed] { 7a64b9e738 2007-09-27 aku: if {![info exists rev($f)]} { 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # A file missing in the candidate parent changeset is 7a64b9e738 2007-09-27 aku: # _not_ a reason to reject it, at least not immediately. 7a64b9e738 2007-09-27 aku: # The code generating the timeline entries has only 7a64b9e738 2007-09-27 aku: # partial information and is prone to misclassify files 7a64b9e738 2007-09-27 aku: # added to branches as changed instead of added. Thus we 7a64b9e738 2007-09-27 aku: # move this file to the list of added things and check it 7a64b9e738 2007-09-27 aku: # again as part of that, see below. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: lappend added $f $r 7a64b9e738 2007-09-27 aku: continue 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: if {[branch::rootSuccessor $r $rev($f)]} continue 7a64b9e738 2007-09-27 aku: if {![branch::successor $r $rev($f)]} { 7a64b9e738 2007-09-27 aku: #puts "not-successor($r of $rev($f))" 72dac950c3 2007-09-26 aku: return 0 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: if {[llength $added]} { 72dac950c3 2007-09-26 aku: # Check that added files belong to the branch too! 72dac950c3 2007-09-26 aku: if {$tag ne [branch::has $ts $added]} { 7a64b9e738 2007-09-27 aku: #puts "not-added-into-same-branch" 72dac950c3 2007-09-26 aku: return 0 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: return 1 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: proc ::vc::cvs::ws::sig::find {id sig} { 72dac950c3 2007-09-26 aku: set cslist [Cut $id [Find $sig]] 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: if {[llength $cslist] < 1} { 72dac950c3 2007-09-26 aku: puts "NO ROOT" 72dac950c3 2007-09-26 aku: # Deal how? 72dac950c3 2007-09-26 aku: # - Abort 72dac950c3 2007-09-26 aku: # - Ignore this changeset and try the next one 72dac950c3 2007-09-26 aku: # (Which has higher probability of not matching as it might 72dac950c3 2007-09-26 aku: # be the successor in the branch to this cset and not a base). 72dac950c3 2007-09-26 aku: exit 72dac950c3 2007-09-26 aku: } elseif {[llength $cslist] > 1} { 72dac950c3 2007-09-26 aku: puts "AMBIGOUS. Following csets match root requirements:" 72dac950c3 2007-09-26 aku: # Deal how? S.a. 72dac950c3 2007-09-26 aku: puts \t[join $cslist \n\t] 72dac950c3 2007-09-26 aku: exit 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: set r [lindex $cslist 0] 72dac950c3 2007-09-26 aku: #puts "ROOT = $r" 72dac950c3 2007-09-26 aku: return $r 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: proc ::vc::cvs::ws::sig::Cut {id cslist} { 72dac950c3 2007-09-26 aku: # Changesets have to be before id! This makes for another 72dac950c3 2007-09-26 aku: # intersection, programmatic. 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: set res {} 72dac950c3 2007-09-26 aku: foreach c $cslist { 72dac950c3 2007-09-26 aku: if {$c >= $id} continue 72dac950c3 2007-09-26 aku: lappend res $c 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: return $res 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: proc ::vc::cvs::ws::sig::Find {sig} { 72dac950c3 2007-09-26 aku: # Locate all changesets which contain the given signature. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # First we try to the exact changeset, by intersecting the 7a64b9e738 2007-09-27 aku: # live-intervals for all file revisions found in the 7a64b9e738 2007-09-27 aku: # signature. This however may fail, as CVS is able to contain 7a64b9e738 2007-09-27 aku: # a-causal branch definitions. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # Example: sqlite, branch "gdbm-branch". 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # File 'db.c', branch 1.6.2, root 1.6, entered on Jan 31, 2001. 7a64b9e738 2007-09-27 aku: # Then 'dbbegdbm.c', 1.1.2, root 1.1, entered on Oct 19, 2000. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # More pertinent, revision 1.2 was entered Jan 13, 2001, 7a64b9e738 2007-09-27 aku: # i.e. existed before Jan 31, before the branchwas actually 7a64b9e738 2007-09-27 aku: # made. Thus it is unclear why 1.1 is in the branch instead. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # An alternative complementary question would be how db.c 1.6 7a64b9e738 2007-09-27 aku: # ended up in a branch tag created before Jan 13, when this 7a64b9e738 2007-09-27 aku: # revision did not exist yet. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # So, CVS repositories can be a-causal when it comes to branches, 7a64b9e738 2007-09-27 aku: # at least in the details. Therefore while try for an exact result 7a64b9e738 2007-09-27 aku: # first we do not fail if that fails, but use a voting scheme as 7a64b9e738 2007-09-27 aku: # fallback which answers the question about which changeset is 7a64b9e738 2007-09-27 aku: # acceptable to the most file revisions in the signature. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # Note that multiple changesets are ok at this level and are 7a64b9e738 2007-09-27 aku: # simply returned. 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: set res [Intersect $sig] 7a64b9e738 2007-09-27 aku: puts Exact=($res) 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: if {[llength $res]} { return $res } 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: set res [Vote $sig] 7a64b9e738 2007-09-27 aku: puts Vote=($res) 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: return $res 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: proc ::vc::cvs::ws::sig::Intersect {sig} { 72dac950c3 2007-09-26 aku: variable csl 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: set res {} 72dac950c3 2007-09-26 aku: set first 1 72dac950c3 2007-09-26 aku: foreach {f r} $sig { 72dac950c3 2007-09-26 aku: #puts $f/$r? 72dac950c3 2007-09-26 aku: # Unknown file not used anywhere 72dac950c3 2007-09-26 aku: if {![info exists csl($f,$r)]} {return {}} 7a64b9e738 2007-09-27 aku: #puts $f/$r\t=\t($csl($f,$r))*($res)/$first 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: if {$first} { 72dac950c3 2007-09-26 aku: set res $csl($f,$r) 72dac950c3 2007-09-26 aku: set first 0 72dac950c3 2007-09-26 aku: #puts F($res) 72dac950c3 2007-09-26 aku: } else { 7a64b9e738 2007-09-27 aku: set res [struct::set intersect $res $csl($f,$r)] 72dac950c3 2007-09-26 aku: #puts R($res) 7a64b9e738 2007-09-27 aku: if {![llength $res]} {return {}} 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: return $res 72dac950c3 2007-09-26 aku: } 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: proc ::vc::cvs::ws::sig::Vote {sig} { 7a64b9e738 2007-09-27 aku: variable csl 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # I. Accumulate votes. 7a64b9e738 2007-09-27 aku: array set v {} 7a64b9e738 2007-09-27 aku: foreach {f r} $sig { 7a64b9e738 2007-09-27 aku: # Unknown revisions do not vote. 7a64b9e738 2007-09-27 aku: if {![info exists csl($f,$r)]} continue 7a64b9e738 2007-09-27 aku: foreach c $csl($f,$r) { 7a64b9e738 2007-09-27 aku: if {[info exists v($c)]} { 7a64b9e738 2007-09-27 aku: incr v($c) 7a64b9e738 2007-09-27 aku: } else { 7a64b9e738 2007-09-27 aku: set v($c) 1 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # Invert index for easier finding the max, compute the max at the 7a64b9e738 2007-09-27 aku: # same time. 7a64b9e738 2007-09-27 aku: array set tally {} 7a64b9e738 2007-09-27 aku: set max -1 7a64b9e738 2007-09-27 aku: foreach {c n} [array get v] { 7a64b9e738 2007-09-27 aku: lappend tally($n) $c 7a64b9e738 2007-09-27 aku: if {$n > $max} {set max $n} 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: #parray tally 7a64b9e738 2007-09-27 aku: puts Max=$max 7a64b9e738 2007-09-27 aku: 7a64b9e738 2007-09-27 aku: # Return the changesets having the most votes. 7a64b9e738 2007-09-27 aku: return $tally($max) 7a64b9e738 2007-09-27 aku: } 7a64b9e738 2007-09-27 aku: 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: proc ::vc::cvs::ws::sig::DictSort {dict} { 72dac950c3 2007-09-26 aku: array set a $dict 72dac950c3 2007-09-26 aku: set r {} 72dac950c3 2007-09-26 aku: foreach k [lsort [array names a]] { 72dac950c3 2007-09-26 aku: lappend r $k $a($k) 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: return $r 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: namespace eval ::vc::cvs::ws::sig { 72dac950c3 2007-09-26 aku: variable sig ; # cset id -> signature 72dac950c3 2007-09-26 aku: array set sig {{} {}} 72dac950c3 2007-09-26 aku: variable csl ; # file x rev -> list (cset id) 72dac950c3 2007-09-26 aku: array set csl {} 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: namespace export def find next 72dac950c3 2007-09-26 aku: } 72dac950c3 2007-09-26 aku: 72dac950c3 2007-09-26 aku: package provide vc::cvs::ws::sig 1.0 72dac950c3 2007-09-26 aku: return
File Annotation