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.
b42cff97e3 2007-11-30       aku: package require struct::set                           ; # Set operations.
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: 
deab4d035b 2007-11-29       aku:     constructor {project cstype srcid items {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: 
b42cff97e3 2007-11-30       aku: 	integrity assert {
b42cff97e3 2007-11-30       aku: 	    [info exists mycstype($cstype)]
b42cff97e3 2007-11-30       aku: 	} {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
deab4d035b 2007-11-29       aku: 	set myitems     $items
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
deab4d035b 2007-11-29       aku: 	# mapping from items to them.
de4cff4142 2007-11-22       aku: 	lappend mychangesets   $self
00bf8c198e 2007-12-02       aku: 	lappend mytchangesets($cstype) $self
de4cff4142 2007-11-22       aku: 	set     myidmap($myid) $self
deab4d035b 2007-11-29       aku: 	foreach iid $items {
deab4d035b 2007-11-29       aku: 	    set key [list $cstype $iid]
deab4d035b 2007-11-29       aku: 	    set myitemmap($key) $self
0fcfbf7828 2007-11-29       aku: 	    lappend mytitems $key
b42cff97e3 2007-11-30       aku: 	    log write 8 csets {MAP+ item <$key> $self = [$self str]}
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
911d56a8c8 2007-11-27       aku:     }
911d56a8c8 2007-11-27       aku: 
61829b076b 2007-11-29       aku:     method id    {} { return $myid }
61829b076b 2007-11-29       aku:     method items {} { return $mytitems }
61829b076b 2007-11-29       aku:     method data  {} { return [list $myproject $mytype $mysrcid] }
c74fe3de3f 2007-11-29       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: 
00bf8c198e 2007-12-02       aku:     method determinesuccessors {} {
00bf8c198e 2007-12-02       aku: 	# Pass 6 operation. Compute project-level dependencies from
00bf8c198e 2007-12-02       aku: 	# the file-level data and save it back to the state. This may
00bf8c198e 2007-12-02       aku: 	# be called during the cycle breaker passes as well, to adjust
00bf8c198e 2007-12-02       aku: 	# the successor information of changesets which are the
00bf8c198e 2007-12-02       aku: 	# predecessors of dropped changesets. For them we have to
00bf8c198e 2007-12-02       aku: 	# remove their existing information first before inserting the
00bf8c198e 2007-12-02       aku: 	# new data.
00bf8c198e 2007-12-02       aku: 	state run {
00bf8c198e 2007-12-02       aku: 	    DELETE FROM cssuccessor WHERE cid = $myid;
00bf8c198e 2007-12-02       aku: 	}
00bf8c198e 2007-12-02       aku: 	set loop 0
00bf8c198e 2007-12-02       aku: 	foreach nid [$mytypeobj cs_successors $myitems] {
00bf8c198e 2007-12-02       aku: 	    state run {
00bf8c198e 2007-12-02       aku: 		INSERT INTO cssuccessor (cid,  nid)
00bf8c198e 2007-12-02       aku: 		VALUES                  ($myid,$nid)
94c39d6375 2007-11-14       aku: 	    }
00bf8c198e 2007-12-02       aku: 	    if {$nid == $myid} { set loop 1 }
00bf8c198e 2007-12-02       aku: 	}
00bf8c198e 2007-12-02       aku: 	# Report after the complete structure has been saved.
00bf8c198e 2007-12-02       aku: 	if {$loop} { $self reportloop }
00bf8c198e 2007-12-02       aku: 	return
0fcfbf7828 2007-11-29       aku:     }
0fcfbf7828 2007-11-29       aku: 
0fcfbf7828 2007-11-29       aku:     # result = list (changeset)
85bd219d0b 2007-11-13       aku:     method successors {} {
00bf8c198e 2007-12-02       aku: 	# Use the data saved by pass 6.
00bf8c198e 2007-12-02       aku: 	return [struct::list map [state run {
00bf8c198e 2007-12-02       aku: 	    SELECT S.nid
00bf8c198e 2007-12-02       aku: 	    FROM   cssuccessor S
00bf8c198e 2007-12-02       aku: 	    WHERE  S.cid = $myid
00bf8c198e 2007-12-02       aku: 	}] [mytypemethod of]]
0fcfbf7828 2007-11-29       aku:     }
0fcfbf7828 2007-11-29       aku: 
0fcfbf7828 2007-11-29       aku:     # item -> list (item)
94c39d6375 2007-11-14       aku:     method nextmap {} {
deab4d035b 2007-11-29       aku: 	$mytypeobj successors tmp $myitems
e50f9ed55e 2007-11-22       aku: 	return [array get tmp]
85bd219d0b 2007-11-13       aku:     }
24c0b662de 2007-11-13       aku: 
24c0b662de 2007-11-13       aku:     method breakinternaldependencies {} {
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	##
c14e8f84cd 2007-11-30       aku: 	## NOTE: This method, maybe in conjunction with its caller
c14e8f84cd 2007-11-30       aku: 	##       seems to be a memory hog, especially for large
c14e8f84cd 2007-11-30       aku: 	##       changesets, with 'large' meaning to have a 'long list
c14e8f84cd 2007-11-30       aku: 	##       of items, several thousand'. Investigate where the
c14e8f84cd 2007-11-30       aku: 	##       memory is spent and then look for ways of rectifying
c14e8f84cd 2007-11-30       aku: 	##       the problem.
c14e8f84cd 2007-11-30       aku: 	##
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: 
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: 
00bf8c198e 2007-12-02       aku: 	# The code checks only successor 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 {}
deab4d035b 2007-11-29       aku: 	$mytypeobj internalsuccessors dependencies $myitems
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: 
deab4d035b 2007-11-29       aku: 	InitializeBreakState $myitems
08ebab80cd 2007-11-10       aku: 
08ebab80cd 2007-11-10       aku: 	set fragments {}
c14e8f84cd 2007-11-30       aku: 	set new       [list $range]
08ebab80cd 2007-11-10       aku: 	array set breaks {}
08ebab80cd 2007-11-10       aku: 
c14e8f84cd 2007-11-30       aku: 	# Instead of one list holding both processed and pending
c14e8f84cd 2007-11-30       aku: 	# fragments we use two, one for the framents to process, one
c14e8f84cd 2007-11-30       aku: 	# to hold the new fragments, and the latter is copied to the
c14e8f84cd 2007-11-30       aku: 	# former when they run out. This keeps the list of pending
c14e8f84cd 2007-11-30       aku: 	# fragments short without sacrificing speed by shifting stuff
c14e8f84cd 2007-11-30       aku: 	# down. We especially drop the memory of fragments broken
c14e8f84cd 2007-11-30       aku: 	# during processing after a short time, instead of letting it
c14e8f84cd 2007-11-30       aku: 	# consume memory.
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	while {[llength $new]} {
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	    set pending $new
c14e8f84cd 2007-11-30       aku: 	    set new     {}
c14e8f84cd 2007-11-30       aku: 	    set at      0
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	    while {$at < [llength $pending]} {
c14e8f84cd 2007-11-30       aku: 		set current [lindex $pending $at]
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		log write 6 csets {. . .. ... ..... ........ .............}
c14e8f84cd 2007-11-30       aku: 		log write 6 csets {Scheduled   [join [PRs [lrange $pending $at end]] { }]}
c14e8f84cd 2007-11-30       aku: 		log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]}
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		set best [FindBestBreak $current]
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		if {$best < 0} {
c14e8f84cd 2007-11-30       aku: 		    # The inspected range has no internal
c14e8f84cd 2007-11-30       aku: 		    # dependencies. This is a complete fragment.
c14e8f84cd 2007-11-30       aku: 		    lappend fragments $current
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    log write 6 csets "No breaks, final"
c14e8f84cd 2007-11-30       aku: 		} else {
c14e8f84cd 2007-11-30       aku: 		    # Split the range and schedule the resulting
c14e8f84cd 2007-11-30       aku: 		    # fragments for further inspection. Remember the
c14e8f84cd 2007-11-30       aku: 		    # number of dependencies cut before we remove them
c14e8f84cd 2007-11-30       aku: 		    # from consideration, for documentation later.
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    set breaks($best) $cross($best)
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    log write 6 csets "Best break @ $best, cutting [nsp $cross($best) dependency dependencies]"
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    # Note: The value of best is an abolute location
c14e8f84cd 2007-11-30       aku: 		    # in myitems. Use the start of current to make it
c14e8f84cd 2007-11-30       aku: 		    # an index absolute to current.
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    set brel [expr {$best - [lindex $current 0]}]
c14e8f84cd 2007-11-30       aku: 		    set bnext $brel ; incr bnext
c14e8f84cd 2007-11-30       aku: 		    set fragbefore [lrange $current 0 $brel]
c14e8f84cd 2007-11-30       aku: 		    set fragafter  [lrange $current $bnext end]
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    log write 6 csets "New pieces  [PR $fragbefore] [PR $fragafter]"
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning}
c14e8f84cd 2007-11-30       aku: 		    integrity assert {[llength $fragafter]}  {Found zero-length fragment at the end}
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 		    lappend new $fragbefore $fragafter
c14e8f84cd 2007-11-30       aku: 		    CutAt $best
08ebab80cd 2007-11-10       aku: 		}
08ebab80cd 2007-11-10       aku: 
c14e8f84cd 2007-11-30       aku: 		incr at
95af789e1f 2007-11-10       aku: 	    }
95af789e1f 2007-11-10       aku: 	}
95af789e1f 2007-11-10       aku: 
08ebab80cd 2007-11-10       aku: 	log write 6 csets ". . .. ... ..... ........ ............."
17ec2d682c 2007-11-24       aku: 
deab4d035b 2007-11-29       aku: 	# (*) We clear out the associated part of the myitemmap
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: 
deab4d035b 2007-11-29       aku: 	foreach iid $myitems {
deab4d035b 2007-11-29       aku: 	    set key [list $mytype $iid]
deab4d035b 2007-11-29       aku: 	    unset myitemmap($key)
b42cff97e3 2007-11-30       aku: 	    log write 8 csets {MAP- item <$key> $self = [$self str]}
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}
47d52d1efd 2007-11-28       aku: 
deab4d035b 2007-11-29       aku: 	    set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
87cf609021 2007-11-24       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 {
deab4d035b 2007-11-29       aku: 	    $laste == ([llength $myitems]-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
deab4d035b 2007-11-29       aku: 	# update the in-memory index. We can simply (re)add the items
deab4d035b 2007-11-29       aku: 	# because we cleared the previously existing information, see
deab4d035b 2007-11-29       aku: 	# (*) above. Persistence does not matter here, none of the
deab4d035b 2007-11-29       aku: 	# changesets has been saved to the persistent state yet.
deab4d035b 2007-11-29       aku: 
facb4a8721 2007-11-30       aku: 	set myitems  [lrange $myitems  0 $firste]
facb4a8721 2007-11-30       aku: 	set mytitems [lrange $mytitems 0 $firste]
deab4d035b 2007-11-29       aku: 	foreach iid $myitems {
deab4d035b 2007-11-29       aku: 	    set key [list $mytype $iid]
deab4d035b 2007-11-29       aku: 	    set myitemmap($key) $self
b42cff97e3 2007-11-30       aku: 	    log write 8 csets {MAP+ item <$key> $self = [$self str]}
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: 
deab4d035b 2007-11-29       aku: 	    foreach iid $myitems {
5f7acef887 2007-11-10       aku: 		state run {
80b1e8936f 2007-11-29       aku: 		    INSERT INTO csitem (cid,   pos,  iid)
80b1e8936f 2007-11-29       aku: 		    VALUES             ($myid, $pos, $iid);
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: 
deab4d035b 2007-11-29       aku:     method timerange {} { return [$mytypeobj timerange $myitems] }
deab4d035b 2007-11-29       aku: 
711e000206 2007-12-04       aku:     method limits {} {
711e000206 2007-12-04       aku: 	struct::list assign [$mytypeobj limits $myitems] maxp mins
711e000206 2007-12-04       aku: 	return [list [TagItemDict $maxp $mytype] [TagItemDict $mins $mytype]]
94c39d6375 2007-11-14       aku:     }
94c39d6375 2007-11-14       aku: 
94c39d6375 2007-11-14       aku:     method drop {} {
b42cff97e3 2007-11-30       aku: 	log write 8 csets {Dropping $self = [$self str]}
b42cff97e3 2007-11-30       aku: 
94c39d6375 2007-11-14       aku: 	state transaction {
94c39d6375 2007-11-14       aku: 	    state run {
00bf8c198e 2007-12-02       aku: 		DELETE FROM changeset   WHERE cid = $myid;
00bf8c198e 2007-12-02       aku: 		DELETE FROM csitem      WHERE cid = $myid;
00bf8c198e 2007-12-02       aku: 		DELETE FROM cssuccessor WHERE cid = $myid;
94c39d6375 2007-11-14       aku: 	    }
94c39d6375 2007-11-14       aku: 	}
deab4d035b 2007-11-29       aku: 	foreach iid $myitems {
deab4d035b 2007-11-29       aku: 	    set key [list $mytype $iid]
deab4d035b 2007-11-29       aku: 	    unset myitemmap($key)
b42cff97e3 2007-11-30       aku: 	    log write 8 csets {MAP- item <$key> $self = [$self str]}
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]
00bf8c198e 2007-12-02       aku: 	set pos                    [lsearch -exact $mytchangesets($mytype) $self]
00bf8c198e 2007-12-02       aku: 	set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos]
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	# Return the list of predecessors so that they can be adjusted.
00bf8c198e 2007-12-02       aku: 	return [struct::list map [state run {
00bf8c198e 2007-12-02       aku: 	    SELECT cid
00bf8c198e 2007-12-02       aku: 	    FROM   cssuccessor
00bf8c198e 2007-12-02       aku: 	    WHERE  nid = $myid
00bf8c198e 2007-12-02       aku: 	}] [mytypemethod of]]
00bf8c198e 2007-12-02       aku:     }
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku:     method reportloop {{kill 1}} {
00bf8c198e 2007-12-02       aku: 	# We print the items which are producing the loop, and how.
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	set hdr "Self-referential changeset [$self str] __________________"
00bf8c198e 2007-12-02       aku: 	set ftr [regsub -all {[^ 	]} $hdr {_}]
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	log write 0 csets $hdr
00bf8c198e 2007-12-02       aku: 	foreach {item nextitem} [$mytypeobj loops $myitems] {
00bf8c198e 2007-12-02       aku: 	    # Create tagged items from the id and our type.
00bf8c198e 2007-12-02       aku: 	    set item     [list $mytype  $item]
00bf8c198e 2007-12-02       aku: 	    set nextitem [list $mytype $nextitem]
00bf8c198e 2007-12-02       aku: 	    # Printable labels.
00bf8c198e 2007-12-02       aku: 	    set i  "<[$type itemstr $item]>"
00bf8c198e 2007-12-02       aku: 	    set n  "<[$type itemstr $nextitem]>"
00bf8c198e 2007-12-02       aku: 	    set ncs $myitemmap($nextitem)
00bf8c198e 2007-12-02       aku: 	    # Print
00bf8c198e 2007-12-02       aku: 	    log write 0 csets {* $i --> $n --> cs [$ncs str]}
00bf8c198e 2007-12-02       aku: 	}
00bf8c198e 2007-12-02       aku: 	log write 0 csets $ftr
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	if {!$kill} return
00bf8c198e 2007-12-02       aku: 	trouble internal "[$self str] depends on itself"
00bf8c198e 2007-12-02       aku: 	return
711e000206 2007-12-04       aku:     }
711e000206 2007-12-04       aku: 
348e45b0d6 2008-01-30       aku:     method pushto {sv repository date} {
348e45b0d6 2008-01-30       aku: 	upvar 1 $sv state
348e45b0d6 2008-01-30       aku: 
348e45b0d6 2008-01-30       aku: 	# Generate and import the manifest for this changeset.
348e45b0d6 2008-01-30       aku: 	#
348e45b0d6 2008-01-30       aku: 	# Data needed:
348e45b0d6 2008-01-30       aku: 	# - Commit message               (-- mysrcid -> repository meta)
348e45b0d6 2008-01-30       aku: 	# - User doing the commit        (s.a.)
348e45b0d6 2008-01-30       aku: 	#
348e45b0d6 2008-01-30       aku: 	# - Timestamp of when committed  (command argument)
348e45b0d6 2008-01-30       aku: 	#
348e45b0d6 2008-01-30       aku: 	# - The parent changeset, if any. If there is no parent use
348e45b0d6 2008-01-30       aku: 	#   the empty base revision as parent.
348e45b0d6 2008-01-30       aku: 	#
348e45b0d6 2008-01-30       aku: 	# - List of the file revisions in the changeset.
348e45b0d6 2008-01-30       aku: 
348e45b0d6 2008-01-30       aku: 	struct::list assign [$myproject getmeta $mysrcid] __ branch user message
348e45b0d6 2008-01-30       aku: 	struct::list assign $branch __ lodname
348e45b0d6 2008-01-30       aku: 
3cd599cacd 2008-01-31       aku: 	# Perform the import. As part of that convert the list of
3cd599cacd 2008-01-31       aku: 	# items in the changeset into uuids and printable data.
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	set uuid [Updatestate state $lodname \
3cd599cacd 2008-01-31       aku: 		      [$repository importrevision [$self str] \
3cd599cacd 2008-01-31       aku: 			   $user $message $date \
3cd599cacd 2008-01-31       aku: 			   [Getparent state $lodname $myproject] \
3cd599cacd 2008-01-31       aku: 			   [Getrevisioninfo $myitems]]]
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	# Remember the whole changeset / uuid mapping, for the tags.
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	state run {
3cd599cacd 2008-01-31       aku: 	    INSERT INTO csuuid (cid,   uuid)
3cd599cacd 2008-01-31       aku: 	    VALUES             ($myid, $uuid)
3cd599cacd 2008-01-31       aku: 	}
3cd599cacd 2008-01-31       aku: 	return
3cd599cacd 2008-01-31       aku:     }
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku:     proc Getrevisioninfo {revisions} {
08ebab80cd 2007-11-10       aku: 	set theset ('[join $revisions {','}]')
3cd599cacd 2008-01-31       aku: 	set revisions {}
3cd599cacd 2008-01-31       aku: 	foreach {uuid fname revnr} [state run [subst -nocommands -nobackslashes {
3cd599cacd 2008-01-31       aku: 	    SELECT U.uuid, F.name, R.rev
3cd599cacd 2008-01-31       aku: 	    FROM   revision R, revuuid U, file F
3cd599cacd 2008-01-31       aku: 	    WHERE  R.rid IN $theset  -- All specified revisions
3cd599cacd 2008-01-31       aku: 	    AND    U.rid = R.rid     -- get fossil uuid of revision
3cd599cacd 2008-01-31       aku: 	    AND    F.fid = R.fid     -- get file of revision
3cd599cacd 2008-01-31       aku: 	}]] {
3cd599cacd 2008-01-31       aku: 	    lappend revisions $uuid $fname $revnr
3cd599cacd 2008-01-31       aku: 	}
3cd599cacd 2008-01-31       aku: 	return $revisions
3cd599cacd 2008-01-31       aku:     }
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku:     proc Getparent {sv lodname project} {
3cd599cacd 2008-01-31       aku: 	upvar 1 $sv state
3cd599cacd 2008-01-31       aku: 
348e45b0d6 2008-01-30       aku: 	# The parent is determined via the line-of-development (LOD)
348e45b0d6 2008-01-30       aku: 	# information of each changeset, and the history of
348e45b0d6 2008-01-30       aku: 	# imports. The last changeset committed to the same LOD is
348e45b0d6 2008-01-30       aku: 	# taken as the parent of the current changeset. If the
348e45b0d6 2008-01-30       aku: 	# changeset is the first on that LOD it can be either spawned
348e45b0d6 2008-01-30       aku: 	# from another LOD, or detached. For the first case we
348e45b0d6 2008-01-30       aku: 	# retrieve the parent LOD of the current LOD symbol (*) and
348e45b0d6 2008-01-30       aku: 	# recheck for a committed changeset. The second case is taken
348e45b0d6 2008-01-30       aku: 	# if that lookup fails as well.
184c56327e 2007-11-24       aku: 	#
348e45b0d6 2008-01-30       aku: 	# (*) And this parent was found in previous passes when
348e45b0d6 2008-01-30       aku: 	#     determining the prefered parents of all the symbols.
348e45b0d6 2008-01-30       aku: 
348e45b0d6 2008-01-30       aku: 	# NOTE: The above is incomplete and buggy. Vendor-branches and
348e45b0d6 2008-01-30       aku: 	#       the various possibilities of its interaction with the
348e45b0d6 2008-01-30       aku: 	#       trunk are not fully handled.
348e45b0d6 2008-01-30       aku: 
348e45b0d6 2008-01-30       aku: 	if {[info exists state($lodname)]} {
348e45b0d6 2008-01-30       aku: 	    # LOD exists and has already been committed to.
3cd599cacd 2008-01-31       aku: 	    return $state($lodname)
3cd599cacd 2008-01-31       aku: 	}
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	# LOD has not been committed to before, this is the first
3cd599cacd 2008-01-31       aku: 	# time. Determine the name of the parent LOD.
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	set lodname [[[$project getsymbol $lodname] parent] name]
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	if {[info exists state($lodname)]} {
3cd599cacd 2008-01-31       aku: 	    # The parental LOD has been committed to, take that last
3cd599cacd 2008-01-31       aku: 	    # changeset as the spawnpoint for the new LOD.
3cd599cacd 2008-01-31       aku: 	    return $state($lodname)
3cd599cacd 2008-01-31       aku: 	}
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku: 	# The parental LOD is not defined (yet). This LOD is
3cd599cacd 2008-01-31       aku: 	# detached. We choose as our parent the automatic empty root
3cd599cacd 2008-01-31       aku: 	# baseline of the target repository.
3cd599cacd 2008-01-31       aku: 	return {}
3cd599cacd 2008-01-31       aku:     }
3cd599cacd 2008-01-31       aku: 
3cd599cacd 2008-01-31       aku:     proc Updatestate {sv lodname uuid} {
348e45b0d6 2008-01-30       aku: 	# Remember the imported changeset in the state, under our LOD.
348e45b0d6 2008-01-30       aku: 
3cd599cacd 2008-01-31       aku: 	upvar 1 $sv state
348e45b0d6 2008-01-30       aku: 	set state($lodname) $uuid
3cd599cacd 2008-01-31       aku: 	return $uuid
c74fe3de3f 2007-11-29       aku:     }
c74fe3de3f 2007-11-29       aku: 
c74fe3de3f 2007-11-29       aku:     typemethod split {cset args} {
c74fe3de3f 2007-11-29       aku: 	# As part of the creation of the new changesets specified in
deab4d035b 2007-11-29       aku: 	# ARGS as sets of items, all subsets of CSET's item set, CSET
deab4d035b 2007-11-29       aku: 	# will be dropped from all databases, in and out of memory,
deab4d035b 2007-11-29       aku: 	# and then destroyed.
184c56327e 2007-11-24       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.
0fcfbf7828 2007-11-29       aku: 
b42cff97e3 2007-11-30       aku: 	log write 8 csets {OLD: [lsort [$cset items]]}
c14e8f84cd 2007-11-30       aku: 	ValidateFragments $cset $args
b42cff97e3 2007-11-30       aku: 
b42cff97e3 2007-11-30       aku: 	# All checks pass, actually perform the split.
c74fe3de3f 2007-11-29       aku: 
c74fe3de3f 2007-11-29       aku: 	struct::list assign [$cset data] project cstype cssrc
c74fe3de3f 2007-11-29       aku: 
00bf8c198e 2007-12-02       aku: 	set predecessors [$cset drop]
c74fe3de3f 2007-11-29       aku: 	$cset destroy
c74fe3de3f 2007-11-29       aku: 
c74fe3de3f 2007-11-29       aku: 	set newcsets {}
deab4d035b 2007-11-29       aku: 	foreach fragmentitems $args {
b42cff97e3 2007-11-30       aku: 	    log write 8 csets {MAKE: [lsort $fragmentitems]}
b42cff97e3 2007-11-30       aku: 
b42cff97e3 2007-11-30       aku: 	    set fragment [$type %AUTO% $project $cstype $cssrc \
b42cff97e3 2007-11-30       aku: 			      [Untag $fragmentitems $cstype]]
b42cff97e3 2007-11-30       aku: 	    lappend newcsets $fragment
00bf8c198e 2007-12-02       aku: 
b42cff97e3 2007-11-30       aku: 	    $fragment persist
00bf8c198e 2007-12-02       aku: 	    $fragment determinesuccessors
00bf8c198e 2007-12-02       aku: 	}
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	# The predecessors have to recompute their successors, i.e.
00bf8c198e 2007-12-02       aku: 	# remove the dropped changeset and put one of the fragments
00bf8c198e 2007-12-02       aku: 	# into its place.
00bf8c198e 2007-12-02       aku: 	foreach p $predecessors {
00bf8c198e 2007-12-02       aku: 	    $p determinesuccessors
00bf8c198e 2007-12-02       aku: 	}
00bf8c198e 2007-12-02       aku: 
c74fe3de3f 2007-11-29       aku: 	return $newcsets
c14e8f84cd 2007-11-30       aku:     }
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku:     typemethod itemstr {item} {
c14e8f84cd 2007-11-30       aku: 	struct::list assign $item itype iid
c14e8f84cd 2007-11-30       aku: 	return [$itype str $iid]
c74fe3de3f 2007-11-29       aku:     }
c74fe3de3f 2007-11-29       aku: 
c74fe3de3f 2007-11-29       aku:     typemethod strlist {changesets} {
c74fe3de3f 2007-11-29       aku: 	return [join [struct::list map $changesets [myproc ID]]]
c74fe3de3f 2007-11-29       aku:     }
c74fe3de3f 2007-11-29       aku: 
c74fe3de3f 2007-11-29       aku:     proc ID {cset} { $cset str }
0fcfbf7828 2007-11-29       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
0fcfbf7828 2007-11-29       aku:     }
0fcfbf7828 2007-11-29       aku: 
711e000206 2007-12-04       aku:     proc TagItemDict {itemdict cstype} {
711e000206 2007-12-04       aku: 	set res {}
711e000206 2007-12-04       aku: 	foreach {i v} $itemdict { lappend res [list $cstype $i] $v }
711e000206 2007-12-04       aku: 	return $res
fbfb531868 2007-12-02       aku:     }
fbfb531868 2007-12-02       aku: 
c14e8f84cd 2007-11-30       aku:     proc ValidateFragments {cset fragments} {
c14e8f84cd 2007-11-30       aku: 	# Check the various integrity constraints for the fragments
c14e8f84cd 2007-11-30       aku: 	# specifying how to split the changeset:
184c56327e 2007-11-24       aku: 	#
c14e8f84cd 2007-11-30       aku: 	# * We must have two or more fragments, as splitting a
c14e8f84cd 2007-11-30       aku: 	#   changeset into one makes no sense.
c14e8f84cd 2007-11-30       aku: 	# * No fragment may be empty.
c14e8f84cd 2007-11-30       aku: 	# * All fragments have to be true subsets of the items in the
c14e8f84cd 2007-11-30       aku: 	#   changeset to split. The 'true' is implied because none are
c14e8f84cd 2007-11-30       aku: 	#   allowed to be empty, so each has to be smaller than the
c14e8f84cd 2007-11-30       aku: 	#   total.
c14e8f84cd 2007-11-30       aku: 	# * The union of the fragments has to be the item set of the
c14e8f84cd 2007-11-30       aku: 	#   changeset.
c14e8f84cd 2007-11-30       aku: 	# * The fragment must not overlap, i.e. their pairwise
c14e8f84cd 2007-11-30       aku: 	#   intersections have to be empty.
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	set cover {}
fbfb531868 2007-12-02       aku: 	foreach fragmentitems $fragments {
c14e8f84cd 2007-11-30       aku: 	    log write 8 csets {NEW: [lsort $fragmentitems]}
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	    integrity assert {
c14e8f84cd 2007-11-30       aku: 		![struct::set empty $fragmentitems]
c14e8f84cd 2007-11-30       aku: 	    } {changeset fragment is empty}
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	    integrity assert {
c14e8f84cd 2007-11-30       aku: 		[struct::set subsetof $fragmentitems [$cset items]]
c14e8f84cd 2007-11-30       aku: 	    } {changeset fragment is not a subset}
c14e8f84cd 2007-11-30       aku: 	    struct::set add cover $fragmentitems
c14e8f84cd 2007-11-30       aku: 	}
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	integrity assert {
c14e8f84cd 2007-11-30       aku: 	    [struct::set equal $cover [$cset items]]
c14e8f84cd 2007-11-30       aku: 	 } {The fragments do not cover the original changeset}
c14e8f84cd 2007-11-30       aku: 
c14e8f84cd 2007-11-30       aku: 	set i 1
fbfb531868 2007-12-02       aku: 	foreach fia $fragments {
fbfb531868 2007-12-02       aku: 	    foreach fib [lrange $fragments $i end] {
c14e8f84cd 2007-11-30       aku: 		integrity assert {
c14e8f84cd 2007-11-30       aku: 		    [struct::set empty [struct::set intersect $fia $fib]]
c14e8f84cd 2007-11-30       aku: 		} {The fragments <$fia> and <$fib> overlap}
08ebab80cd 2007-11-10       aku: 	    }
c14e8f84cd 2007-11-30       aku: 	    incr i
c14e8f84cd 2007-11-30       aku: 	}
c14e8f84cd 2007-11-30       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: 
c74fe3de3f 2007-11-29       aku:     variable myid        {} ; # Id of the cset for the persistent
c74fe3de3f 2007-11-29       aku: 			      # state.
c74fe3de3f 2007-11-29       aku:     variable myproject   {} ; # Reference of the project object the
c74fe3de3f 2007-11-29       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.
c74fe3de3f 2007-11-29       aku:     variable mysrcid     {} ; # Id of the metadata or symbol the cset
c74fe3de3f 2007-11-29       aku: 			      # is based on.
deab4d035b 2007-11-29       aku:     variable myitems     {} ; # 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.
deab4d035b 2007-11-29       aku:     variable mytitems    {} ; # As myitems, the tagged form.
c74fe3de3f 2007-11-29       aku:     variable mypos       {} ; # Commit position of the changeset, if
c74fe3de3f 2007-11-29       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.
70d2283564 2007-11-29       aku: 
348e45b0d6 2008-01-30       aku:     typemethod inorder {projectid} {
348e45b0d6 2008-01-30       aku: 	# Return all revision changesets for the specified project, in
348e45b0d6 2008-01-30       aku: 	# the order given to them by the sort passes. Both the
348e45b0d6 2008-01-30       aku: 	# filtering by project and sorting make use of 'project::rev
348e45b0d6 2008-01-30       aku: 	# rev' impossible.
348e45b0d6 2008-01-30       aku: 
348e45b0d6 2008-01-30       aku: 	set res {}
348e45b0d6 2008-01-30       aku: 	foreach {cid cdate} [state run {
348e45b0d6 2008-01-30       aku: 	    SELECT C.cid, T.date
348e45b0d6 2008-01-30       aku: 	    FROM   changeset C, cstimestamp T
348e45b0d6 2008-01-30       aku: 	    WHERE  C.type = 0          -- limit to revision changesets
348e45b0d6 2008-01-30       aku: 	    AND    C.pid  = $projectid -- limit to changesets in project
348e45b0d6 2008-01-30       aku: 	    AND    T.cid  = C.cid      -- get ordering information
348e45b0d6 2008-01-30       aku: 	    ORDER BY T.date            -- sort into commit order
348e45b0d6 2008-01-30       aku: 	}] {
348e45b0d6 2008-01-30       aku: 	    lappend res $myidmap($cid) $cdate
348e45b0d6 2008-01-30       aku: 	}
348e45b0d6 2008-01-30       aku: 	return $res
348e45b0d6 2008-01-30       aku:     }
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: 
9e1b461b2f 2008-01-30       aku:     typemethod load {repository} {
49dd66f64f 2008-01-30       aku: 	set n 0
49dd66f64f 2008-01-30       aku: 	log write 2 csets {Loading the changesets}
49dd66f64f 2008-01-30       aku: 	foreach {id pid cstype srcid} [state run {
49dd66f64f 2008-01-30       aku: 	    SELECT C.cid, C.pid, CS.name, C.src
49dd66f64f 2008-01-30       aku: 	    FROM   changeset C, cstype CS
49dd66f64f 2008-01-30       aku: 	    WHERE  C.type = CS.tid
49dd66f64f 2008-01-30       aku: 	    ORDER BY C.cid
49dd66f64f 2008-01-30       aku: 	}] {
49dd66f64f 2008-01-30       aku: 	    log progress 2 csets $n {}
9e1b461b2f 2008-01-30       aku: 	    set r [$type %AUTO% [$repository projectof $pid] $cstype $srcid [state run {
49dd66f64f 2008-01-30       aku: 		SELECT C.iid
49dd66f64f 2008-01-30       aku: 		FROM   csitem C
49dd66f64f 2008-01-30       aku: 		WHERE  C.cid = $id
49dd66f64f 2008-01-30       aku: 		ORDER BY C.pos
49dd66f64f 2008-01-30       aku: 	    }] $id]
49dd66f64f 2008-01-30       aku: 	    incr n
eabaea870a 2007-11-24       aku: 	}
eabaea870a 2007-11-24       aku: 	return
eabaea870a 2007-11-24       aku:     }
eabaea870a 2007-11-24       aku: 
70d2283564 2007-11-29       aku:     typemethod loadcounter {} {
70d2283564 2007-11-29       aku: 	# Initialize the counter from the state
49dd66f64f 2008-01-30       aku: 	log write 2 csets {Loading changeset counter}
70d2283564 2007-11-29       aku: 	set mycounter [state one { SELECT MAX(cid) FROM changeset }]
eabaea870a 2007-11-24       aku: 	return
eabaea870a 2007-11-24       aku:     }
47d52d1efd 2007-11-28       aku: 
70d2283564 2007-11-29       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 {','}]')
0ee9711e2e 2007-12-05       aku: 	foreach {rid time} [state run [subst -nocommands -nobackslashes {
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
0ee9711e2e 2007-12-05       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.
ac02614803 2007-12-02       aku:     # TODO: Replace with call to itemstr (list rev $id)
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
6809145eb1 2008-01-19       aku: 		WHERE R.rid = $id    -- Find specified file revision
6809145eb1 2008-01-19       aku: 		AND   F.fid = R.fid  -- Get file of the revision
6809145eb1 2008-01-19       aku: 		AND   P.pid = F.pid  -- Get project of the file.
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: 
00bf8c198e 2007-12-02       aku:     typevariable mychangesets         {} ; # List of all known
00bf8c198e 2007-12-02       aku: 					   # changesets.
00bf8c198e 2007-12-02       aku:     typevariable mytchangesets -array {} ; # List of all known
00bf8c198e 2007-12-02       aku: 					   # changesets of a type.
00bf8c198e 2007-12-02       aku:     typevariable myitemmap     -array {} ; # Map from items (tagged)
00bf8c198e 2007-12-02       aku: 					   # to the list of changesets
00bf8c198e 2007-12-02       aku: 					   # containing it. Each item
00bf8c198e 2007-12-02       aku: 					   # can be used by only one
00bf8c198e 2007-12-02       aku: 					   # changeset.
deab4d035b 2007-11-29       aku:     typevariable myidmap   -array {} ; # Map from changeset id to
deab4d035b 2007-11-29       aku: 				       # changeset.
deab4d035b 2007-11-29       aku: 
04d76a9e79 2007-11-29       aku:     typemethod all    {}    { return $mychangesets }
04d76a9e79 2007-11-29       aku:     typemethod of     {cid} { return $myidmap($cid) }
04d76a9e79 2007-11-29       aku:     typemethod ofitem {iid} { return $myitemmap($iid) }
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku:     typemethod rev    {}    { return $mytchangesets(rev) }
00bf8c198e 2007-12-02       aku:     typemethod sym    {}    { return [concat \
00bf8c198e 2007-12-02       aku: 					  ${mytchangesets(sym::branch)} \
00bf8c198e 2007-12-02       aku: 					  ${mytchangesets(sym::tag)}] }
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: }
70d2283564 2007-11-29       aku: 
c14e8f84cd 2007-11-30       aku: ##
c14e8f84cd 2007-11-30       aku: ## NOTE: The successor and predecessor methods defined by the classes
c14e8f84cd 2007-11-30       aku: ##       below are -- bottle necks --. Look for ways to make the SQL
c14e8f84cd 2007-11-30       aku: ##       faster.
c14e8f84cd 2007-11-30       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: 
b42cff97e3 2007-11-30       aku:     typemethod str {revision} {
b42cff97e3 2007-11-30       aku: 	struct::list assign [state run {
b42cff97e3 2007-11-30       aku: 	    SELECT R.rev, F.name, P.name
b42cff97e3 2007-11-30       aku: 	    FROM   revision R, file F, project P
6809145eb1 2008-01-19       aku: 	    WHERE  R.rid = $revision -- Find specified file revision
6809145eb1 2008-01-19       aku: 	    AND    F.fid = R.fid     -- Get file of the revision
6809145eb1 2008-01-19       aku: 	    AND    P.pid = F.pid     -- Get project of the file.
b42cff97e3 2007-11-30       aku: 	}] revnr fname pname
b42cff97e3 2007-11-30       aku: 	return "$pname/${revnr}::$fname"
b42cff97e3 2007-11-30       aku:     }
b42cff97e3 2007-11-30       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 {','}]')
0ee9711e2e 2007-12-05       aku: 	return [state run [subst -nocommands -nobackslashes {
c74fe3de3f 2007-11-29       aku: 	    SELECT MIN(R.date), MAX(R.date)
c74fe3de3f 2007-11-29       aku: 	    FROM revision R
6809145eb1 2008-01-19       aku: 	    WHERE R.rid IN $theset -- Restrict to revisions of interest
0ee9711e2e 2007-12-05       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: 
0ee9711e2e 2007-12-05       aku: 	foreach {rid child} [state run [subst -nocommands -nobackslashes {
6809145eb1 2008-01-19       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
0ee9711e2e 2007-12-05       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
fbfb531868 2007-12-02       aku: 	# changeset, but in turn need the pseudo-dependencies to
fbfb531868 2007-12-02       aku: 	# handle this.
70d2283564 2007-11-29       aku: 
70d2283564 2007-11-29       aku: 	array set fids {}
0ee9711e2e 2007-12-05       aku: 	foreach {rid fid} [state run [subst -nocommands -nobackslashes {
fbfb531868 2007-12-02       aku: 	    SELECT R.rid, R.fid
fbfb531868 2007-12-02       aku:             FROM   revision R
fbfb531868 2007-12-02       aku:             WHERE  R.rid IN $theset
0ee9711e2e 2007-12-05       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
00bf8c198e 2007-12-02       aku:     }
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku:     # result = 4-list (itemtype itemid nextitemtype nextitemid ...)
00bf8c198e 2007-12-02       aku:     typemethod loops {revisions} {
00bf8c198e 2007-12-02       aku: 	# Note: Tags and branches cannot cause the loop. Their id's,
6809145eb1 2008-01-19       aku: 	# being of a fundamentally different type than the revisions
00bf8c198e 2007-12-02       aku: 	# coming in cannot be in the set.
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	set theset ('[join $revisions {','}]')
00bf8c198e 2007-12-02       aku: 	return [state run [subst -nocommands -nobackslashes {
00bf8c198e 2007-12-02       aku: 	    -- (1) Primary child
00bf8c198e 2007-12-02       aku: 	    SELECT R.rid, R.child
00bf8c198e 2007-12-02       aku: 	    FROM   revision R
00bf8c198e 2007-12-02       aku: 	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
00bf8c198e 2007-12-02       aku: 	    AND    R.child IS NOT NULL    -- Has primary child
00bf8c198e 2007-12-02       aku: 	    AND    R.child IN $theset     -- Loop
00bf8c198e 2007-12-02       aku: 	    --
00bf8c198e 2007-12-02       aku: 	    UNION
00bf8c198e 2007-12-02       aku: 	    -- (2) Secondary (branch) children
00bf8c198e 2007-12-02       aku: 	    SELECT R.rid, B.brid
00bf8c198e 2007-12-02       aku: 	    FROM   revision R, revisionbranchchildren B
00bf8c198e 2007-12-02       aku: 	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
00bf8c198e 2007-12-02       aku: 	    AND    R.rid = B.rid          -- Select subset of branch children
00bf8c198e 2007-12-02       aku: 	    AND    B.rid   IN $theset     -- Loop
00bf8c198e 2007-12-02       aku: 	    --
00bf8c198e 2007-12-02       aku: 	    UNION
00bf8c198e 2007-12-02       aku: 	    -- (4) Child of trunk root successor of last NTDB on trunk.
00bf8c198e 2007-12-02       aku: 	    SELECT R.rid, RA.child
00bf8c198e 2007-12-02       aku: 	    FROM   revision R, revision RA
00bf8c198e 2007-12-02       aku: 	    WHERE  R.rid    IN $theset     -- Restrict to revisions of interest
00bf8c198e 2007-12-02       aku: 	    AND    R.isdefault             -- Restrict to NTDB
00bf8c198e 2007-12-02       aku: 	    AND    R.dbchild IS NOT NULL   -- and last NTDB belonging to trunk
00bf8c198e 2007-12-02       aku: 	    AND    RA.rid = R.dbchild      -- Go directly to trunk root
00bf8c198e 2007-12-02       aku: 	    AND    RA.child IS NOT NULL    -- Has primary child.
00bf8c198e 2007-12-02       aku: 	    AND    RA.child IN $theset     -- Loop
00bf8c198e 2007-12-02       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 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: 
0ee9711e2e 2007-12-05       aku: 	foreach {rid child} [state run [subst -nocommands -nobackslashes {
6809145eb1 2008-01-19       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.
0ee9711e2e 2007-12-05       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: 	}
0ee9711e2e 2007-12-05       aku: 	foreach {rid child} [state run [subst -nocommands -nobackslashes {
70d2283564 2007-11-29       aku: 	    SELECT R.rid, T.tid
70d2283564 2007-11-29       aku: 	    FROM   revision R, tag T
6809145eb1 2008-01-19       aku: 	    WHERE  R.rid IN $theset       -- Restrict to revisions of interest
6809145eb1 2008-01-19       aku: 	    AND    T.rev = R.rid          -- Select tags attached to them
0ee9711e2e 2007-12-05       aku: 	}]] {
70d2283564 2007-11-29       aku: 	    lappend dependencies([list rev $rid]) [list sym::tag $child]
70d2283564 2007-11-29       aku: 	}
0ee9711e2e 2007-12-05       aku: 	foreach {rid child} [state run [subst -nocommands -nobackslashes {
70d2283564 2007-11-29       aku: 	    SELECT R.rid, B.bid
70d2283564 2007-11-29       aku: 	    FROM   revision R, branch B
6809145eb1 2008-01-19       aku: 	    WHERE  R.rid IN $theset       -- Restrict to revisions of interest
6809145eb1 2008-01-19       aku: 	    AND    B.root = R.rid         -- Select branches attached to them
0ee9711e2e 2007-12-05       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
70d2283564 2007-11-29       aku:     }
70d2283564 2007-11-29       aku: 
9c57055025 2007-12-02       aku:     # result = list (changeset-id)
9c57055025 2007-12-02       aku:     typemethod cs_successors {revisions} {
9c57055025 2007-12-02       aku:         # This is a variant of 'successors' which maps the low-level
9c57055025 2007-12-02       aku:         # data directly to the associated changesets. I.e. instead
9c57055025 2007-12-02       aku:         # millions of dependency pairs (in extreme cases (Example: Tcl
9c57055025 2007-12-02       aku:         # CVS)) we return a very short and much more manageable list
9c57055025 2007-12-02       aku:         # of changesets.
9c57055025 2007-12-02       aku: 
70d2283564 2007-11-29       aku: 	set theset ('[join $revisions {','}]')
0ee9711e2e 2007-12-05       aku: 	return [state run [subst -nocommands -nobackslashes {
6809145eb1 2008-01-19       aku:     -- (1) Primary child
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   revision R, csitem CI, changeset C
9c57055025 2007-12-02       aku: 	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
9c57055025 2007-12-02       aku: 	    AND    R.child IS NOT NULL    -- Has primary child
6809145eb1 2008-01-19       aku:             AND    CI.iid = R.child       -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid         -- containing the primary child
6809145eb1 2008-01-19       aku:             AND    C.type = 0             -- which are revision changesets
9c57055025 2007-12-02       aku:     UNION
6809145eb1 2008-01-19       aku:     -- (2) Secondary (branch) children
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   revision R, revisionbranchchildren B, csitem CI, changeset C
70d2283564 2007-11-29       aku: 	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
9c57055025 2007-12-02       aku: 	    AND    R.rid = B.rid          -- Select subset of branch children
6809145eb1 2008-01-19       aku:             AND    CI.iid = B.brid        -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	  -- containing the branch
6809145eb1 2008-01-19       aku:             AND    C.type = 0		  -- which are revision changesets
9c57055025 2007-12-02       aku:     UNION
6809145eb1 2008-01-19       aku:     -- (4) Child of trunk root successor of last NTDB on trunk.
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   revision R, revision RA, csitem CI, changeset C
9c57055025 2007-12-02       aku: 	    WHERE  R.rid   IN $theset      -- Restrict to revisions of interest
9c57055025 2007-12-02       aku: 	    AND    R.isdefault             -- Restrict to NTDB
9c57055025 2007-12-02       aku: 	    AND    R.dbchild IS NOT NULL   -- and last NTDB belonging to trunk
9c57055025 2007-12-02       aku: 	    AND    RA.rid = R.dbchild      -- Go directly to trunk root
9c57055025 2007-12-02       aku: 	    AND    RA.child IS NOT NULL    -- Has primary child.
6809145eb1 2008-01-19       aku:             AND    CI.iid = RA.child       -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	   -- containing the primary child
6809145eb1 2008-01-19       aku:             AND    C.type = 0		   -- which are revision changesets
9c57055025 2007-12-02       aku:     UNION
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   revision R, tag T, csitem CI, changeset C
6809145eb1 2008-01-19       aku: 	    WHERE  R.rid in $theset        -- Restrict to revisions of interest
6809145eb1 2008-01-19       aku: 	    AND    T.rev = R.rid	   -- Select tags attached to them
6809145eb1 2008-01-19       aku:             AND    CI.iid = T.tid          -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	   -- containing the tags
6809145eb1 2008-01-19       aku:             AND    C.type = 1		   -- which are tag changesets
70d2283564 2007-11-29       aku:     UNION
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   revision R, branch B, csitem CI, changeset C
6809145eb1 2008-01-19       aku: 	    WHERE  R.rid in $theset        -- Restrict to revisions of interest
6809145eb1 2008-01-19       aku: 	    AND    B.root = R.rid	   -- Select branches attached to them
6809145eb1 2008-01-19       aku:             AND    CI.iid = B.bid          -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	   -- containing the branches
6809145eb1 2008-01-19       aku:             AND    C.type = 2		   -- which are branch changesets
0ee9711e2e 2007-12-05       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 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: 
b42cff97e3 2007-11-30       aku:     typemethod str {tag} {
b42cff97e3 2007-11-30       aku: 	struct::list assign [state run {
b42cff97e3 2007-11-30       aku: 	    SELECT S.name, F.name, P.name
b42cff97e3 2007-11-30       aku: 	    FROM   tag T, symbol S, file F, project P
6809145eb1 2008-01-19       aku: 	    WHERE  T.tid = $tag   -- Find specified tag
6809145eb1 2008-01-19       aku: 	    AND    F.fid = T.fid  -- Get file of tag
6809145eb1 2008-01-19       aku: 	    AND    P.pid = F.pid  -- Get project of file
6809145eb1 2008-01-19       aku: 	    AND    S.sid = T.sid  -- Get symbol of tag
b42cff97e3 2007-11-30       aku: 	}] sname fname pname
b42cff97e3 2007-11-30       aku: 	return "$pname/T'${sname}'::$fname"
b42cff97e3 2007-11-30       aku:     }
b42cff97e3 2007-11-30       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 {','}]')
0ee9711e2e 2007-12-05       aku: 	return [state run [subst -nocommands -nobackslashes {
b1666f8ff4 2007-11-29       aku: 	    SELECT MIN(R.date), MAX(R.date)
fbfb531868 2007-12-02       aku: 	    FROM   tag T, revision R
6809145eb1 2008-01-19       aku: 	    WHERE  T.tid IN $theset  -- Restrict to tags of interest
6809145eb1 2008-01-19       aku:             AND    R.rid = T.rev     -- Select tag parent revisions
0ee9711e2e 2007-12-05       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
b1666f8ff4 2007-11-29       aku:     }
b1666f8ff4 2007-11-29       aku: 
00bf8c198e 2007-12-02       aku:     # result = 4-list (itemtype itemid nextitemtype nextitemid ...)
00bf8c198e 2007-12-02       aku:     typemethod loops {tags} {
00bf8c198e 2007-12-02       aku: 	# Tags have no successors, therefore cannot cause loops
00bf8c198e 2007-12-02       aku: 	return {}
27b15b7095 2007-11-29       aku:     }
27b15b7095 2007-11-29       aku: 
9c57055025 2007-12-02       aku:     # result = list (changeset-id)
9c57055025 2007-12-02       aku:     typemethod cs_successors {tags} {
9c57055025 2007-12-02       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: 
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: 
b42cff97e3 2007-11-30       aku:     typemethod str {branch} {
b42cff97e3 2007-11-30       aku: 	struct::list assign [state run {
b42cff97e3 2007-11-30       aku: 	    SELECT S.name, F.name, P.name
b42cff97e3 2007-11-30       aku: 	    FROM   branch B, symbol S, file F, project P
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid = $branch  -- Find specified branch
6809145eb1 2008-01-19       aku: 	    AND    F.fid = B.fid    -- Get file of branch
6809145eb1 2008-01-19       aku: 	    AND    P.pid = F.pid    -- Get project of file
6809145eb1 2008-01-19       aku: 	    AND    S.sid = B.sid    -- Get symbol of branch
b42cff97e3 2007-11-30       aku: 	}] sname fname pname
b42cff97e3 2007-11-30       aku: 	return "$pname/B'${sname}'::$fname"
b42cff97e3 2007-11-30       aku:     }
b42cff97e3 2007-11-30       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 {','}]')
0ee9711e2e 2007-12-05       aku: 	return [state run [subst -nocommands -nobackslashes {
b1666f8ff4 2007-11-29       aku: 	    SELECT IFNULL(MIN(R.date),0), IFNULL(MAX(R.date),0)
fbfb531868 2007-12-02       aku: 	    FROM  branch B, revision R
6809145eb1 2008-01-19       aku: 	    WHERE B.bid IN $theset   -- Restrict to branches of interest
6809145eb1 2008-01-19       aku:             AND   R.rid = B.root     -- Select branch parent revisions
0ee9711e2e 2007-12-05       aku: 	}]]
00bf8c198e 2007-12-02       aku:     }
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku:     # result = 4-list (itemtype itemid nextitemtype nextitemid ...)
00bf8c198e 2007-12-02       aku:     typemethod loops {branches} {
00bf8c198e 2007-12-02       aku: 	# Note: Revisions and tags cannot cause the loop. Being of a
00bf8c198e 2007-12-02       aku: 	# fundamentally different type they cannot be in the incoming
00bf8c198e 2007-12-02       aku: 	# set of ids.
00bf8c198e 2007-12-02       aku: 
00bf8c198e 2007-12-02       aku: 	set theset ('[join $branches {','}]')
00bf8c198e 2007-12-02       aku: 	return [state run [subst -nocommands -nobackslashes {
00bf8c198e 2007-12-02       aku: 	    SELECT B.bid, BX.bid
00bf8c198e 2007-12-02       aku: 	    FROM   branch B, preferedparent P, branch BX
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset   -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.sid = P.pid      -- Get the prefered branches via
6809145eb1 2008-01-19       aku: 	    AND    BX.sid = P.sid     -- the branch symbols
6809145eb1 2008-01-19       aku: 	    AND    BX.bid IN $theset  -- Loop
00bf8c198e 2007-12-02       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} {
712010580a 2007-12-02       aku: 	upvar 1 $dv dependencies
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 {','}]')
0ee9711e2e 2007-12-05       aku: 	foreach {bid child} [state run [subst -nocommands -nobackslashes {
b1666f8ff4 2007-11-29       aku: 	    SELECT B.bid, R.rid
fbfb531868 2007-12-02       aku: 	    FROM   branch B, revision R
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.first = R.rid      -- Get first revision on the branch
0ee9711e2e 2007-12-05       aku: 	}]] {
00bf8c198e 2007-12-02       aku: 	    lappend dependencies([list sym::branch $bid]) [list rev $child]
b1666f8ff4 2007-11-29       aku: 	}
0ee9711e2e 2007-12-05       aku: 	foreach {bid child} [state run [subst -nocommands -nobackslashes {
b1666f8ff4 2007-11-29       aku: 	    SELECT B.bid, BX.bid
fbfb531868 2007-12-02       aku: 	    FROM   branch B, preferedparent P, branch BX
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.sid = P.pid        -- Get subordinate branches via the
6809145eb1 2008-01-19       aku: 	    AND    BX.sid = P.sid       -- prefered parents of their symbols
0ee9711e2e 2007-12-05       aku: 	}]] {
00bf8c198e 2007-12-02       aku: 	    lappend dependencies([list sym::branch $bid]) [list sym::branch $child]
b1666f8ff4 2007-11-29       aku: 	}
0ee9711e2e 2007-12-05       aku: 	foreach {bid child} [state run [subst -nocommands -nobackslashes {
b1666f8ff4 2007-11-29       aku: 	    SELECT B.bid, T.tid
fbfb531868 2007-12-02       aku: 	    FROM   branch B, preferedparent P, tag T
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.sid = P.pid        -- Get subordinate tags via the
6809145eb1 2008-01-19       aku: 	    AND    T.sid = P.sid        -- prefered parents of their symbols
0ee9711e2e 2007-12-05       aku: 	}]] {
3c0ef2c379 2007-12-05       aku: 	    lappend dependencies([list sym::branch $bid]) [list sym::tag $child]
b1666f8ff4 2007-11-29       aku: 	}
b1666f8ff4 2007-11-29       aku: 	return
b1666f8ff4 2007-11-29       aku:     }
b1666f8ff4 2007-11-29       aku: 
9c57055025 2007-12-02       aku:     # result = list (changeset-id)
9c57055025 2007-12-02       aku:     typemethod cs_successors {branches} {
9c57055025 2007-12-02       aku:         # This is a variant of 'successors' which maps the low-level
9c57055025 2007-12-02       aku:         # data directly to the associated changesets. I.e. instead
9c57055025 2007-12-02       aku:         # millions of dependency pairs (in extreme cases (Example: Tcl
9c57055025 2007-12-02       aku:         # CVS)) we return a very short and much more manageable list
9c57055025 2007-12-02       aku:         # of changesets.
9c57055025 2007-12-02       aku: 
9c57055025 2007-12-02       aku: 	set theset ('[join $branches {','}]')
0ee9711e2e 2007-12-05       aku:         return [state run [subst -nocommands -nobackslashes {
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   branch B, revision R, csitem CI, changeset C
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.first = R.rid	-- Get first revision on the branch
6809145eb1 2008-01-19       aku:             AND    CI.iid = R.rid       -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	-- containing this revision
6809145eb1 2008-01-19       aku:             AND    C.type = 0		-- which are revision changesets
9c57055025 2007-12-02       aku:     UNION
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   branch B, preferedparent P, branch BX, csitem CI, changeset C
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.sid = P.pid	-- Get subordinate branches via the
6809145eb1 2008-01-19       aku: 	    AND    BX.sid = P.sid	-- prefered parents of their symbols
6809145eb1 2008-01-19       aku:             AND    CI.iid = BX.bid      -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	-- containing the subordinate branches
6809145eb1 2008-01-19       aku:             AND    C.type = 2		-- which are branch changesets
9c57055025 2007-12-02       aku:     UNION
9c57055025 2007-12-02       aku: 	    SELECT C.cid
9c57055025 2007-12-02       aku: 	    FROM   branch B, preferedparent P, tag T, csitem CI, changeset C
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.sid = P.pid	-- Get subordinate tags via the
6809145eb1 2008-01-19       aku: 	    AND    T.sid = P.sid	-- prefered parents of their symbols
6809145eb1 2008-01-19       aku:             AND    CI.iid = T.tid       -- Select all changesets
6809145eb1 2008-01-19       aku:             AND    C.cid = CI.cid	-- containing the subordinate tags
6809145eb1 2008-01-19       aku:             AND    C.type = 1		-- which are tag changesets
0ee9711e2e 2007-12-05       aku: 	}]]
b1666f8ff4 2007-11-29       aku: 	return
27b15b7095 2007-11-29       aku:     }
27b15b7095 2007-11-29       aku: 
711e000206 2007-12-04       aku:     typemethod limits {branches} {
711e000206 2007-12-04       aku: 	# Notes. This method exists only for branches. It is needed to
711e000206 2007-12-04       aku: 	# get detailed information about a backward branch. It does
711e000206 2007-12-04       aku: 	# not apply to tags, nor revisions. The queries can also
711e000206 2007-12-04       aku: 	# restrict themselves to the revision sucessors/predecessors
711e000206 2007-12-04       aku: 	# of branches, as only they have ordering data and thus can
711e000206 2007-12-04       aku: 	# cause the backwardness.
711e000206 2007-12-04       aku: 
711e000206 2007-12-04       aku: 	set theset ('[join $branches {','}]')
711e000206 2007-12-04       aku: 
711e000206 2007-12-04       aku: 	set maxp [state run [subst -nocommands -nobackslashes {
711e000206 2007-12-04       aku: 	    -- maximal predecessor position per branch
711e000206 2007-12-04       aku: 	    SELECT B.bid, MAX (CO.pos)
711e000206 2007-12-04       aku: 	    FROM   branch B, revision R, csitem CI, changeset C, csorder CO
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.root = R.rid       -- Get branch root revisions
6809145eb1 2008-01-19       aku: 	    AND    CI.iid = R.rid       -- Get changesets containing the
6809145eb1 2008-01-19       aku: 	    AND    C.cid = CI.cid       -- root revisions, which are
6809145eb1 2008-01-19       aku: 	    AND    C.type = 0           -- revision changesets
6809145eb1 2008-01-19       aku: 	    AND    CO.cid = C.cid       -- Get their topological ordering
711e000206 2007-12-04       aku: 	    GROUP BY B.bid
711e000206 2007-12-04       aku: 	}]]
711e000206 2007-12-04       aku: 
711e000206 2007-12-04       aku: 	set mins [state run [subst -nocommands -nobackslashes {
711e000206 2007-12-04       aku: 	    -- minimal successor position per branch
711e000206 2007-12-04       aku: 	    SELECT B.bid, MIN (CO.pos)
711e000206 2007-12-04       aku: 	    FROM   branch B, revision R, csitem CI, changeset C, csorder CO
6809145eb1 2008-01-19       aku: 	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
6809145eb1 2008-01-19       aku: 	    AND    B.first = R.rid      -- Get the first revisions on the branches
6809145eb1 2008-01-19       aku: 	    AND    CI.iid = R.rid       -- Get changesets containing the
6809145eb1 2008-01-19       aku: 	    AND    C.cid = CI.cid	-- first revisions, which are
6809145eb1 2008-01-19       aku: 	    AND    C.type = 0		-- revision changesets
6809145eb1 2008-01-19       aku: 	    AND    CO.cid = C.cid	-- Get their topological ordering
711e000206 2007-12-04       aku: 	    GROUP BY B.bid
711e000206 2007-12-04       aku: 	}]]
711e000206 2007-12-04       aku: 
711e000206 2007-12-04       aku:         return [list $maxp $mins]
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