84de38d73f 2007-10-10 aku: ## -*- tcl -*- 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Copyright (c) 2007 Andreas Kupries. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software is licensed as described in the file LICENSE, which 84de38d73f 2007-10-10 aku: # you should have received as part of this distribution. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software consists of voluntary contributions made by many 84de38d73f 2007-10-10 aku: # individuals. For exact contribution history, see the revision 84de38d73f 2007-10-10 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: ## Revisions per project, aka Changesets. These objects are first used 5f7acef887 2007-11-10 aku: ## in pass 5, which creates the initial set covering the repository. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Requirements 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: package require Tcl 8.4 ; # Required runtime. 5f7acef887 2007-11-10 aku: package require snit ; # OO system. 95af789e1f 2007-11-10 aku: package require vc::tools::log ; # User feedback. 5f7acef887 2007-11-10 aku: package require vc::fossil::import::cvs::state ; # State storage. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: snit::type ::vc::fossil::import::cvs::project::rev { 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Public API 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: constructor {project cstype srcid revisions} { 5f7acef887 2007-11-10 aku: set myid [incr mycounter] 5f7acef887 2007-11-10 aku: set myproject $project 5f7acef887 2007-11-10 aku: set mytype $cstype 5f7acef887 2007-11-10 aku: set mysrcid $srcid 5f7acef887 2007-11-10 aku: set myrevisions $revisions 5f7acef887 2007-11-10 aku: return 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: method id {} { return $myid } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: method breakinternaldependencies {cv} { 95af789e1f 2007-11-10 aku: upvar 2 $cv csets ; # simple-dispatch! 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # This method inspects the changesets for internal 95af789e1f 2007-11-10 aku: # dependencies. Nothing is done if there are no 95af789e1f 2007-11-10 aku: # such. Otherwise the changeset is split into a set of 95af789e1f 2007-11-10 aku: # fragments without internal dependencies, transforming the 95af789e1f 2007-11-10 aku: # internal dependencies into external ones. The new changesets 95af789e1f 2007-11-10 aku: # are added to the list of all changesets. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Actually at most one split is performed, resulting in at 95af789e1f 2007-11-10 aku: # most one additional fragment. It is the caller's 95af789e1f 2007-11-10 aku: # responsibility to spli the resulting fragments further. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # The code checks only sucessor dependencies, automatically 95af789e1f 2007-11-10 aku: # covering the predecessor dependencies as well (A sucessor 95af789e1f 2007-11-10 aku: # dependency a -> b is a predecessor dependency b -> a). 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Array of dependencies (parent -> child). This is pulled from 95af789e1f 2007-11-10 aku: # the state, and limited to successors within the changeset. 95af789e1f 2007-11-10 aku: array set dependencies {} 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: set theset ('[join $myrevisions {','}]') 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: foreach {rid child} [state run " 95af789e1f 2007-11-10 aku: SELECT R.rid, R.child 95af789e1f 2007-11-10 aku: FROM revision R 95af789e1f 2007-11-10 aku: WHERE R.rid IN $theset 95af789e1f 2007-11-10 aku: AND R.child IS NOT NULL 95af789e1f 2007-11-10 aku: AND R.child IN $theset 95af789e1f 2007-11-10 aku: UNION 95af789e1f 2007-11-10 aku: SELECT R.rid, R.dbchild 95af789e1f 2007-11-10 aku: FROM revision R 95af789e1f 2007-11-10 aku: WHERE R.rid IN $theset 95af789e1f 2007-11-10 aku: AND R.dbchild IS NOT NULL 95af789e1f 2007-11-10 aku: AND R.dbchild IN $theset 95af789e1f 2007-11-10 aku: UNION 95af789e1f 2007-11-10 aku: SELECT R.rid, B.brid 95af789e1f 2007-11-10 aku: FROM revision R, revisionbranchchildren B 95af789e1f 2007-11-10 aku: WHERE R.rid IN $theset 95af789e1f 2007-11-10 aku: AND R.rid = B.rid 95af789e1f 2007-11-10 aku: AND B.brid IN $theset 95af789e1f 2007-11-10 aku: "] { 95af789e1f 2007-11-10 aku: # Consider moving this to the integrity module. 95af789e1f 2007-11-10 aku: if {$rid == $child} { 95af789e1f 2007-11-10 aku: trouble internal "Revision $rid depends on itself." 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: set dependencies($rid) $child 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: if {![array size dependencies]} {return 0} ; # Nothing to break. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # We have internal dependencies to break. We now iterate over 95af789e1f 2007-11-10 aku: # all positions in the list (which is chronological, at least 95af789e1f 2007-11-10 aku: # as far as the timestamps are correct and unique) and 95af789e1f 2007-11-10 aku: # determine the best position for the break, by trying to 95af789e1f 2007-11-10 aku: # break as many dependencies as possible in one go. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # First we create a map of positions to make it easier to 95af789e1f 2007-11-10 aku: # determine whether a dependency cross a particular index. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: array set pos {} 95af789e1f 2007-11-10 aku: array set crossing {} 95af789e1f 2007-11-10 aku: set n 0 95af789e1f 2007-11-10 aku: foreach rev $myrevisions { 95af789e1f 2007-11-10 aku: set pos($rev) $n 95af789e1f 2007-11-10 aku: set crossing($n) 0 95af789e1f 2007-11-10 aku: incr n 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Secondly we count the crossings per position, by iterating 95af789e1f 2007-11-10 aku: # over the recorded internal dependencies. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: foreach {rid child} [array get dependencies] { 95af789e1f 2007-11-10 aku: set start $pos($rid) 95af789e1f 2007-11-10 aku: set end $pos($child) 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Note: If the timestamps are badly out of order it is 95af789e1f 2007-11-10 aku: # possible to have a backward successor dependency, 95af789e1f 2007-11-10 aku: # i.e. with start > end. We may have to swap the 95af789e1f 2007-11-10 aku: # indices to ensure that the following loop runs 95af789e1f 2007-11-10 aku: # correctly. 95af789e1f 2007-11-10 aku: # 95af789e1f 2007-11-10 aku: # Note 2: start == end is not possible. It indicates a 95af789e1f 2007-11-10 aku: # self-dependency due to the uniqueness of 95af789e1f 2007-11-10 aku: # positions, and that is something we have ruled 95af789e1f 2007-11-10 aku: # out already. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: if {$start > $end} { 95af789e1f 2007-11-10 aku: while {$end < $start} { incr crossing($end) ; incr end } 95af789e1f 2007-11-10 aku: } else { 95af789e1f 2007-11-10 aku: while {$start < $end} { incr crossing($start) ; incr start } 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Now we can determine the best break location. First we look 95af789e1f 2007-11-10 aku: # for the locations with the maximal number of crossings. If 95af789e1f 2007-11-10 aku: # there are several we look for the shortest time interval 95af789e1f 2007-11-10 aku: # among them. If we still have multiple possibilities after 95af789e1f 2007-11-10 aku: # that we select the smallest index among these. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: set max -1 95af789e1f 2007-11-10 aku: set best {} 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: foreach key [array names crossing] { 95af789e1f 2007-11-10 aku: set now $crossing($key) 95af789e1f 2007-11-10 aku: if {$now > $max} { 95af789e1f 2007-11-10 aku: set max $now 95af789e1f 2007-11-10 aku: set best $key 95af789e1f 2007-11-10 aku: continue 95af789e1f 2007-11-10 aku: } elseif {$now == $max} { 95af789e1f 2007-11-10 aku: lappend best $key 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: if {[llength $best] > 1} { 95af789e1f 2007-11-10 aku: set min -1 95af789e1f 2007-11-10 aku: set newbest {} 95af789e1f 2007-11-10 aku: foreach at $best { 95af789e1f 2007-11-10 aku: set rat [lindex $myrevisions $at] ; incr at 95af789e1f 2007-11-10 aku: set rnext [lindex $myrevisions $at] ; incr at -1 95af789e1f 2007-11-10 aku: set tat [lindex [state run {SELECT R.date FROM revision R WHERE R.rid = $rat }] 0] 95af789e1f 2007-11-10 aku: set tnext [lindex [state run {SELECT R.date FROM revision R WHERE R.rid = $rnext}] 0] 95af789e1f 2007-11-10 aku: set delta [expr {$tnext - $tat}] 95af789e1f 2007-11-10 aku: if {($min < 0) || ($delta < $min)} { 95af789e1f 2007-11-10 aku: set min $delta 95af789e1f 2007-11-10 aku: set newbest $at 95af789e1f 2007-11-10 aku: } elseif {$delta == $min} { 95af789e1f 2007-11-10 aku: lappend newbest $at 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: set best $newbest 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: if {[llength $best] > 1} { 95af789e1f 2007-11-10 aku: set best [lindex [lsort -integer -increasing $best] 0] 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # Now we can split off a fragment. 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: set bnext $best ; incr bnext 95af789e1f 2007-11-10 aku: set revbefore [lrange $myrevisions 0 $best] 95af789e1f 2007-11-10 aku: set revafter [lrange $myrevisions $bnext end] 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: if {![llength $revbefore]} { 95af789e1f 2007-11-10 aku: trouble internal "Tried to split off a zero-length fragment at the beginning" 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: if {![llength $revafter]} { 95af789e1f 2007-11-10 aku: trouble internal "Tried to split off a zero-length fragment at the end" 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: lappend csets [set new [$type %AUTO% $myproject $mytype $mysrcid $revafter]] 95af789e1f 2007-11-10 aku: set myrevisions $revbefore 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: log write 4 csets "Breaking <$myid> @$best, making <[$new id]>, cutting $crossing($best)" 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: #puts "\tKeeping <$revbefore>" 95af789e1f 2007-11-10 aku: #puts "\tSplit off <$revafter>" 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: return 1 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: method persist {} { 5f7acef887 2007-11-10 aku: set tid $mycstype($mytype) 5f7acef887 2007-11-10 aku: set pid [$myproject id] 5f7acef887 2007-11-10 aku: set pos 0 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: state transaction { 5f7acef887 2007-11-10 aku: state run { 5f7acef887 2007-11-10 aku: INSERT INTO changeset (cid, pid, type, src) 5f7acef887 2007-11-10 aku: VALUES ($myid, $pid, $tid, $mysrcid); 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: foreach rid $myrevisions { 5f7acef887 2007-11-10 aku: state run { 5f7acef887 2007-11-10 aku: INSERT INTO csrevision (cid, pos, rid) 5f7acef887 2007-11-10 aku: VALUES ($myid, $pos, $rid); 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: incr pos 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: } 84de38d73f 2007-10-10 aku: return 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## State 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: variable myid ; # Id of the cset for the persistent state. 5f7acef887 2007-11-10 aku: variable myproject ; # Reference of the project object the changeset belongs to. 5f7acef887 2007-11-10 aku: variable mytype ; # rev or sym, where the cset originated from. 5f7acef887 2007-11-10 aku: variable mysrcid ; # id of the metadata or symbol the cset is based on. 5f7acef887 2007-11-10 aku: variable myrevisions ; # List of the file level revisions in the cset. 5f7acef887 2007-11-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: typevariable mycounter 0 ; # Id counter for csets. 5f7acef887 2007-11-10 aku: typevariable mycstype -array {} ; # Map cstypes to persistent ids. 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: typemethod getcstypes {} { 5f7acef887 2007-11-10 aku: foreach {tid name} [state run { 5f7acef887 2007-11-10 aku: SELECT tid, name FROM cstype; 5f7acef887 2007-11-10 aku: }] { set mycstype($name) $tid } 5f7acef887 2007-11-10 aku: return 5f7acef887 2007-11-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Configuration 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: pragma -hastypeinfo no ; # no type introspection 84de38d73f 2007-10-10 aku: pragma -hasinfo no ; # no object introspection 84de38d73f 2007-10-10 aku: pragma -simpledispatch yes ; # simple fast dispatch 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: namespace eval ::vc::fossil::import::cvs::project { 84de38d73f 2007-10-10 aku: namespace export rev 5f7acef887 2007-11-10 aku: namespace eval rev { 5f7acef887 2007-11-10 aku: namespace import ::vc::fossil::import::cvs::state 95af789e1f 2007-11-10 aku: namespace import ::vc::tools::log 95af789e1f 2007-11-10 aku: log register csets 5f7acef887 2007-11-10 aku: } 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Ready 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package provide vc::fossil::import::cvs::project::rev 1.0 84de38d73f 2007-10-10 aku: return
File Annotation