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. 08ebab80cd 2007-11-10 aku: package require vc::tools::misc ; # Text formatting 08ebab80cd 2007-11-10 aku: package require vc::tools::trouble ; # Error reporting. 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. 47d52d1efd 2007-11-28 aku: package require vc::fossil::import::cvs::integrity ; # State integrity checks. 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: 65be27aa69 2007-11-22 aku: constructor {project cstype srcid revisions {theid {}}} { 65be27aa69 2007-11-22 aku: if {$theid ne ""} { 65be27aa69 2007-11-22 aku: set myid $theid 65be27aa69 2007-11-22 aku: } else { 65be27aa69 2007-11-22 aku: set myid [incr mycounter] 65be27aa69 2007-11-22 aku: } 65be27aa69 2007-11-22 aku: c74fe3de3f 2007-11-29 aku: integrity assert {[info exists mycstype($cstype)]} {Bad changeset type '$cstype'.} c74fe3de3f 2007-11-29 aku: 5f7acef887 2007-11-10 aku: set myproject $project 5f7acef887 2007-11-10 aku: set mytype $cstype c74fe3de3f 2007-11-29 aku: set mytypeobj ::vc::fossil::import::cvs::project::rev::${cstype} 5f7acef887 2007-11-10 aku: set mysrcid $srcid 5f7acef887 2007-11-10 aku: set myrevisions $revisions de4cff4142 2007-11-22 aku: set mypos {} ; # Commit location is not known yet. 85bd219d0b 2007-11-13 aku: 85bd219d0b 2007-11-13 aku: # Keep track of the generated changesets and of the inverse 85bd219d0b 2007-11-13 aku: # mapping from revisions to them. de4cff4142 2007-11-22 aku: lappend mychangesets $self de4cff4142 2007-11-22 aku: set myidmap($myid) $self 0fcfbf7828 2007-11-29 aku: foreach r $revisions { 0fcfbf7828 2007-11-29 aku: set key [list $cstype $id] 0fcfbf7828 2007-11-29 aku: set myrevmap($key) $self 0fcfbf7828 2007-11-29 aku: lappend mytitems $key 0fcfbf7828 2007-11-29 aku: } 911d56a8c8 2007-11-27 aku: return 911d56a8c8 2007-11-27 aku: } 911d56a8c8 2007-11-27 aku: 911d56a8c8 2007-11-27 aku: method str {} { 911d56a8c8 2007-11-27 aku: set str "<" 911d56a8c8 2007-11-27 aku: set detail "" 70d2283564 2007-11-29 aku: if {[$mytypeobj bysymbol]} { 70d2283564 2007-11-29 aku: set detail " '[state one { 70d2283564 2007-11-29 aku: SELECT S.name 70d2283564 2007-11-29 aku: FROM symbol S 911d56a8c8 2007-11-27 aku: WHERE S.sid = $mysrcid 70d2283564 2007-11-29 aku: }]'" 911d56a8c8 2007-11-27 aku: } 911d56a8c8 2007-11-27 aku: append str "$mytype ${myid}${detail}>" 911d56a8c8 2007-11-27 aku: return $str 85bd219d0b 2007-11-13 aku: } 85bd219d0b 2007-11-13 aku: 85bd219d0b 2007-11-13 aku: method id {} { return $myid } 0fcfbf7828 2007-11-29 aku: method revisions {} { return $mytitems } 94c39d6375 2007-11-14 aku: method data {} { return [list $myproject $mytype $mysrcid] } 94c39d6375 2007-11-14 aku: c74fe3de3f 2007-11-29 aku: delegate method bysymbol to mytypeobj c74fe3de3f 2007-11-29 aku: delegate method byrevision to mytypeobj c74fe3de3f 2007-11-29 aku: delegate method isbranch to mytypeobj c74fe3de3f 2007-11-29 aku: delegate method istag to mytypeobj de4cff4142 2007-11-22 aku: de4cff4142 2007-11-22 aku: method setpos {p} { set mypos $p ; return } de4cff4142 2007-11-22 aku: method pos {} { return $mypos } de4cff4142 2007-11-22 aku: 0fcfbf7828 2007-11-29 aku: # result = dict (item -> list (changeset)) e50f9ed55e 2007-11-22 aku: method successormap {} { e50f9ed55e 2007-11-22 aku: # NOTE / FUTURE: Possible bottleneck. e50f9ed55e 2007-11-22 aku: array set tmp {} e50f9ed55e 2007-11-22 aku: foreach {rev children} [$self nextmap] { e50f9ed55e 2007-11-22 aku: foreach child $children { 8c9030e3e8 2007-11-24 aku: # 8.5 lappend tmp($rev) {*}$myrevmap($child) 8c9030e3e8 2007-11-24 aku: foreach cset $myrevmap($child) { 8c9030e3e8 2007-11-24 aku: lappend tmp($rev) $cset 8c9030e3e8 2007-11-24 aku: } e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: set tmp($rev) [lsort -unique $tmp($rev)] e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: return [array get tmp] e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: 0fcfbf7828 2007-11-29 aku: # result = list (changeset) 85bd219d0b 2007-11-13 aku: method successors {} { 85bd219d0b 2007-11-13 aku: # NOTE / FUTURE: Possible bottleneck. 85bd219d0b 2007-11-13 aku: set csets {} 94c39d6375 2007-11-14 aku: foreach {_ children} [$self nextmap] { 94c39d6375 2007-11-14 aku: foreach child $children { 8c9030e3e8 2007-11-24 aku: # 8.5 lappend csets {*}$myrevmap($child) 8c9030e3e8 2007-11-24 aku: foreach cset $myrevmap($child) { 8c9030e3e8 2007-11-24 aku: lappend csets $cset 8c9030e3e8 2007-11-24 aku: } 94c39d6375 2007-11-14 aku: } 85bd219d0b 2007-11-13 aku: } 85bd219d0b 2007-11-13 aku: return [lsort -unique $csets] 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 0fcfbf7828 2007-11-29 aku: # result = dict (item -> list (changeset)) e50f9ed55e 2007-11-22 aku: method predecessormap {} { e50f9ed55e 2007-11-22 aku: # NOTE / FUTURE: Possible bottleneck. e50f9ed55e 2007-11-22 aku: array set tmp {} e50f9ed55e 2007-11-22 aku: foreach {rev children} [$self premap] { e50f9ed55e 2007-11-22 aku: foreach child $children { 8c9030e3e8 2007-11-24 aku: # 8.5 lappend tmp($rev) {*}$myrevmap($child) 8c9030e3e8 2007-11-24 aku: foreach cset $myrevmap($child) { 8c9030e3e8 2007-11-24 aku: lappend tmp($rev) $cset 8c9030e3e8 2007-11-24 aku: } e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: set tmp($rev) [lsort -unique $tmp($rev)] e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: return [array get tmp] e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: 0fcfbf7828 2007-11-29 aku: # item -> list (item) 94c39d6375 2007-11-14 aku: method nextmap {} { 94c39d6375 2007-11-14 aku: if {[llength $mynextmap]} { return $mynextmap } c74fe3de3f 2007-11-29 aku: $mytypeobj successors tmp $myrevisions 94c39d6375 2007-11-14 aku: set mynextmap [array get tmp] 94c39d6375 2007-11-14 aku: return $mynextmap e50f9ed55e 2007-11-22 aku: } e50f9ed55e 2007-11-22 aku: 0fcfbf7828 2007-11-29 aku: # item -> list (item) e50f9ed55e 2007-11-22 aku: method premap {} { e50f9ed55e 2007-11-22 aku: if {[llength $mypremap]} { return $mypremap } c74fe3de3f 2007-11-29 aku: $mytypeobj predecessors tmp $myrevisions e50f9ed55e 2007-11-22 aku: set mypremap [array get tmp] e50f9ed55e 2007-11-22 aku: return $mypremap 85bd219d0b 2007-11-13 aku: } 24c0b662de 2007-11-13 aku: 24c0b662de 2007-11-13 aku: method breakinternaldependencies {} { 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: 08ebab80cd 2007-11-10 aku: # We perform all necessary splits in one go, instead of only 08ebab80cd 2007-11-10 aku: # one. The previous algorithm, adapted from cvs2svn, computed 08ebab80cd 2007-11-10 aku: # a lot of state which was thrown away and then computed again 08ebab80cd 2007-11-10 aku: # for each of the fragments. It should be easier to update and 08ebab80cd 2007-11-10 aku: # reuse that state. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # The code checks only sucessor dependencies, as this 08ebab80cd 2007-11-10 aku: # automatically covers the predecessor dependencies as well (A 08ebab80cd 2007-11-10 aku: # successor dependency a -> b is also a predecessor dependency 08ebab80cd 2007-11-10 aku: # 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. 08ebab80cd 2007-11-10 aku: 95af789e1f 2007-11-10 aku: array set dependencies {} c74fe3de3f 2007-11-29 aku: $mytypeobj internalsuccessors dependencies $myrevisions 95af789e1f 2007-11-10 aku: if {![array size dependencies]} {return 0} ; # Nothing to break. 08ebab80cd 2007-11-10 aku: 911d56a8c8 2007-11-27 aku: log write 5 csets ...[$self str]....................................................... 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 08ebab80cd 2007-11-10 aku: # break as many dependencies as possible in one go. When a 08ebab80cd 2007-11-10 aku: # break was found this is redone for the fragments coming and 08ebab80cd 2007-11-10 aku: # after, after upding the crossing information. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Data structures: 08ebab80cd 2007-11-10 aku: # Map: POS revision id -> position in list. 08ebab80cd 2007-11-10 aku: # CROSS position in list -> number of dependencies crossing it 08ebab80cd 2007-11-10 aku: # DEPC dependency -> positions it crosses 08ebab80cd 2007-11-10 aku: # List: RANGE Of the positions itself. 08ebab80cd 2007-11-10 aku: # A dependency is a single-element map parent -> child 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: InitializeBreakState $myrevisions 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set fragments {} 08ebab80cd 2007-11-10 aku: set pending [list $range] 08ebab80cd 2007-11-10 aku: set at 0 08ebab80cd 2007-11-10 aku: array set breaks {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: while {$at < [llength $pending]} { 08ebab80cd 2007-11-10 aku: set current [lindex $pending $at] 08ebab80cd 2007-11-10 aku: 47d52d1efd 2007-11-28 aku: log write 6 csets {. . .. ... ..... ........ .............} 47d52d1efd 2007-11-28 aku: log write 6 csets {Scheduled [join [PRs [lrange $pending $at end]] { }]} 47d52d1efd 2007-11-28 aku: log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set best [FindBestBreak $current] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$best < 0} { 08ebab80cd 2007-11-10 aku: # The inspected range has no internal 08ebab80cd 2007-11-10 aku: # dependencies. This is a complete fragment. 08ebab80cd 2007-11-10 aku: lappend fragments $current 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets "No breaks, final" 95af789e1f 2007-11-10 aku: } else { 08ebab80cd 2007-11-10 aku: # Split the range and schedule the resulting fragments 08ebab80cd 2007-11-10 aku: # for further inspection. Remember the number of 08ebab80cd 2007-11-10 aku: # dependencies cut before we remove them from 08ebab80cd 2007-11-10 aku: # consideration, for documentation later. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set breaks($best) $cross($best) 08ebab80cd 2007-11-10 aku: 96b7bfb834 2007-11-16 aku: log write 6 csets "Best break @ $best, cutting [nsp $cross($best) dependency dependencies]" 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: The value of best is an abolute location in 08ebab80cd 2007-11-10 aku: # myrevisions. Use the start of current to make it an 08ebab80cd 2007-11-10 aku: # index absolute to current. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set brel [expr {$best - [lindex $current 0]}] 08ebab80cd 2007-11-10 aku: set bnext $brel ; incr bnext 08ebab80cd 2007-11-10 aku: set fragbefore [lrange $current 0 $brel] 08ebab80cd 2007-11-10 aku: set fragafter [lrange $current $bnext end] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]" 08ebab80cd 2007-11-10 aku: 47d52d1efd 2007-11-28 aku: integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning} 47d52d1efd 2007-11-28 aku: integrity assert {[llength $fragafter]} {Found zero-length fragment at the end} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: lappend pending $fragbefore $fragafter 08ebab80cd 2007-11-10 aku: CutAt $best 95af789e1f 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: incr at 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: log write 6 csets ". . .. ... ..... ........ ............." 17ec2d682c 2007-11-24 aku: 17ec2d682c 2007-11-24 aku: # (*) We clear out the associated part of the myrevmap 17ec2d682c 2007-11-24 aku: # in-memory index in preparation for new data. A simple unset 17ec2d682c 2007-11-24 aku: # is enough, we have no symbol changesets at this time, and 17ec2d682c 2007-11-24 aku: # thus never more than one reference in the list. 17ec2d682c 2007-11-24 aku: 0fcfbf7828 2007-11-29 aku: foreach r $myrevisions { 0fcfbf7828 2007-11-29 aku: set key [list $mytype $r] 0fcfbf7828 2007-11-29 aku: unset myrevmap($key) 0fcfbf7828 2007-11-29 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Create changesets for the fragments, reusing the current one 08ebab80cd 2007-11-10 aku: # for the first fragment. We sort them in order to allow 08ebab80cd 2007-11-10 aku: # checking for gaps and nice messages. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set fragments [lsort -index 0 -integer $fragments] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: #puts \t.[join [PRs $fragments] .\n\t.]. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: Border [lindex $fragments 0] firsts firste 08ebab80cd 2007-11-10 aku: 47d52d1efd 2007-11-28 aku: integrity assert {$firsts == 0} {Bad fragment start @ $firsts, gap, or before beginning of the range} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set laste $firste 08ebab80cd 2007-11-10 aku: foreach fragment [lrange $fragments 1 end] { 08ebab80cd 2007-11-10 aku: Border $fragment s e 47d52d1efd 2007-11-28 aku: integrity assert {$laste == ($s - 1)} {Bad fragment border <$laste | $s>, gap or overlap} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myrevisions $s $e]] 24c0b662de 2007-11-13 aku: 87cf609021 2007-11-24 aku: log write 4 csets "Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)" 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set laste $e 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 47d52d1efd 2007-11-28 aku: integrity assert { 47d52d1efd 2007-11-28 aku: $laste == ([llength $myrevisions]-1) 47d52d1efd 2007-11-28 aku: } {Bad fragment end @ $laste, gap, or beyond end of the range} 17ec2d682c 2007-11-24 aku: 17ec2d682c 2007-11-24 aku: # Put the first fragment into the current changeset, and 17ec2d682c 2007-11-24 aku: # update the in-memory index. We can simply (re)add the 17ec2d682c 2007-11-24 aku: # revisions because we cleared the previously existing 17ec2d682c 2007-11-24 aku: # information, see (*) above. Persistence does not matter 17ec2d682c 2007-11-24 aku: # here, none of the changesets has been saved to the 17ec2d682c 2007-11-24 aku: # persistent state yet. 17ec2d682c 2007-11-24 aku: 08ebab80cd 2007-11-10 aku: set myrevisions [lrange $myrevisions 0 $firste] 0fcfbf7828 2007-11-29 aku: foreach r $myrevisions { 0fcfbf7828 2007-11-29 aku: set key [list $mytype $r] 0fcfbf7828 2007-11-29 aku: set myrevmap($key) $self 0fcfbf7828 2007-11-29 aku: } 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: } 5f7acef887 2007-11-10 aku: return 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: c74fe3de3f 2007-11-29 aku: method timerange {} { return [$mytypeobj timerange $myrevisions] } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: method drop {} { 94c39d6375 2007-11-14 aku: state transaction { 94c39d6375 2007-11-14 aku: state run { 94c39d6375 2007-11-14 aku: DELETE FROM changeset WHERE cid = $myid; 94c39d6375 2007-11-14 aku: DELETE FROM csrevision WHERE cid = $myid; 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: } 8c9030e3e8 2007-11-24 aku: foreach r $myrevisions { 0fcfbf7828 2007-11-29 aku: set key [list $mytype $r] 0fcfbf7828 2007-11-29 aku: unset myrevmap($key) 8c9030e3e8 2007-11-24 aku: } 94c39d6375 2007-11-14 aku: set pos [lsearch -exact $mychangesets $self] 94c39d6375 2007-11-14 aku: set mychangesets [lreplace $mychangesets $pos $pos] 94c39d6375 2007-11-14 aku: return 59207428e2 2007-11-22 aku: } 59207428e2 2007-11-22 aku: 59207428e2 2007-11-22 aku: typemethod split {cset args} { 59207428e2 2007-11-22 aku: # As part of the creation of the new changesets specified in 59207428e2 2007-11-22 aku: # ARGS as sets of revisions, all subsets of CSET's revision 59207428e2 2007-11-22 aku: # set, CSET will be dropped from all databases, in and out of 59207428e2 2007-11-22 aku: # memory, and then destroyed. 0fcfbf7828 2007-11-29 aku: # 0fcfbf7828 2007-11-29 aku: # Note: The item lists found in args are tagged items. They 0fcfbf7828 2007-11-29 aku: # have to have the same type as the changeset, being subsets 0fcfbf7828 2007-11-29 aku: # of its items. This is checked in Untag1. 59207428e2 2007-11-22 aku: 59207428e2 2007-11-22 aku: struct::list assign [$cset data] project cstype cssrc 59207428e2 2007-11-22 aku: 59207428e2 2007-11-22 aku: $cset drop 59207428e2 2007-11-22 aku: $cset destroy 59207428e2 2007-11-22 aku: 59207428e2 2007-11-22 aku: set newcsets {} 59207428e2 2007-11-22 aku: foreach fragmentrevisions $args { 47d52d1efd 2007-11-28 aku: integrity assert { 47d52d1efd 2007-11-28 aku: [llength $fragmentrevisions] 47d52d1efd 2007-11-28 aku: } {Attempted to create an empty changeset, i.e. without revisions} 0fcfbf7828 2007-11-29 aku: lappend newcsets [$type %AUTO% $project $cstype $cssrc \ 0fcfbf7828 2007-11-29 aku: [Untag $fragmentrevisions $cstype]] 59207428e2 2007-11-22 aku: } 59207428e2 2007-11-22 aku: 59207428e2 2007-11-22 aku: foreach c $newcsets { $c persist } 59207428e2 2007-11-22 aku: return $newcsets 87cf609021 2007-11-24 aku: } 87cf609021 2007-11-24 aku: 87cf609021 2007-11-24 aku: typemethod strlist {changesets} { 87cf609021 2007-11-24 aku: return [join [struct::list map $changesets [myproc ID]]] 87cf609021 2007-11-24 aku: } 87cf609021 2007-11-24 aku: 87cf609021 2007-11-24 aku: proc ID {cset} { $cset str } 87cf609021 2007-11-24 aku: 0fcfbf7828 2007-11-29 aku: proc Untag {taggeditems cstype} { 0fcfbf7828 2007-11-29 aku: return [struct::list map $taggeditems [myproc Untag1 $cstype]] 0fcfbf7828 2007-11-29 aku: } 0fcfbf7828 2007-11-29 aku: 0fcfbf7828 2007-11-29 aku: proc Untag1 {cstype theitem} { 0fcfbf7828 2007-11-29 aku: struct::list assign $theitem t i 0fcfbf7828 2007-11-29 aku: integrity assert {$cstype eq $t} {Item $i's type is '$t', expected '$cstype'} 0fcfbf7828 2007-11-29 aku: return $i 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: 94c39d6375 2007-11-14 aku: variable myid {} ; # Id of the cset for the persistent 94c39d6375 2007-11-14 aku: # state. 94c39d6375 2007-11-14 aku: variable myproject {} ; # Reference of the project object the 94c39d6375 2007-11-14 aku: # changeset belongs to. c74fe3de3f 2007-11-29 aku: variable mytype {} ; # What the changeset is based on c74fe3de3f 2007-11-29 aku: # (revisions, tags, or branches). c74fe3de3f 2007-11-29 aku: # Values: See mycstype. Note that we c74fe3de3f 2007-11-29 aku: # have to keep the names of the helper c74fe3de3f 2007-11-29 aku: # singletons in sync with the contents c74fe3de3f 2007-11-29 aku: # of state table 'cstype', and various c74fe3de3f 2007-11-29 aku: # other places using them hardwired. c74fe3de3f 2007-11-29 aku: variable mytypeobj {} ; # Reference to the container for the c74fe3de3f 2007-11-29 aku: # type dependent code. Derived from c74fe3de3f 2007-11-29 aku: # mytype. 94c39d6375 2007-11-14 aku: variable mysrcid {} ; # Id of the metadata or symbol the cset 94c39d6375 2007-11-14 aku: # is based on. 0fcfbf7828 2007-11-29 aku: variable myrevisions {} ; # List of the file level revisions, 0fcfbf7828 2007-11-29 aku: # tags, or branches in the cset, as 0fcfbf7828 2007-11-29 aku: # ids. Not tagged. 0fcfbf7828 2007-11-29 aku: variable mytitems {} ; # As myrevisions, the tagged form. 0fcfbf7828 2007-11-29 aku: variable mypremap {} ; # Dictionary mapping from the items (tagged now) 0fcfbf7828 2007-11-29 aku: # to their predecessors, also tagged. A 0fcfbf7828 2007-11-29 aku: # cache to avoid loading this from the 0fcfbf7828 2007-11-29 aku: # state more than once. 0fcfbf7828 2007-11-29 aku: variable mynextmap {} ; # Dictionary mapping from the items (tagged) 0fcfbf7828 2007-11-29 aku: # to their successors (also tagged). A 0fcfbf7828 2007-11-29 aku: # cache to avoid loading this from the 0fcfbf7828 2007-11-29 aku: # state more than once. de4cff4142 2007-11-22 aku: variable mypos {} ; # Commit position of the changeset, if de4cff4142 2007-11-22 aku: # known. 5f7acef887 2007-11-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods 84de38d73f 2007-10-10 aku: 70d2283564 2007-11-29 aku: typevariable mycounter 0 ; # Id counter for csets. Last id 70d2283564 2007-11-29 aku: # used. c74fe3de3f 2007-11-29 aku: typevariable mycstype -array {} ; # Map cstypes (names) to persistent c74fe3de3f 2007-11-29 aku: # ids. Note that we have to keep c74fe3de3f 2007-11-29 aku: # the names in the table 'cstype' c74fe3de3f 2007-11-29 aku: # in sync with the names of the c74fe3de3f 2007-11-29 aku: # helper singletons. 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: } 5f7acef887 2007-11-10 aku: 770a9b576a 2007-11-16 aku: typemethod loadcounter {} { 770a9b576a 2007-11-16 aku: # Initialize the counter from the state 96b7bfb834 2007-11-16 aku: set mycounter [state one { SELECT MAX(cid) FROM changeset }] 770a9b576a 2007-11-16 aku: return 770a9b576a 2007-11-16 aku: } 770a9b576a 2007-11-16 aku: 96167b2a48 2007-11-25 aku: typemethod num {} { return $mycounter } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc InitializeBreakState {revisions} { 08ebab80cd 2007-11-10 aku: upvar 1 pos pos cross cross range range depc depc delta delta \ 08ebab80cd 2007-11-10 aku: dependencies dependencies 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # First we create a map of positions to make it easier to 08ebab80cd 2007-11-10 aku: # determine whether a dependency crosses a particular index. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: array set pos {} 08ebab80cd 2007-11-10 aku: array set cross {} 08ebab80cd 2007-11-10 aku: array set depc {} 08ebab80cd 2007-11-10 aku: set range {} 08ebab80cd 2007-11-10 aku: set n 0 08ebab80cd 2007-11-10 aku: foreach rev $revisions { 08ebab80cd 2007-11-10 aku: lappend range $n 08ebab80cd 2007-11-10 aku: set pos($rev) $n 08ebab80cd 2007-11-10 aku: set cross($n) 0 08ebab80cd 2007-11-10 aku: incr n 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Secondly we count the crossings per position, by iterating 08ebab80cd 2007-11-10 aku: # over the recorded internal dependencies. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: If the timestamps are badly out of order it is 08ebab80cd 2007-11-10 aku: # possible to have a backward successor dependency, 08ebab80cd 2007-11-10 aku: # i.e. with start > end. We may have to swap the indices 08ebab80cd 2007-11-10 aku: # to ensure that the following loop runs correctly. 08ebab80cd 2007-11-10 aku: # 08ebab80cd 2007-11-10 aku: # Note 2: start == end is not possible. It indicates a 08ebab80cd 2007-11-10 aku: # self-dependency due to the uniqueness of positions, 08ebab80cd 2007-11-10 aku: # and that is something we have ruled out already, see 70d2283564 2007-11-29 aku: # 'rev internalsuccessors'. 678765068d 2007-11-27 aku: 678765068d 2007-11-27 aku: foreach {rid children} [array get dependencies] { 678765068d 2007-11-27 aku: foreach child $children { 678765068d 2007-11-27 aku: set dkey [list $rid $child] 678765068d 2007-11-27 aku: set start $pos($rid) 678765068d 2007-11-27 aku: set end $pos($child) 678765068d 2007-11-27 aku: set crosses {} 678765068d 2007-11-27 aku: 678765068d 2007-11-27 aku: if {$start > $end} { 678765068d 2007-11-27 aku: while {$end < $start} { 678765068d 2007-11-27 aku: lappend crosses $end 678765068d 2007-11-27 aku: incr cross($end) 678765068d 2007-11-27 aku: incr end 678765068d 2007-11-27 aku: } 678765068d 2007-11-27 aku: } else { 678765068d 2007-11-27 aku: while {$start < $end} { 678765068d 2007-11-27 aku: lappend crosses $start 678765068d 2007-11-27 aku: incr cross($start) 678765068d 2007-11-27 aku: incr start 678765068d 2007-11-27 aku: } 08ebab80cd 2007-11-10 aku: } 678765068d 2007-11-27 aku: set depc($dkey) $crosses 678765068d 2007-11-27 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: InitializeDeltas $revisions 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc InitializeDeltas {revisions} { 08ebab80cd 2007-11-10 aku: upvar 1 delta delta 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Pull the timestamps for all revisions in the changesets and 08ebab80cd 2007-11-10 aku: # compute their deltas for use by the break finder. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: array set delta {} 08ebab80cd 2007-11-10 aku: array set stamp {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set theset ('[join $revisions {','}]') 08ebab80cd 2007-11-10 aku: foreach {rid time} [state run " 08ebab80cd 2007-11-10 aku: SELECT R.rid, R.date 08ebab80cd 2007-11-10 aku: FROM revision R 08ebab80cd 2007-11-10 aku: WHERE R.rid IN $theset 08ebab80cd 2007-11-10 aku: "] { 08ebab80cd 2007-11-10 aku: set stamp($rid) $time 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set n 0 08ebab80cd 2007-11-10 aku: foreach rid [lrange $revisions 0 end-1] rnext [lrange $revisions 1 end] { 08ebab80cd 2007-11-10 aku: set delta($n) [expr {$stamp($rnext) - $stamp($rid)}] 08ebab80cd 2007-11-10 aku: incr n 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc FindBestBreak {range} { 08ebab80cd 2007-11-10 aku: upvar 1 cross cross delta delta 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Determine the best break location in the given range of 08ebab80cd 2007-11-10 aku: # positions. First we look for the locations with the maximal 08ebab80cd 2007-11-10 aku: # number of crossings. If there are several we look for the 08ebab80cd 2007-11-10 aku: # shortest time interval among them. If we still have multiple 08ebab80cd 2007-11-10 aku: # possibilities after that we select the earliest location 08ebab80cd 2007-11-10 aku: # among these. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: If the maximal number of crossings is 0 then the range 08ebab80cd 2007-11-10 aku: # has no internal dependencies, and no break location at 08ebab80cd 2007-11-10 aku: # all. This possibility is signaled via result -1. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: A range of length 1 or less cannot have internal 08ebab80cd 2007-11-10 aku: # dependencies, as that needs at least two revisions in 08ebab80cd 2007-11-10 aku: # the range. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {[llength $range] < 2} { return -1 } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set max -1 08ebab80cd 2007-11-10 aku: set best {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach location $range { 08ebab80cd 2007-11-10 aku: set crossings $cross($location) 08ebab80cd 2007-11-10 aku: if {$crossings > $max} { 08ebab80cd 2007-11-10 aku: set max $crossings 08ebab80cd 2007-11-10 aku: set best [list $location] 08ebab80cd 2007-11-10 aku: continue 08ebab80cd 2007-11-10 aku: } elseif {$crossings == $max} { 08ebab80cd 2007-11-10 aku: lappend best $location 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$max == 0} { return -1 } 08ebab80cd 2007-11-10 aku: if {[llength $best] == 1} { return [lindex $best 0] } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set locations $best 08ebab80cd 2007-11-10 aku: set best {} 08ebab80cd 2007-11-10 aku: set min -1 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach location $locations { 08ebab80cd 2007-11-10 aku: set interval $delta($location) 08ebab80cd 2007-11-10 aku: if {($min < 0) || ($interval < $min)} { 08ebab80cd 2007-11-10 aku: set min $interval 08ebab80cd 2007-11-10 aku: set best [list $location] 08ebab80cd 2007-11-10 aku: } elseif {$interval == $min} { 08ebab80cd 2007-11-10 aku: lappend best $location 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {[llength $best] == 1} { return [lindex $best 0] } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: return [lindex [lsort -integer -increasing $best] 0] 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc CutAt {location} { 08ebab80cd 2007-11-10 aku: upvar 1 cross cross depc depc 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # It was decided to split the changeset at the given 08ebab80cd 2007-11-10 aku: # location. This cuts a number of dependencies. Here we update 08ebab80cd 2007-11-10 aku: # the cross information so that the break finder has accurate 08ebab80cd 2007-11-10 aku: # data when we look at the generated fragments. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set six [log visible? 6] 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach {dep range} [array get depc] { 08ebab80cd 2007-11-10 aku: # Check all dependencies still known, take their range and 08ebab80cd 2007-11-10 aku: # see if the break location falls within. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: Border $range s e 08ebab80cd 2007-11-10 aku: if {$location < $s} continue ; # break before range, ignore 08ebab80cd 2007-11-10 aku: if {$location > $e} continue ; # break after range, ignore. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # This dependency crosses the break location. We remove it 08ebab80cd 2007-11-10 aku: # from the crossings counters, and then also from the set 08ebab80cd 2007-11-10 aku: # of known dependencies, as we are done with it. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach loc $depc($dep) { incr cross($loc) -1 } 08ebab80cd 2007-11-10 aku: unset depc($dep) 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {!$six} continue 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: struct::list assign $dep parent child 911d56a8c8 2007-11-27 aku: log write 5 csets "Broke dependency [PD $parent] --> [PD $child]" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Print identifying data for a revision (project, file, dotted rev 08ebab80cd 2007-11-10 aku: # number), for high verbosity log output. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PD {id} { 08ebab80cd 2007-11-10 aku: foreach {p f r} [state run { 08ebab80cd 2007-11-10 aku: SELECT P.name , F.name, R.rev 08ebab80cd 2007-11-10 aku: FROM revision R, file F, project P 08ebab80cd 2007-11-10 aku: WHERE R.rid = $id 08ebab80cd 2007-11-10 aku: AND R.fid = F.fid 08ebab80cd 2007-11-10 aku: AND F.pid = P.pid 08ebab80cd 2007-11-10 aku: }] break 08ebab80cd 2007-11-10 aku: return "'$p : $f/$r'" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Printing one or more ranges, formatted, and only their border to 08ebab80cd 2007-11-10 aku: # keep the strings short. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PRs {ranges} { 08ebab80cd 2007-11-10 aku: return [struct::list map $ranges [myproc PR]] 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PR {range} { 08ebab80cd 2007-11-10 aku: Border $range s e 08ebab80cd 2007-11-10 aku: return <${s}...${e}> 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc Border {range sv ev} { 08ebab80cd 2007-11-10 aku: upvar 1 $sv s $ev e 08ebab80cd 2007-11-10 aku: set s [lindex $range 0] 08ebab80cd 2007-11-10 aku: set e [lindex $range end] 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # # ## ### ##### ######## ############# 24c0b662de 2007-11-13 aku: 85bd219d0b 2007-11-13 aku: typevariable mychangesets {} ; # List of all known changesets. 0fcfbf7828 2007-11-29 aku: typevariable myrevmap -array {} ; # Map from items (tagged) to the 0fcfbf7828 2007-11-29 aku: # list of changesets containing 0fcfbf7828 2007-11-29 aku: # it. Each item can be used by 0fcfbf7828 2007-11-29 aku: # only one changeset. de4cff4142 2007-11-22 aku: typevariable myidmap -array {} ; # Map from changeset id to changeset. de4cff4142 2007-11-22 aku: e50f9ed55e 2007-11-22 aku: typemethod all {} { return $mychangesets } e50f9ed55e 2007-11-22 aku: typemethod of {id} { return $myidmap($id) } e50f9ed55e 2007-11-22 aku: typemethod ofrev {id} { return $myrevmap($id) } 24c0b662de 2007-11-13 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 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## Helper singleton. Commands for revision changesets. 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: snit::type ::vc::fossil::import::cvs::project::rev::rev { 27b15b7095 2007-11-29 aku: typemethod byrevision {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod bysymbol {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod istag {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod isbranch {} { return 0 } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # result = list (mintime, maxtime) 27b15b7095 2007-11-29 aku: typemethod timerange {items} { c74fe3de3f 2007-11-29 aku: set theset ('[join $items {','}]') c74fe3de3f 2007-11-29 aku: return [state run " c74fe3de3f 2007-11-29 aku: SELECT MIN(R.date), MAX(R.date) c74fe3de3f 2007-11-29 aku: FROM revision R c74fe3de3f 2007-11-29 aku: WHERE R.rid IN $theset c74fe3de3f 2007-11-29 aku: "] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (revision -> list (revision)) 27b15b7095 2007-11-29 aku: typemethod internalsuccessors {dv revisions} { 70d2283564 2007-11-29 aku: upvar 1 $dv dependencies 70d2283564 2007-11-29 aku: set theset ('[join $revisions {','}]') 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # See 'successors' below for the main explanation of 70d2283564 2007-11-29 aku: # the various cases. This piece is special in that it 70d2283564 2007-11-29 aku: # restricts the successors we look for to the same set of 70d2283564 2007-11-29 aku: # revisions we start from. Sensible as we are looking for 70d2283564 2007-11-29 aku: # changeset internal dependencies. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: array set dep {} 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: foreach {rid child} [state run " 70d2283564 2007-11-29 aku: -- (1) Primary child 70d2283564 2007-11-29 aku: SELECT R.rid, R.child 70d2283564 2007-11-29 aku: FROM revision R 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.child IS NOT NULL -- Has primary child 70d2283564 2007-11-29 aku: AND R.child IN $theset -- Which is also of interest 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (2) Secondary (branch) children 70d2283564 2007-11-29 aku: SELECT R.rid, B.brid 70d2283564 2007-11-29 aku: FROM revision R, revisionbranchchildren B 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.rid = B.rid -- Select subset of branch children 70d2283564 2007-11-29 aku: AND B.brid IN $theset -- Which is also of interest 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (4) Child of trunk root successor of last NTDB on trunk. 70d2283564 2007-11-29 aku: SELECT R.rid, RA.child 70d2283564 2007-11-29 aku: FROM revision R, revision RA 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.isdefault -- Restrict to NTDB 70d2283564 2007-11-29 aku: AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk 70d2283564 2007-11-29 aku: AND RA.rid = R.dbchild -- Go directly to trunk root 70d2283564 2007-11-29 aku: AND RA.child IS NOT NULL -- Has primary child. 70d2283564 2007-11-29 aku: AND RA.child IN $theset -- Which is also of interest 70d2283564 2007-11-29 aku: "] { 70d2283564 2007-11-29 aku: # Consider moving this to the integrity module. 70d2283564 2007-11-29 aku: integrity assert {$rid != $child} {Revision $rid depends on itself.} 70d2283564 2007-11-29 aku: lappend dependencies($rid) $child 70d2283564 2007-11-29 aku: set dep($rid,$child) . 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # The sql statements above looks only for direct dependencies 70d2283564 2007-11-29 aku: # between revision in the changeset. However due to the 70d2283564 2007-11-29 aku: # vagaries of meta data it is possible for two revisions of 70d2283564 2007-11-29 aku: # the same file to end up in the same changeset, without a 70d2283564 2007-11-29 aku: # direct dependency between them. However we know that there 70d2283564 2007-11-29 aku: # has to be a an indirect dependency, be it through primary 70d2283564 2007-11-29 aku: # children, branch children, or a combination thereof. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # We now fill in these pseudo-dependencies, if no such 70d2283564 2007-11-29 aku: # dependency exists already. The direction of the dependency 70d2283564 2007-11-29 aku: # is actually irrelevant for this. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # NOTE: This is different from cvs2svn. Our spiritual ancestor 70d2283564 2007-11-29 aku: # does not use such pseudo-dependencies, however it uses a 70d2283564 2007-11-29 aku: # COMMIT_THRESHOLD, a time interval commits should fall. This 70d2283564 2007-11-29 aku: # will greatly reduces the risk of getting far separated 70d2283564 2007-11-29 aku: # revisions of the same file into one changeset. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # We allow revisions to be far apart in time in the same 70d2283564 2007-11-29 aku: # changeset, but need the pseudo-dependencies for this. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: array set fids {} 70d2283564 2007-11-29 aku: foreach {rid fid} [state run " 70d2283564 2007-11-29 aku: SELECT R.rid, R.fid FROM revision R WHERE R.rid IN $theset 70d2283564 2007-11-29 aku: "] { lappend fids($fid) $rid } 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: foreach {fid rids} [array get fids] { 70d2283564 2007-11-29 aku: if {[llength $rids] < 2} continue 70d2283564 2007-11-29 aku: foreach a $rids { 70d2283564 2007-11-29 aku: foreach b $rids { 70d2283564 2007-11-29 aku: if {$a == $b} continue 70d2283564 2007-11-29 aku: if {[info exists dep($a,$b)]} continue 70d2283564 2007-11-29 aku: if {[info exists dep($b,$a)]} continue 70d2283564 2007-11-29 aku: lappend dependencies($a) $b 70d2283564 2007-11-29 aku: set dep($a,$b) . 70d2283564 2007-11-29 aku: set dep($b,$a) . 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod successors {dv revisions} { 70d2283564 2007-11-29 aku: upvar 1 $dv dependencies 70d2283564 2007-11-29 aku: set theset ('[join $revisions {','}]') 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # The following cases specify when a revision S is a successor 70d2283564 2007-11-29 aku: # of a revision R. Each of the cases translates into one of 70d2283564 2007-11-29 aku: # the branches of the SQL UNION coming below. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (1) S can be a primary child of R, i.e. in the same LOD. R 70d2283564 2007-11-29 aku: # references S directly. R.child = S(.rid), if it exists. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (2) S can be a secondary, i.e. branch, child of R. Here the 70d2283564 2007-11-29 aku: # link is made through the helper table 70d2283564 2007-11-29 aku: # REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid = 70d2283564 2007-11-29 aku: # S(.rid) 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (3) Originally this use case defined the root of a detached 70d2283564 2007-11-29 aku: # NTDB as the successor of the trunk root. This leads to a 70d2283564 2007-11-29 aku: # bad tangle later on. With a detached NTDB the original 70d2283564 2007-11-29 aku: # trunk root revision was removed as irrelevant, allowing 70d2283564 2007-11-29 aku: # the nominal root to be later in time than the NTDB 70d2283564 2007-11-29 aku: # root. Now setting this dependency will be backward in 70d2283564 2007-11-29 aku: # time. REMOVED. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (4) If R is the last of the NTDB revisions which belong to 70d2283564 2007-11-29 aku: # the trunk, then the primary child of the trunk root (the 70d2283564 2007-11-29 aku: # '1.2' revision) is a successor, if it exists. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # Note that the branches spawned from the revisions, and the 70d2283564 2007-11-29 aku: # tags associated with them are successors as well. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: foreach {rid child} [state run " 70d2283564 2007-11-29 aku: -- (1) Primary child 70d2283564 2007-11-29 aku: SELECT R.rid, R.child 70d2283564 2007-11-29 aku: FROM revision R 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.child IS NOT NULL -- Has primary child 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (2) Secondary (branch) children 70d2283564 2007-11-29 aku: SELECT R.rid, B.brid 70d2283564 2007-11-29 aku: FROM revision R, revisionbranchchildren B 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.rid = B.rid -- Select subset of branch children 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (4) Child of trunk root successor of last NTDB on trunk. 70d2283564 2007-11-29 aku: SELECT R.rid, RA.child 70d2283564 2007-11-29 aku: FROM revision R, revision RA 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.isdefault -- Restrict to NTDB 70d2283564 2007-11-29 aku: AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk 70d2283564 2007-11-29 aku: AND RA.rid = R.dbchild -- Go directly to trunk root 70d2283564 2007-11-29 aku: AND RA.child IS NOT NULL -- Has primary child. 70d2283564 2007-11-29 aku: "] { 70d2283564 2007-11-29 aku: # Consider moving this to the integrity module. 70d2283564 2007-11-29 aku: integrity assert {$rid != $child} {Revision $rid depends on itself.} 70d2283564 2007-11-29 aku: lappend dependencies([list rev $rid]) [list rev $child] 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: foreach {rid child} [state run " 70d2283564 2007-11-29 aku: SELECT R.rid, T.tid 70d2283564 2007-11-29 aku: FROM revision R, tag T 70d2283564 2007-11-29 aku: WHERE R.rid in $theset 70d2283564 2007-11-29 aku: AND T.rev = R.rid 70d2283564 2007-11-29 aku: "] { 70d2283564 2007-11-29 aku: lappend dependencies([list rev $rid]) [list sym::tag $child] 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: foreach {rid child} [state run " 70d2283564 2007-11-29 aku: SELECT R.rid, B.bid 70d2283564 2007-11-29 aku: FROM revision R, branch B 70d2283564 2007-11-29 aku: WHERE R.rid in $theset 70d2283564 2007-11-29 aku: AND B.root = R.rid 70d2283564 2007-11-29 aku: "] { 70d2283564 2007-11-29 aku: lappend dependencies([list rev $rid]) [list sym::branch $child] 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod predecessors {dv revisions} { 70d2283564 2007-11-29 aku: upvar 1 $dv dependencies 70d2283564 2007-11-29 aku: set theset ('[join $revisions {','}]') 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # The following cases specify when a revision P is a 70d2283564 2007-11-29 aku: # predecessor of a revision R. Each of the cases translates 70d2283564 2007-11-29 aku: # into one of the branches of the SQL UNION coming below. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (1) The immediate parent R.parent of R is a predecessor of 70d2283564 2007-11-29 aku: # R. NOTE: This is true for R either primary or secondary 70d2283564 2007-11-29 aku: # child of P. It not necessary to distinguish the two 70d2283564 2007-11-29 aku: # cases, in contrast to the code retrieving the successor 70d2283564 2007-11-29 aku: # information. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (2) The complement of successor case (3). The trunk root is 70d2283564 2007-11-29 aku: # a predecessor of a NTDB root. REMOVED. See 'successors' 70d2283564 2007-11-29 aku: # for the explanation. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (3) The complement of successor case (4). The last NTDB 70d2283564 2007-11-29 aku: # revision belonging to the trunk is a predecessor of the 70d2283564 2007-11-29 aku: # primary child of the trunk root (The '1.2' revision). 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: foreach {rid parent} [state run " 70d2283564 2007-11-29 aku: -- (1) Primary parent, can be in different LOD for first in a branch 70d2283564 2007-11-29 aku: SELECT R.rid, R.parent 70d2283564 2007-11-29 aku: FROM revision R 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.parent IS NOT NULL -- Has primary parent 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (3) Last NTDB on trunk is predecessor of child of trunk root 70d2283564 2007-11-29 aku: SELECT R.rid, RA.dbparent 70d2283564 2007-11-29 aku: FROM revision R, revision RA 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND NOT R.isdefault -- not on NTDB 70d2283564 2007-11-29 aku: AND R.parent IS NOT NULL -- which are not root 70d2283564 2007-11-29 aku: AND RA.rid = R.parent -- go to their parent 70d2283564 2007-11-29 aku: AND RA.dbparent IS NOT NULL -- which has to refer to NTDB's root 70d2283564 2007-11-29 aku: "] { 70d2283564 2007-11-29 aku: # Consider moving this to the integrity module. 70d2283564 2007-11-29 aku: integrity assert {$rid != $parent} {Revision $rid depends on itself.} 70d2283564 2007-11-29 aku: lappend dependencies([list rev $rid]) [list rev $parent] 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # The revisions which are the first on a branch have that 70d2283564 2007-11-29 aku: # branch as their predecessor. Note that revisions cannot be 70d2283564 2007-11-29 aku: # on tags in the same manner, so tags cannot be predecessors 70d2283564 2007-11-29 aku: # of revisions. This complements that they have no successors 70d2283564 2007-11-29 aku: # (See sym::tag/successors). 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: foreach {rid parent} [state run " 70d2283564 2007-11-29 aku: SELECT R.rid B.bid 70d2283564 2007-11-29 aku: FROM revision R, branch B 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset 70d2283564 2007-11-29 aku: AND B.first = R.rid 70d2283564 2007-11-29 aku: "] { 70d2283564 2007-11-29 aku: lappend dependencies([list rev $rid]) [list sym::branch $parent] 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## Helper singleton. Commands for tag symbol changesets. 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: snit::type ::vc::fossil::import::cvs::project::rev::sym::tag { 27b15b7095 2007-11-29 aku: typemethod byrevision {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod bysymbol {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod istag {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod isbranch {} { return 0 } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # result = list (mintime, maxtime) 27b15b7095 2007-11-29 aku: typemethod timerange {tags} { b1666f8ff4 2007-11-29 aku: # The range is defined as the range of the revisions the tags b1666f8ff4 2007-11-29 aku: # are attached to. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $tags {','}]') b1666f8ff4 2007-11-29 aku: return [state run " b1666f8ff4 2007-11-29 aku: SELECT MIN(R.date), MAX(R.date) b1666f8ff4 2007-11-29 aku: FROM revision R, tag T b1666f8ff4 2007-11-29 aku: WHERE T.tid IN $theset b1666f8ff4 2007-11-29 aku: AND R.rid = T.rev b1666f8ff4 2007-11-29 aku: "] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod successors {dv tags} { b1666f8ff4 2007-11-29 aku: # Tags have no successors. b1666f8ff4 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod predecessors {dv tags} { b1666f8ff4 2007-11-29 aku: # The predecessors of a tag are all the revisions the tags are b1666f8ff4 2007-11-29 aku: # attached to, as well as all the branches or tags which are b1666f8ff4 2007-11-29 aku: # their prefered parents. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $tags {','}]') b1666f8ff4 2007-11-29 aku: foreach {tid parent} [state run " b1666f8ff4 2007-11-29 aku: SELECT T.tid, R.rid b1666f8ff4 2007-11-29 aku: FROM revision R, tag T b1666f8ff4 2007-11-29 aku: WHERE T.tid IN $theset b1666f8ff4 2007-11-29 aku: AND T.rev = R.rid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::tag $tid]) [list rev $parent] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: foreach {tid parent} [state run " b1666f8ff4 2007-11-29 aku: SELECT T.tid, B.bid b1666f8ff4 2007-11-29 aku: FROM tag T, branch B, preferedparent P b1666f8ff4 2007-11-29 aku: WHERE T.tid IN $theset b1666f8ff4 2007-11-29 aku: AND T.sid = P.sid b1666f8ff4 2007-11-29 aku: AND P.pid = B.sid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::tag $tid]) [list sym::branch $parent] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: foreach {tid parent} [state run " b1666f8ff4 2007-11-29 aku: SELECT T.tid, TX.tid b1666f8ff4 2007-11-29 aku: FROM tag T, tag TX, preferedparent P b1666f8ff4 2007-11-29 aku: WHERE T.tid IN $theset b1666f8ff4 2007-11-29 aku: AND T.sid = P.sid b1666f8ff4 2007-11-29 aku: AND P.pid = TX.sid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::tag $tid]) [list sym::tag $parent] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## Helper singleton. Commands for branch symbol changesets. 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: snit::type ::vc::fossil::import::cvs::project::rev::sym::branch { 27b15b7095 2007-11-29 aku: typemethod byrevision {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod bysymbol {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod istag {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod isbranch {} { return 1 } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # result = list (mintime, maxtime) 27b15b7095 2007-11-29 aku: typemethod timerange {branches} { b1666f8ff4 2007-11-29 aku: # The range of a branch is defined as the range of the b1666f8ff4 2007-11-29 aku: # revisions the branches are spawned by. NOTE however that the b1666f8ff4 2007-11-29 aku: # branches associated with a detached NTDB will have no root b1666f8ff4 2007-11-29 aku: # spawning them, hence they have no real timerange any b1666f8ff4 2007-11-29 aku: # longer. By using 0 we put them in front of everything else, b1666f8ff4 2007-11-29 aku: # as they logically are. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $branches {','}]') b1666f8ff4 2007-11-29 aku: return [state run " b1666f8ff4 2007-11-29 aku: SELECT IFNULL(MIN(R.date),0), IFNULL(MAX(R.date),0) b1666f8ff4 2007-11-29 aku: FROM revision R, branch B b1666f8ff4 2007-11-29 aku: WHERE B.bid IN $theset b1666f8ff4 2007-11-29 aku: AND R.rid = B.root b1666f8ff4 2007-11-29 aku: "] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod successors {dv branches} { b1666f8ff4 2007-11-29 aku: # The first revision committed on a branch, and all branches b1666f8ff4 2007-11-29 aku: # and tags which have it as their prefered parent are the b1666f8ff4 2007-11-29 aku: # successors of a branch. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $branches {','}]') b1666f8ff4 2007-11-29 aku: foreach {bid child} [state run " b1666f8ff4 2007-11-29 aku: SELECT B.bid, R.rid b1666f8ff4 2007-11-29 aku: FROM revision R, branch B b1666f8ff4 2007-11-29 aku: WHERE B.bid IN $theset b1666f8ff4 2007-11-29 aku: AND B.first = R.rid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::tag $bid]) [list rev $child] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: foreach {bid child} [state run " b1666f8ff4 2007-11-29 aku: SELECT B.bid, BX.bid b1666f8ff4 2007-11-29 aku: FROM branch B, branch BX, preferedparent P b1666f8ff4 2007-11-29 aku: WHERE B.bid IN $theset b1666f8ff4 2007-11-29 aku: AND B.sid = P.pid b1666f8ff4 2007-11-29 aku: AND BX.sid = P.sid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::tag $bid]) [list sym::branch $child] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: foreach {bid child} [state run " b1666f8ff4 2007-11-29 aku: SELECT B.bid, T.tid b1666f8ff4 2007-11-29 aku: FROM branch B, tag T, preferedparent P b1666f8ff4 2007-11-29 aku: WHERE B.bid IN $theset b1666f8ff4 2007-11-29 aku: AND B.sid = P.pid b1666f8ff4 2007-11-29 aku: AND T.sid = P.sid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::tag $bid]) [list sym::tag $child] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod predecessors {dv branches} { b1666f8ff4 2007-11-29 aku: # The predecessors of a branch are all the revisions the b1666f8ff4 2007-11-29 aku: # branches are spawned from, as well as all the branches or b1666f8ff4 2007-11-29 aku: # tags which are their prefered parents. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $tags {','}]') b1666f8ff4 2007-11-29 aku: foreach {bid parent} [state run " b1666f8ff4 2007-11-29 aku: SELECT B.Bid, R.rid b1666f8ff4 2007-11-29 aku: FROM revision R, branch B b1666f8ff4 2007-11-29 aku: WHERE B.bid IN $theset b1666f8ff4 2007-11-29 aku: AND B.root = R.rid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::branch $bid]) [list rev $parent] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: foreach {bid parent} [state run " b1666f8ff4 2007-11-29 aku: SELECT B.bid, BX.bid b1666f8ff4 2007-11-29 aku: FROM branch B, branch BX, preferedparent P b1666f8ff4 2007-11-29 aku: WHERE B.bid IN $theset b1666f8ff4 2007-11-29 aku: AND B.sid = P.sid b1666f8ff4 2007-11-29 aku: AND P.pid = BX.sid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::branch $bid]) [list sym::branch $parent] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: foreach {bid parent} [state run " b1666f8ff4 2007-11-29 aku: SELECT B.bid, T.tid b1666f8ff4 2007-11-29 aku: FROM branch B, tag T, preferedparent P b1666f8ff4 2007-11-29 aku: WHERE B.tid IN $theset b1666f8ff4 2007-11-29 aku: AND B.sid = P.sid b1666f8ff4 2007-11-29 aku: AND P.pid = T.sid b1666f8ff4 2007-11-29 aku: "] { b1666f8ff4 2007-11-29 aku: lappend dependencies([list sym::branch $bid]) [list sym::tag $parent] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 27b15b7095 2007-11-29 aku: ## Configuration 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: pragma -hasinstances no ; # singleton 27b15b7095 2007-11-29 aku: pragma -hastypeinfo no ; # no introspection 27b15b7095 2007-11-29 aku: pragma -hastypedestroy no ; # immortal 84de38d73f 2007-10-10 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 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 47d52d1efd 2007-11-28 aku: namespace import ::vc::fossil::import::cvs::integrity 08ebab80cd 2007-11-10 aku: namespace import ::vc::tools::misc::* 08ebab80cd 2007-11-10 aku: namespace import ::vc::tools::trouble 95af789e1f 2007-11-10 aku: namespace import ::vc::tools::log 95af789e1f 2007-11-10 aku: log register csets 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # Set up the helper singletons 27b15b7095 2007-11-29 aku: namespace eval rev { 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::state 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::integrity 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: namespace eval sym::tag { 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::state 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::integrity 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: namespace eval sym::branch { 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::state 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::integrity 27b15b7095 2007-11-29 aku: } 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