xref: /dports/devel/fossil/fossil-src-2.17/tools/cvs2fossil/lib/c2f_prev.tcl

## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007-2008 Andreas Kupries.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Revisions per project, aka Changesets. These objects are first used
## in pass 5, which creates the initial set covering the repository.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                               ; # Required runtime.
package require snit                                  ; # OO system.
package require struct::set                           ; # Set operations.
package require vc::tools::misc                       ; # Text formatting
package require vc::tools::trouble                    ; # Error reporting.
package require vc::tools::log                        ; # User feedback.
package require vc::fossil::import::cvs::state        ; # State storage.
package require vc::fossil::import::cvs::integrity    ; # State integrity checks.

# # ## ### ##### ######## ############# #####################
##

snit::type ::vc::fossil::import::cvs::project::rev {
    # # ## ### ##### ######## #############
    ## Public API

    constructor {project cstype srcid items {theid {}}} {
	if {$theid ne ""} {
	    set myid $theid
	} else {
	    set myid [incr mycounter]
	}

	integrity assert {
	    [info exists mycstype($cstype)]
	} {Bad changeset type '$cstype'.}

	set myproject   $project
	set mytype      $cstype
	set mytypeobj   ::vc::fossil::import::cvs::project::rev::${cstype}
	set mysrcid	$srcid
	set myitems     $items
	set mypos       {} ; # Commit location is not known yet.

	foreach iid $items { lappend mytitems [list $cstype $iid] }

	# Keep track of the generated changesets and of the inverse
	# mapping from items to them.
	lappend mychangesets   $self
	lappend mytchangesets($cstype) $self
	set     myidmap($myid) $self

	MapItems $cstype $items
	return
    }

    destructor {
	# We may be able to get rid of this entirely, at least for
	# (de)construction and pass InitCSets.

	UnmapItems $mytype $myitems
	unset myidmap($myid)

	set pos                    [lsearch -exact $mychangesets $self]
	set mychangesets           [lreplace       $mychangesets $pos $pos]
	set pos                    [lsearch -exact $mytchangesets($mytype) $self]
	set mytchangesets($mytype) [lreplace       $mytchangesets($mytype) $pos $pos]
	return
    }

    method str {} {
	set str    "<"
	set detail ""
	if {[$mytypeobj bysymbol]} {
	    set detail " '[state one {
		SELECT S.name
		FROM   symbol S
		WHERE  S.sid = $mysrcid
	    }]'"
	}
	append str "$mytype ${myid}${detail}>"
	return $str
    }

    method lod {} {
	return [$mytypeobj cs_lod $mysrcid $myitems]
    }

    method id    {} { return $myid }
    method items {} { return $mytitems }
    method data  {} { return [list $myproject $mytype $mysrcid] }

    delegate method bysymbol   to mytypeobj
    delegate method byrevision to mytypeobj
    delegate method isbranch   to mytypeobj
    delegate method istag      to mytypeobj

    method setpos {p} { set mypos $p ; return }
    method pos    {}  { return $mypos }

    method determinesuccessors {} {
	# Pass 6 operation. Compute project-level dependencies from
	# the file-level data and save it back to the state. This may
	# be called during the cycle breaker passes as well, to adjust
	# the successor information of changesets which are the
	# predecessors of dropped changesets. For them we have to
	# remove their existing information first before inserting the
	# new data.
	state run {
	    DELETE FROM cssuccessor WHERE cid = $myid;
	}
	set loop 0
	# TODO: Check other uses of cs_sucessors.
	# TODO: Consider merging cs_sucessor's SELECT with the INSERT here.
	foreach nid [$mytypeobj cs_successors $myitems] {
	    state run {
		INSERT INTO cssuccessor (cid,  nid)
		VALUES                  ($myid,$nid)
	    }
	    if {$nid == $myid} { set loop 1 }
	}
	# Report after the complete structure has been saved.
	if {$loop} { $self reportloop }
	return
    }

    # result = list (changeset)
    method successors {} {
	# Use the data saved by pass 6.
	return [struct::list map [state run {
	    SELECT S.nid
	    FROM   cssuccessor S
	    WHERE  S.cid = $myid
	}] [mytypemethod of]]
    }

    # item -> list (item)
    method nextmap {} {
	$mytypeobj successors tmp $myitems
	return [array get tmp]
    }

    method breakinternaldependencies {cv} {
	upvar 1 $cv counter
	log write 14 csets {[$self str] BID}
	vc::tools::mem::mark

	# This method inspects the changeset, looking for internal
	# dependencies. Nothing is done if there are no such.

	# Otherwise the changeset is split into a set of fragments
	# which have no internal dependencies, transforming the
	# internal dependencies into external ones. The new changesets
	# generated from the fragment information are added to the
	# list of all changesets (by the caller).

	# The code checks only successor dependencies, as this auto-
	# matically covers the predecessor dependencies as well (Any
	# successor dependency a -> b is also a predecessor dependency
	# b -> a).

	array set breaks {}

	set fragments [BreakDirectDependencies $myitems breaks]

	if {![llength $fragments]} { return {} }

	return [$self CreateFromFragments $fragments counter breaks]
    }

    method persist {} {
	set tid $mycstype($mytype)
	set pid [$myproject id]
	set pos 0

	state transaction {
	    state run {
		INSERT INTO changeset (cid,   pid,  type, src)
		VALUES                ($myid, $pid, $tid, $mysrcid);
	    }

	    foreach iid $myitems {
		state run {
		    INSERT INTO csitem (cid,   pos,  iid)
		    VALUES             ($myid, $pos, $iid);
		}
		incr pos
	    }
	}
	return
    }

    method timerange {} { return [$mytypeobj timerange $myitems] }

    method limits {} {
	struct::list assign [$mytypeobj limits $myitems] maxp mins
	return [list [TagItemDict $maxp $mytype] [TagItemDict $mins $mytype]]
    }

    method drop {} {
	log write 8 csets {Dropping $self = [$self str]}

	state transaction {
	    state run {
		DELETE FROM changeset   WHERE cid = $myid;
		DELETE FROM csitem      WHERE cid = $myid;
		DELETE FROM cssuccessor WHERE cid = $myid;
	    }
	}

	# Return the list of predecessors so that they can be adjusted.
	return [struct::list map [state run {
	    SELECT cid
	    FROM   cssuccessor
	    WHERE  nid = $myid
	}] [mytypemethod of]]
    }

    method reportloop {{kill 1}} {
	# We print the items which are producing the loop, and how.

	set hdr "Self-referential changeset [$self str] __________________"
	set ftr [regsub -all {[^ 	]} $hdr {_}]

	log write 0 csets $hdr
	foreach {item nextitem} [$mytypeobj loops $myitems] {
	    # Create tagged items from the id and our type.
	    set item     [list $mytype  $item]
	    set nextitem [list $mytype $nextitem]
	    # Printable labels.
	    set i  "<[$type itemstr $item]>"
	    set n  "<[$type itemstr $nextitem]>"
	    set ncs $myitemmap($nextitem)
	    # Print
	    log write 0 csets {* $i --> $n --> cs [$ncs str]}
	}
	log write 0 csets $ftr

	if {!$kill} return
	trouble internal "[$self str] depends on itself"
	return
    }

    method pushto {repository date rstate} {
	# Generate and import the manifest for this changeset.
	#
	# Data needed:
	# - Commit message               (-- mysrcid -> repository meta)
	# - User doing the commit        (s.a.)
	#
	# - Timestamp of when committed  (command argument)
	#
	# - The parent changeset, if any. If there is no parent fossil
	#   will use the empty base revision as parent.
	#
	# - List of the file revisions in the changeset.

	# We derive the lod information directly from the revisions of
	# the changeset, as the branch part of the meta data (s.a.) is
	# outdated since pass FilterSymbols. See the method 'run' in
	# file "c2f_pfiltersym.tcl" for more commentary on this.

	set lodname [$self lod]

	log write 2 csets {Importing changeset [$self str] on $lodname}

	if {[$mytypeobj istag]} {
	    # Handle tags. They appear immediately after the revision
	    # they are attached to (*). We can assume that the
	    # workspace for the relevant line of development
	    # exists. We retrieve it, then the uuid of the last
	    # revision entered into it, then tag this revision.

	    # (*) Immediately in terms of the relevant line of
	    #     development. Revisions on other lines may come in
	    #     between, but they do not matter to that.

	    set lws  [Getworkspace $rstate $lodname $myproject 0]
	    set uuid [lindex [$lws getid] 1]

	    $repository tag $uuid [state one {
		SELECT S.name
		FROM   symbol S
		WHERE  S.sid = $mysrcid
	    }]

	} elseif {[$mytypeobj isbranch]} {

	    # Handle branches. They appear immediately after the
	    # revision they are spawned from (*). We can assume that
	    # the workspace for the relevant line of development
	    # exists.

	    # We retrieve it, then the uuid of the last revision
	    # entered into it. That revision is tagged as the root of
	    # the branch (**). A new workspace for the branch is
	    # created as well, for the future revisions of the new
	    # line of development.

	    # An exception is made of the non-trunk default branch,
	    # aka vendor branch. This lod has to have a workspace not
	    # inherited from anything else. It has no root either, so
	    # tagging is out as well.

	    # (*) Immediately in terms of the relevant line of
	    #     development. Revisions on other lines may come in
	    #     between, but they do not matter to that.

	    # (**) Tagging the parent revision of the branch as its
	    #      root is done to let us know about the existence of
	    #      the branch even if it has no revisions committed to
	    #      it, and thus no regular branch tag anywhere else.
	    #      The name of the tag is the name for the lod, with
	    #      the suffix '-root' appended to it.

	    # LOD is self symbol of branch, not parent
	    set lodname [state one {
		SELECT S.name
		FROM   symbol S
		WHERE  S.sid = $mysrcid
	    }]

	    if {![$rstate has :trunk:]} {
		# No trunk implies default branch. Just create the
		# proper workspace.
		Getworkspace $rstate $lodname $myproject 1
	    } else {
		# Non-default branch. Need workspace, and tag parent
		# revision.

		set lws [Getworkspace $rstate $lodname $myproject 0]
		set uuid [lindex [$lws getid] 1]

		$repository tag $uuid ${lodname}-root
	    }
	} else {
	    # Revision changeset.

	    struct::list assign [$myproject getmeta $mysrcid] __ __ user message

	    # Perform the import. As part of that we determine the
	    # parent we need, and convert the list of items in the
	    # changeset into uuids and printable data.

	    struct::list assign [Getisdefault $myitems] \
		isdefault lastdefaultontrunk

	    log write 8 csets {LOD    '$lodname'}
	    log write 8 csets { def?  $isdefault}
	    log write 8 csets { last? $lastdefaultontrunk}

	    set lws  [Getworkspace    $rstate $lodname $myproject $isdefault]
	    $lws add [Getrevisioninfo $myitems]

	    struct::list assign \
		[$repository importrevision [$self str] \
		     $user $message $date \
		     [lindex [$lws getid] 0] [$lws get]] \
		rid uuid

	    if {[$lws ticks] == 1} {
		# First commit on this line of development. Set our
		# own name as a propagating tag. And if the LOD has a
		# parent we have to prevent the propagation of that
		# tag into this new line.

		set plws [$lws parent]
		if {$plws ne ""} {
		    $repository branchcancel $uuid [$plws name]
		}
		$repository branchmark $uuid [$lws name]
	    }

	    # Remember the imported changeset in the state, under our
	    # LOD. And if it is the last trunk changeset on the vendor
	    # branch then the revision is also the actual root of the
	    # :trunk:, so we remember it as such in the state. However
	    # if the trunk already exists then the changeset cannot be
	    # on it any more. This indicates weirdness in the setup of
	    # the vendor branch, but one we can work around.

	    $lws defid [list $rid $uuid]
	    if {$lastdefaultontrunk} {
		log write 2 csets {This cset is the last on the NTDB, set the trunk workspace up}

		if {[$rstate has :trunk:]} {
		    log write 2 csets {Multiple changesets declared to be the last trunk changeset on the vendor-branch}
		} else {
		    $rstate new :trunk: [$lws name]
		}
	    }
	}

	log write 2 csets { }
	log write 2 csets { }
	return
    }

    proc Getrevisioninfo {revisions} {
	set theset ('[join $revisions {','}]')
	set revisions {}
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT U.uuid    AS frid,
	           F.visible AS path,
	           F.name    AS fname,
	           R.rev     AS revnr,
	           R.op      AS rop
	    FROM   revision R, revuuid U, file F
	    WHERE  R.rid IN $theset  -- All specified revisions
	    AND    U.rid = R.rid     -- get fossil uuid of revision
	    AND    F.fid = R.fid     -- get file of revision
	}] {
	    lappend revisions $frid $path $fname/$revnr $rop
	}
	return $revisions
    }

    proc Getworkspace {rstate lodname project isdefault} {

	# The state object holds the workspace state of each known
	# line-of-development (LOD), up to the last committed
	# changeset belonging to that LOD.

	# (*) Standard handling if in-LOD changesets. If the LOD of
	#     the current changeset exists in the state (= has been
	#     committed to) then this it has the workspace we are
	#     looking for.

	if {[$rstate has $lodname]} {
	    return [$rstate get $lodname]
	}

	# If the LOD is however not yet known, then the current
	# changeset can be either of
	# (a) root of a vendor branch,
	# (b) root of the trunk LOD, or
	# (c) the first changeset in a new LOD which was spawned from
	#     an existing LOD.

	# For both (a) and (b) we have to create a new workspace for
	# the lod, and it doesn't inherit from anything.

	# One exception for (a). If we already have a :vendor: branch
	# then multiple symbols were used for the vendor branch by
	# different files. In that case the 'new' branch is made an
	# alias of the :vendor:, effectively merging the symbols
	# together.

	# Note that case (b) may never occur. See the variable
	# 'lastdefaultontrunk' in the caller (method pushto). This
	# flag can the generation of the workspace for the :trunk: LOD
	# as well, making it inherit the state of the last
	# trunk-changeset on the vendor-branch.

	if {$isdefault} {
	    if {![$rstate has ":vendor:"]} {
		# Create the vendor branch if not present already. We
		# use the actual name for the lod, and additional make
		# it accessible under an internal name (:vendor:) so
		# that we can merge to it later, should it become
		# necessary. See the other branch below.
		$rstate new $lodname
		$rstate dup :vendor: <-- $lodname
	    } else {
		# Merge the new symbol to the vendor branch
		$rstate dup $lodname <-- :vendor:
	    }
	    return [$rstate get $lodname]
	}

	if {$lodname eq ":trunk:"} {
	    return [$rstate new $lodname]
	}

	# Case (c). We find the parent LOD of our LOD and let the new
	# workspace inherit from the parent's workspace.

	set plodname [[[$project getsymbol $lodname] parent] name]

	log write 8 csets {pLOD   '$plodname'}

	if {[$rstate has $plodname]} {
	    return [$rstate new $lodname $plodname]
	}

	foreach k [lsort [$rstate names]] {
	    log write 8 csets {    $k = [[$rstate get $k] getid]}
	}

	trouble internal {Unable to determine changeset parent}
	return
    }

    proc Getisdefault {revisions} {
	set theset ('[join $revisions {','}]')

	struct::list assign [state run [subst -nocommands -nobackslashes {
	    SELECT R.isdefault, R.dbchild
	    FROM   revision R
	    WHERE  R.rid IN $theset  -- All specified revisions
	    LIMIT 1
	}]] def last

	# TODO/CHECK: look for changesets where isdefault/dbchild is
	# ambigous.

	return [list $def [expr {$last ne ""}]]
    }

    typemethod split {cset args} {
	# As part of the creation of the new changesets specified in
	# ARGS as sets of items, all subsets of CSET's item set, CSET
	# will be dropped from all databases, in and out of memory,
	# and then destroyed.
	#
	# Note: The item lists found in args are tagged items. They
	# have to have the same type as the changeset, being subsets
	# of its items. This is checked in Untag1.

	log write 8 csets {OLD: [lsort [$cset items]]}
	ValidateFragments $cset $args

	# All checks pass, actually perform the split.

	struct::list assign [$cset data] project cstype cssrc

	set predecessors [$cset drop]
	$cset destroy

	set newcsets {}
	foreach fragmentitems $args {
	    log write 8 csets {MAKE: [lsort $fragmentitems]}

	    set fragment [$type %AUTO% $project $cstype $cssrc \
			      [Untag $fragmentitems $cstype]]
	    lappend newcsets $fragment

	    $fragment persist
	    $fragment determinesuccessors
	}

	# The predecessors have to recompute their successors, i.e.
	# remove the dropped changeset and put one of the fragments
	# into its place.
	foreach p $predecessors {
	    $p determinesuccessors
	}

	return $newcsets
    }

    typemethod itemstr {item} {
	struct::list assign $item itype iid
	return [$itype str $iid]
    }

    typemethod strlist {changesets} {
	return [join [struct::list map $changesets [myproc ID]]]
    }

    proc ID {cset} { $cset str }

    proc Untag {taggeditems cstype} {
	return [struct::list map $taggeditems [myproc Untag1 $cstype]]
    }

    proc Untag1 {cstype theitem} {
	struct::list assign $theitem t i
	integrity assert {$cstype eq $t} {Item $i's type is '$t', expected '$cstype'}
	return $i
    }

    proc TagItemDict {itemdict cstype} {
	set res {}
	foreach {i v} $itemdict { lappend res [list $cstype $i] $v }
	return $res
    }

    proc ValidateFragments {cset fragments} {
	# Check the various integrity constraints for the fragments
	# specifying how to split the changeset:
	#
	# * We must have two or more fragments, as splitting a
	#   changeset into one makes no sense.
	# * No fragment may be empty.
	# * All fragments have to be true subsets of the items in the
	#   changeset to split. The 'true' is implied because none are
	#   allowed to be empty, so each has to be smaller than the
	#   total.
	# * The union of the fragments has to be the item set of the
	#   changeset.
	# * The fragment must not overlap, i.e. their pairwise
	#   intersections have to be empty.

	set cover {}
	foreach fragmentitems $fragments {
	    log write 8 csets {NEW: [lsort $fragmentitems]}

	    integrity assert {
		![struct::set empty $fragmentitems]
	    } {changeset fragment is empty}

	    integrity assert {
		[struct::set subsetof $fragmentitems [$cset items]]
	    } {changeset fragment is not a subset}
	    struct::set add cover $fragmentitems
	}

	integrity assert {
	    [struct::set equal $cover [$cset items]]
	 } {The fragments do not cover the original changeset}

	set i 1
	foreach fia $fragments {
	    foreach fib [lrange $fragments $i end] {
		integrity assert {
		    [struct::set empty [struct::set intersect $fia $fib]]
		} {The fragments <$fia> and <$fib> overlap}
	    }
	    incr i
	}

	return
    }

    # # ## ### ##### ######## #############
    ## State

    variable myid        {} ; # Id of the cset for the persistent
			      # state.
    variable myproject   {} ; # Reference of the project object the
			      # changeset belongs to.
    variable mytype      {} ; # What the changeset is based on
			      # (revisions, tags, or branches).
			      # Values: See mycstype. Note that we
			      # have to keep the names of the helper
			      # singletons in sync with the contents
			      # of state table 'cstype', and various
			      # other places using them hardwired.
    variable mytypeobj   {} ; # Reference to the container for the
			      # type dependent code. Derived from
			      # mytype.
    variable mysrcid     {} ; # Id of the metadata or symbol the cset
			      # is based on.
    variable myitems     {} ; # List of the file level revisions,
			      # tags, or branches in the cset, as
			      # ids. Not tagged.
    variable mytitems    {} ; # As myitems, the tagged form.
    variable mypos       {} ; # Commit position of the changeset, if
			      # known.

    # # ## ### ##### ######## #############
    ## Internal methods

    typevariable mycounter        0 ; # Id counter for csets. Last id
				      # used.
    typevariable mycstype -array {} ; # Map cstypes (names) to persistent
				      # ids. Note that we have to keep
				      # the names in the table 'cstype'
				      # in sync with the names of the
				      # helper singletons.

    typemethod inorder {projectid} {
	# Return all changesets (object references) for the specified
	# project, in the order given to them by the sort passes. Both
	# the filtering by project and the sorting by time make the
	# use of 'project::rev rev' impossible.

	set res {}
	state foreachrow {
	    SELECT C.cid  AS xcid,
	           T.date AS cdate
	    FROM   changeset C, cstimestamp T
	    WHERE  C.pid  = $projectid -- limit to changesets in project
	    AND    T.cid  = C.cid      -- get ordering information
	    ORDER BY T.date            -- sort into commit order
	} {
	    lappend res $myidmap($xcid) $cdate
	}
	return $res
    }

    typemethod getcstypes {} {
	state foreachrow {
	    SELECT tid, name FROM cstype;
	} { set mycstype($name) $tid }
	return
    }

    typemethod load {repository} {
	set n 0
	log write 2 csets {Loading the changesets}
	state foreachrow {
	    SELECT C.cid   AS id,
	           C.pid   AS xpid,
                   CS.name AS cstype,
	           C.src   AS srcid
	    FROM   changeset C, cstype CS
	    WHERE  C.type = CS.tid
	    ORDER BY C.cid
	} {
	    log progress 2 csets $n {}
	    set r [$type %AUTO% [$repository projectof $xpid] $cstype $srcid [state run {
		SELECT C.iid
		FROM   csitem C
		WHERE  C.cid = $id
		ORDER BY C.pos
	    }] $id]
	    incr n
	}
	return
    }

    typemethod loadcounter {} {
	# Initialize the counter from the state
	log write 2 csets {Loading changeset counter}
	set mycounter [state one { SELECT MAX(cid) FROM changeset }]
	return
    }

    typemethod num {} { return $mycounter }

    # # ## ### ##### ######## #############

    method CreateFromFragments {fragments cv bv} {
	upvar 1 $cv counter $bv breaks
	UnmapItems $mytype $myitems

	# Create changesets for the fragments, reusing the current one
	# for the first fragment. We sort them in order to allow
	# checking for gaps and nice messages.

	set newcsets  {}
	set fragments [lsort -index 0 -integer $fragments]

	#puts \t.[join [PRs $fragments] .\n\t.].

	Border [lindex $fragments 0] firsts firste

	integrity assert {
	    $firsts == 0
	} {Bad fragment start @ $firsts, gap, or before beginning of the range}

	set laste $firste
	foreach fragment [lrange $fragments 1 end] {
	    Border $fragment s e
	    integrity assert {
		$laste == ($s - 1)
	    } {Bad fragment border <$laste | $s>, gap or overlap}

	    set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]]
	    lappend newcsets $new
	    incr counter

            log write 4 csets {Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)}

	    set laste $e
	}

	integrity assert {
	    $laste == ([llength $myitems]-1)
	} {Bad fragment end @ $laste, gap, or beyond end of the range}

	# Put the first fragment into the current changeset, and
	# update the in-memory index. We can simply (re)add the items
	# because we cleared the previously existing information, see
	# 'UnmapItems' above. Persistence does not matter here, none
	# of the changesets has been saved to the persistent state
	# yet.

	set myitems  [lrange $myitems  0 $firste]
	set mytitems [lrange $mytitems 0 $firste]
	MapItems $mytype $myitems
	return $newcsets
    }

    # # ## ### ##### ######## #############

    proc BreakDirectDependencies {theitems bv} {
	upvar 1 mytypeobj mytypeobj self self $bv breaks

	# Array of dependencies (parent -> child). This is pulled from
	# the state, and limited to successors within the changeset.

	array set dependencies {}

	$mytypeobj internalsuccessors dependencies $theitems
	if {![array size dependencies]} {
	    return {}
	} ; # Nothing to break.

	log write 5 csets ...[$self str].......................................................
	vc::tools::mem::mark

	return [BreakerCore $theitems dependencies breaks]
    }

    proc BreakerCore {theitems dv bv} {
	# Break a set of revisions into fragments which have no
	# internal dependencies.

	# We perform all necessary splits in one go, instead of only
	# one. The previous algorithm, adapted from cvs2svn, computed
	# a lot of state which was thrown away and then computed again
	# for each of the fragments. It should be easier to update and
	# reuse that state.

	upvar 1 $dv dependencies $bv breaks

	# We have internal dependencies to break. We now iterate over
	# all positions in the list (which is chronological, at least
	# as far as the timestamps are correct and unique) and
	# determine the best position for the break, by trying to
	# break as many dependencies as possible in one go. When a
	# break was found this is redone for the fragments coming and
	# after, after upding the crossing information.

	# Data structures:
	# Map:  POS   revision id      -> position in list.
	#       CROSS position in list -> number of dependencies crossing it
	#       DEPC  dependency       -> positions it crosses
	# List: RANGE Of the positions itself.
	# Map:  DELTA position in list -> time delta between its revision
	#                                 and the next, if any.
	# A dependency is a single-element map parent -> child

	# InitializeBreakState initializes their contents after
	# upvar'ing them from this scope. It uses the information in
	# DEPENDENCIES to do so.

	InitializeBreakState $theitems

	set fragments {}
	set new       [list $range]

	# Instead of one list holding both processed and pending
	# fragments we use two, one for the framents to process, one
	# to hold the new fragments, and the latter is copied to the
	# former when they run out. This keeps the list of pending
	# fragments short without sacrificing speed by shifting stuff
	# down. We especially drop the memory of fragments broken
	# during processing after a short time, instead of letting it
	# consume memory.

	while {[llength $new]} {

	    set pending $new
	    set new     {}
	    set at      0

	    while {$at < [llength $pending]} {
		set current [lindex $pending $at]

		log write 6 csets {. . .. ... ..... ........ .............}
		log write 6 csets {Scheduled   [join [PRs [lrange $pending $at end]] { }]}
		log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]}

		set best [FindBestBreak $current]

		if {$best < 0} {
		    # The inspected range has no internal
		    # dependencies. This is a complete fragment.
		    lappend fragments $current

		    log write 6 csets "No breaks, final"
		} else {
		    # Split the range and schedule the resulting
		    # fragments for further inspection. Remember the
		    # number of dependencies cut before we remove them
		    # from consideration, for documentation later.

		    set breaks($best) $cross($best)

		    log write 6 csets "Best break @ $best, cutting [nsp $cross($best) dependency dependencies]"

		    # Note: The value of best is an abolute location
		    # in myitems. Use the start of current to make it
		    # an index absolute to current.

		    set brel [expr {$best - [lindex $current 0]}]
		    set bnext $brel ; incr bnext
		    set fragbefore [lrange $current 0 $brel]
		    set fragafter  [lrange $current $bnext end]

		    log write 6 csets "New pieces  [PR $fragbefore] [PR $fragafter]"

		    integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning}
		    integrity assert {[llength $fragafter]}  {Found zero-length fragment at the end}

		    lappend new $fragbefore $fragafter
		    CutAt $best
		}

		incr at
	    }
	}

	log write 6 csets ". . .. ... ..... ........ ............."

	return $fragments
    }

    proc InitializeBreakState {revisions} {
	upvar 1 pos pos cross cross range range depc depc delta delta \
	    dependencies dependencies

	# First we create a map of positions to make it easier to
	# determine whether a dependency crosses a particular index.

	log write 14 csets {IBS: #rev [llength $revisions]}
	log write 14 csets {IBS: pos map, cross counter}

	array set pos   {}
	array set cross {}
	array set depc  {}
	set range       {}
	set n 0
	foreach rev $revisions {
	    lappend range $n
	    set pos($rev) $n
	    set cross($n) 0
	    incr n
	}

	log write 14 csets {IBS: pos/[array size pos], cross/[array size cross]}

	# Secondly we count the crossings per position, by iterating
	# over the recorded internal dependencies.

	# Note: If the timestamps are badly out of order it is
	#       possible to have a backward successor dependency,
	#       i.e. with start > end. We may have to swap the indices
	#       to ensure that the following loop runs correctly.
	#
	# Note 2: start == end is not possible. It indicates a
	#         self-dependency due to the uniqueness of positions,
	#         and that is something we have ruled out already, see
	#         'rev internalsuccessors'.

	log write 14 csets {IBS: cross counter filling, pos/cross map}

	foreach {rid children} [array get dependencies] {
	    foreach child $children {
		set dkey    [list $rid $child]
		set start   $pos($rid)
		set end     $pos($child)

		if {$start > $end} {
		    set crosses [list $end [expr {$start-1}]]
		    while {$end < $start} {
			incr cross($end)
			incr end
		    }
		} else {
		    set crosses [list $start [expr {$end-1}]]
		    while {$start < $end} {
			incr cross($start)
			incr start
		    }
		}
		set depc($dkey) $crosses
	    }
	}

	log write 14 csets {IBS: pos/[array size pos], cross/[array size cross], depc/[array size depc] (for [llength $revisions])}
	log write 14 csets {IBS: timestamps, deltas}

	InitializeDeltas $revisions

	log write 14 csets {IBS: delta [array size delta]}
	return
    }

    proc InitializeDeltas {revisions} {
	upvar 1 delta delta

	# Pull the timestamps for all revisions in the changesets and
	# compute their deltas for use by the break finder.

	array set delta {}
	array set stamp {}

	set theset ('[join $revisions {','}]')
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT R.rid AS xrid, R.date AS time
	    FROM revision R
	    WHERE R.rid IN $theset
	}] {
	    set stamp($xrid) $time
	}

	log write 14 csets {IBS: stamp [array size stamp]}

	set n 0
	foreach rid [lrange $revisions 0 end-1] rnext [lrange $revisions 1 end] {
	    set delta($n) [expr {$stamp($rnext) - $stamp($rid)}]
	    incr n
	}
	return
    }

    proc FindBestBreak {range} {
	upvar 1 cross cross delta delta

	# Determine the best break location in the given range of
	# positions. First we look for the locations with the maximal
	# number of crossings. If there are several we look for the
	# shortest time interval among them. If we still have multiple
	# possibilities after that we select the earliest location
	# among these.

	# Note: If the maximal number of crossings is 0 then the range
	#       has no internal dependencies, and no break location at
	#       all. This possibility is signaled via result -1.

	# Note: A range of length 1 or less cannot have internal
	#       dependencies, as that needs at least two revisions in
	#       the range.

	if {[llength $range] < 2} { return -1 }

	set max -1
	set best {}

	foreach location $range {
	    set crossings $cross($location)
	    if {$crossings > $max} {
		set max  $crossings
		set best [list $location]
		continue
	    } elseif {$crossings == $max} {
		lappend best $location
	    }
	}

	if {$max == 0}            { return -1 }
	if {[llength $best] == 1} { return [lindex $best 0] }

	set locations $best
	set best {}
	set min -1

	foreach location $locations {
	    set interval $delta($location)
	    if {($min < 0) || ($interval < $min)} {
		set min  $interval
		set best [list $location]
	    } elseif {$interval == $min} {
		lappend best $location
	    }
	}

	if {[llength $best] == 1} { return [lindex $best 0] }

	return [lindex [lsort -integer -increasing $best] 0]
    }

    proc CutAt {location} {
	upvar 1 cross cross depc depc

	# It was decided to split the changeset at the given
	# location. This cuts a number of dependencies. Here we update
	# the cross information so that the break finder has accurate
	# data when we look at the generated fragments.

	set six [log visible? 6]

	# Note: The loop below could be made faster by keeping a map
	# from positions to the dependencies crossing. An extension of
	# CROSS, i.e. list of dependencies, counter is implied. Takes
	# a lot more memory however, and takes time to update here
	# (The inner loop is not incr -1, but ldelete).

	foreach dep [array names depc] {
	    set range $depc($dep)
	    # Check all dependencies still known, take their range and
	    # see if the break location falls within.

	    Border $range s e
	    if {$location < $s} continue ; # break before range, ignore
	    if {$location > $e} continue ; # break after range, ignore.

	    # This dependency crosses the break location. We remove it
	    # from the crossings counters, and then also from the set
	    # of known dependencies, as we are done with it.

	    Border $depc($dep) ds de
	    for {set loc $ds} {$loc <= $de} {incr loc} {
		incr cross($loc) -1
	    }
	    unset depc($dep)

	    if {!$six} continue

	    struct::list assign $dep parent child
	    log write 5 csets "Broke dependency [PD $parent] --> [PD $child]"
	}

	return
    }

    # Print identifying data for a revision (project, file, dotted rev
    # number), for high verbosity log output.
    # TODO: Replace with call to itemstr (list rev $id)

    proc PD {id} {
	foreach {p f r} [state run {
		SELECT P.name , F.name, R.rev
		FROM revision R, file F, project P
		WHERE R.rid = $id    -- Find specified file revision
		AND   F.fid = R.fid  -- Get file of the revision
		AND   P.pid = F.pid  -- Get project of the file.
	}] break
	return "'$p : $f/$r'"
    }

    # Printing one or more ranges, formatted, and only their border to
    # keep the strings short.

    proc PRs {ranges} {
	return [struct::list map $ranges [myproc PR]]
    }

    proc PR {range} {
	Border $range s e
	return <${s}...${e}>
    }

    proc Border {range sv ev} {
	upvar 1 $sv s $ev e
	set s [lindex $range 0]
	set e [lindex $range end]
	return
    }

    # # ## ### ##### ######## #############

    proc UnmapItems {thetype theitems} {
	# (*) We clear out the associated part of the myitemmap
	# in-memory index in preparation for new data, or as part of
	# object destruction. A simple unset is enough, we have no
	# symbol changesets at this time, and thus never more than one
	# reference in the list.

	upvar 1 myitemmap myitemmap self self
	foreach iid $theitems {
	    set key [list $thetype $iid]
	    unset myitemmap($key)
	    log write 8 csets {MAP- item <$key> $self = [$self str]}
	}
	return
    }

    proc MapItems {thetype theitems} {
	upvar 1 myitemmap myitemmap self self

	foreach iid $theitems {
	    set key [list $thetype $iid]
	    set myitemmap($key) $self
	    log write 8 csets {MAP+ item <$key> $self = [$self str]}
	}
	return
    }

    # # ## ### ##### ######## #############

    typevariable mychangesets         {} ; # List of all known
					   # changesets.

    # List of all known changesets of a type.
    typevariable mytchangesets -array {
	sym::branch {}
	sym::tag    {}
	rev         {}
    }

    typevariable myitemmap     -array {} ; # Map from items (tagged)
					   # to the list of changesets
					   # containing it. Each item
					   # can be used by only one
					   # changeset.
    typevariable myidmap   -array {} ; # Map from changeset id to
				       # changeset.

    typemethod all    {}    { return $mychangesets }
    typemethod of     {cid} { return $myidmap($cid) }
    typemethod ofitem {iid} { return $myitemmap($iid) }

    typemethod rev    {}    { return $mytchangesets(rev) }
    typemethod sym    {}    { return [concat \
					  ${mytchangesets(sym::branch)} \
					  ${mytchangesets(sym::tag)}] }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hastypeinfo    no  ; # no type introspection
    pragma -hasinfo        no  ; # no object introspection

    # # ## ### ##### ######## #############
}

##
## NOTE: The successor and predecessor methods defined by the classes
##       below are -- bottle necks --. Look for ways to make the SQL
##       faster.
##

# # ## ### ##### ######## ############# #####################
## Helper singleton. Commands for revision changesets.

snit::type ::vc::fossil::import::cvs::project::rev::rev {
    typemethod byrevision {} { return 1 }
    typemethod bysymbol   {} { return 0 }
    typemethod istag      {} { return 0 }
    typemethod isbranch   {} { return 0 }

    typemethod str {revision} {
	struct::list assign [state run {
	    SELECT R.rev, F.name, P.name
	    FROM   revision R, file F, project P
	    WHERE  R.rid = $revision -- Find specified file revision
	    AND    F.fid = R.fid     -- Get file of the revision
	    AND    P.pid = F.pid     -- Get project of the file.
	}] revnr fname pname
	return "$pname/${revnr}::$fname"
    }

    # result = list (mintime, maxtime)
    typemethod timerange {items} {
	set theset ('[join $items {','}]')
	return [state run [subst -nocommands -nobackslashes {
	    SELECT MIN(R.date), MAX(R.date)
	    FROM revision R
	    WHERE R.rid IN $theset -- Restrict to revisions of interest
	}]]
    }

    # var(dv) = dict (revision -> list (revision))
    typemethod internalsuccessors {dv revisions} {
	upvar 1 $dv dependencies
	set theset ('[join $revisions {','}]')

	log write 14 csets internalsuccessors

	# See 'successors' below for the main explanation of
	# the various cases. This piece is special in that it
	# restricts the successors we look for to the same set of
	# revisions we start from. Sensible as we are looking for
	# changeset internal dependencies.

	array set dep {}

	state foreachrow [subst -nocommands -nobackslashes {
    -- (1) Primary child
	    SELECT R.rid AS xrid, R.child AS xchild
	    FROM   revision R
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.child IS NOT NULL    -- Has primary child
	    AND    R.child IN $theset     -- Which is also of interest
    UNION
    -- (2) Secondary (branch) children
	    SELECT R.rid AS xrid, B.brid AS xchild
	    FROM   revision R, revisionbranchchildren B
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.rid = B.rid          -- Select subset of branch children
	    AND    B.brid IN $theset      -- Which is also of interest
    UNION
    -- (4) Child of trunk root successor of last NTDB on trunk.
	    SELECT R.rid AS xrid, RA.child AS xchild
	    FROM revision R, revision RA
	    WHERE R.rid   IN $theset      -- Restrict to revisions of interest
	    AND   R.isdefault             -- Restrict to NTDB
	    AND   R.dbchild IS NOT NULL   -- and last NTDB belonging to trunk
	    AND   RA.rid = R.dbchild      -- Go directly to trunk root
	    AND   RA.child IS NOT NULL    -- Has primary child.
            AND   RA.child IN $theset     -- Which is also of interest
	}] {
	    # Consider moving this to the integrity module.
	    integrity assert {$xrid != $xchild} {Revision $xrid depends on itself.}
	    lappend dependencies($xrid) $xchild
	    set dep($xrid,$xchild) .
	}

	# The sql statements above looks only for direct dependencies
	# between revision in the changeset. However due to the
	# vagaries of meta data it is possible for two revisions of
	# the same file to end up in the same changeset, without a
	# direct dependency between them. However we know that there
	# has to be a an indirect dependency, be it through primary
	# children, branch children, or a combination thereof.

	# We now fill in these pseudo-dependencies, if no such
	# dependency exists already. The direction of the dependency
	# is actually irrelevant for this.

	# NOTE: This is different from cvs2svn. Our spiritual ancestor
	# does not use such pseudo-dependencies, however it uses a
	# COMMIT_THRESHOLD, a time interval commits should fall. This
	# will greatly reduces the risk of getting far separated
	# revisions of the same file into one changeset.

	# We allow revisions to be far apart in time in the same
	# changeset, but in turn need the pseudo-dependencies to
	# handle this.

	log write 14 csets {internal  [array size dep]}
	log write 14 csets {collected [array size dependencies]}
	log write 14 csets pseudo-internalsuccessors

	array set fids {}
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT R.rid AS xrid, R.fid AS xfid
            FROM   revision R
            WHERE  R.rid IN $theset
	}] { lappend fids($xfid) $xrid }

	set groups {}
	foreach {fid rids} [array get fids] {
	    if {[llength $rids] < 2} continue
	    foreach a $rids {
		foreach b $rids {
		    if {$a == $b} continue
		    if {[info exists dep($a,$b)]} continue
		    if {[info exists dep($b,$a)]} continue
		    lappend dependencies($a) $b
		    set dep($a,$b) .
		    set dep($b,$a) .
		}
	    }
	    set n [llength $rids]
	    lappend groups [list $n [expr {($n*$n-$n)/2}]]
	}

	log write 14 csets {pseudo    [array size fids] ([lsort -index 0 -decreasing -integer $groups])}
	log write 14 csets {internal  [array size dep]}
	log write 14 csets {collected [array size dependencies]}
	log write 14 csets complete
	return
    }

    # result = 4-list (itemtype itemid nextitemtype nextitemid ...)
    typemethod loops {revisions} {
	# Note: Tags and branches cannot cause the loop. Their id's,
	# being of a fundamentally different type than the revisions
	# coming in cannot be in the set.

	set theset ('[join $revisions {','}]')
	return [state run [subst -nocommands -nobackslashes {
	    -- (1) Primary child
	    SELECT R.rid, R.child
	    FROM   revision R
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.child IS NOT NULL    -- Has primary child
	    AND    R.child IN $theset     -- Loop
	    --
	    UNION
	    -- (2) Secondary (branch) children
	    SELECT R.rid, B.brid
	    FROM   revision R, revisionbranchchildren B
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.rid = B.rid          -- Select subset of branch children
	    AND    B.rid   IN $theset     -- Loop
	    --
	    UNION
	    -- (4) Child of trunk root successor of last NTDB on trunk.
	    SELECT R.rid, RA.child
	    FROM   revision R, revision RA
	    WHERE  R.rid    IN $theset     -- Restrict to revisions of interest
	    AND    R.isdefault             -- Restrict to NTDB
	    AND    R.dbchild IS NOT NULL   -- and last NTDB belonging to trunk
	    AND    RA.rid = R.dbchild      -- Go directly to trunk root
	    AND    RA.child IS NOT NULL    -- Has primary child.
	    AND    RA.child IN $theset     -- Loop
	}]]
    }

    # var(dv) = dict (item -> list (item)), item  = list (type id)
    typemethod successors {dv revisions} {
	upvar 1 $dv dependencies
	set theset ('[join $revisions {','}]')

	# The following cases specify when a revision S is a successor
	# of a revision R. Each of the cases translates into one of
	# the branches of the SQL UNION coming below.
	#
	# (1) S can be a primary child of R, i.e. in the same LOD. R
	#     references S directly. R.child = S(.rid), if it exists.
	#
	# (2) S can be a secondary, i.e. branch, child of R. Here the
	#     link is made through the helper table
	#     REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid =
	#     S(.rid)
	#
	# (3) Originally this use case defined the root of a detached
	#     NTDB as the successor of the trunk root. This leads to a
	#     bad tangle later on. With a detached NTDB the original
	#     trunk root revision was removed as irrelevant, allowing
	#     the nominal root to be later in time than the NTDB
	#     root. Now setting this dependency will be backward in
	#     time. REMOVED.
	#
	# (4) If R is the last of the NTDB revisions which belong to
	#     the trunk, then the primary child of the trunk root (the
	#     '1.2' revision) is a successor, if it exists.

	# Note that the branches spawned from the revisions, and the
	# tags associated with them are successors as well.

	state foreachrow [subst -nocommands -nobackslashes {
    -- (1) Primary child
	    SELECT R.rid AS xrid, R.child AS xchild
	    FROM   revision R
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.child IS NOT NULL    -- Has primary child
    UNION
    -- (2) Secondary (branch) children
	    SELECT R.rid AS xrid, B.brid AS xchild
	    FROM   revision R, revisionbranchchildren B
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.rid = B.rid          -- Select subset of branch children
    UNION
    -- (4) Child of trunk root successor of last NTDB on trunk.
	    SELECT R.rid AS xrid, RA.child AS xchild
	    FROM revision R, revision RA
	    WHERE R.rid   IN $theset      -- Restrict to revisions of interest
	    AND   R.isdefault             -- Restrict to NTDB
	    AND   R.dbchild IS NOT NULL   -- and last NTDB belonging to trunk
	    AND   RA.rid = R.dbchild      -- Go directly to trunk root
	    AND   RA.child IS NOT NULL    -- Has primary child.
	}] {
	    # Consider moving this to the integrity module.
	    integrity assert {$xrid != $xchild} {Revision $xrid depends on itself.}
	    lappend dependencies([list rev $xrid]) [list rev $xchild]
	}
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT R.rid AS xrid, T.tid AS xchild
	    FROM   revision R, tag T
	    WHERE  R.rid IN $theset       -- Restrict to revisions of interest
	    AND    T.rev = R.rid          -- Select tags attached to them
	}] {
	    lappend dependencies([list rev $xrid]) [list sym::tag $xchild]
	}
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT R.rid AS xrid, B.bid AS xchild
	    FROM   revision R, branch B
	    WHERE  R.rid IN $theset       -- Restrict to revisions of interest
	    AND    B.root = R.rid         -- Select branches attached to them
	}] {
	    lappend dependencies([list rev $xrid]) [list sym::branch $xchild]
	}
	return
    }

    # result = list (changeset-id)
    typemethod cs_successors {revisions} {
        # This is a variant of 'successors' which maps the low-level
        # data directly to the associated changesets. I.e. instead
        # millions of dependency pairs (in extreme cases (Example: Tcl
        # CVS)) we return a very short and much more manageable list
        # of changesets.

	set theset ('[join $revisions {','}]')
	return [state run [subst -nocommands -nobackslashes {
    -- (1) Primary child
	    SELECT C.cid
	    FROM   revision R, csitem CI, changeset C
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.child IS NOT NULL    -- Has primary child
            AND    CI.iid = R.child       -- Select all changesets
            AND    C.cid = CI.cid         -- containing the primary child
            AND    C.type = 0             -- which are revision changesets
    UNION
    -- (2) Secondary (branch) children
	    SELECT C.cid
	    FROM   revision R, revisionbranchchildren B, csitem CI, changeset C
	    WHERE  R.rid   IN $theset     -- Restrict to revisions of interest
	    AND    R.rid = B.rid          -- Select subset of branch children
            AND    CI.iid = B.brid        -- Select all changesets
            AND    C.cid = CI.cid	  -- containing the branch
            AND    C.type = 0		  -- which are revision changesets
    UNION
    -- (4) Child of trunk root successor of last NTDB on trunk.
	    SELECT C.cid
	    FROM   revision R, revision RA, csitem CI, changeset C
	    WHERE  R.rid   IN $theset      -- Restrict to revisions of interest
	    AND    R.isdefault             -- Restrict to NTDB
	    AND    R.dbchild IS NOT NULL   -- and last NTDB belonging to trunk
	    AND    RA.rid = R.dbchild      -- Go directly to trunk root
	    AND    RA.child IS NOT NULL    -- Has primary child.
            AND    CI.iid = RA.child       -- Select all changesets
            AND    C.cid = CI.cid	   -- containing the primary child
            AND    C.type = 0		   -- which are revision changesets
    UNION
	    SELECT C.cid
	    FROM   revision R, tag T, csitem CI, changeset C
	    WHERE  R.rid in $theset        -- Restrict to revisions of interest
	    AND    T.rev = R.rid	   -- Select tags attached to them
            AND    CI.iid = T.tid          -- Select all changesets
            AND    C.cid = CI.cid	   -- containing the tags
            AND    C.type = 1		   -- which are tag changesets
    UNION
	    SELECT C.cid
	    FROM   revision R, branch B, csitem CI, changeset C
	    WHERE  R.rid in $theset        -- Restrict to revisions of interest
	    AND    B.root = R.rid	   -- Select branches attached to them
            AND    CI.iid = B.bid          -- Select all changesets
            AND    C.cid = CI.cid	   -- containing the branches
            AND    C.type = 2		   -- which are branch changesets
	}]]

	# Regarding rev -> branch|tag, we could consider looking at
	# the symbol of the branch|tag, its lod-symbol, and the
	# revisions on that lod, but don't. Because it is not exact
	# enough, the branch|tag would depend on revisions coming
	# after its creation on the parental lod.
    }

    # result = symbol name
    typemethod cs_lod {metaid revisions} {
	# Determines the name of the symbol which is the line of
	# development for the revisions in a changeset. The
	# information in the meta data referenced by the source metaid
	# is out of date by the time we come here (since pass
	# FilterSymbols), so it cannot be used. See the method 'run'
	# in file "c2f_pfiltersym.tcl" for more commentary on this.

	set theset ('[join $revisions {','}]')
	return [state run [subst -nocommands -nobackslashes {
	    SELECT
	    DISTINCT L.name
	    FROM   revision R, symbol L
	    WHERE  R.rid in $theset        -- Restrict to revisions of interest
	    AND    L.sid = R.lod           -- Get lod symbol of revision
	}]]
    }
}

# # ## ### ##### ######## ############# #####################
## Helper singleton. Commands for tag symbol changesets.

snit::type ::vc::fossil::import::cvs::project::rev::sym::tag {
    typemethod byrevision {} { return 0 }
    typemethod bysymbol   {} { return 1 }
    typemethod istag      {} { return 1 }
    typemethod isbranch   {} { return 0 }

    typemethod str {tag} {
	struct::list assign [state run {
	    SELECT S.name, F.name, P.name
	    FROM   tag T, symbol S, file F, project P
	    WHERE  T.tid = $tag   -- Find specified tag
	    AND    F.fid = T.fid  -- Get file of tag
	    AND    P.pid = F.pid  -- Get project of file
	    AND    S.sid = T.sid  -- Get symbol of tag
	}] sname fname pname
	return "$pname/T'${sname}'::$fname"
    }

    # result = list (mintime, maxtime)
    typemethod timerange {tags} {
	# The range is defined as the range of the revisions the tags
	# are attached to.

	set theset ('[join $tags {','}]')
	return [state run [subst -nocommands -nobackslashes {
	    SELECT MIN(R.date), MAX(R.date)
	    FROM   tag T, revision R
	    WHERE  T.tid IN $theset  -- Restrict to tags of interest
            AND    R.rid = T.rev     -- Select tag parent revisions
	}]]
    }

    # var(dv) = dict (item -> list (item)), item  = list (type id)
    typemethod successors {dv tags} {
	# Tags have no successors.
	return
    }

    # result = 4-list (itemtype itemid nextitemtype nextitemid ...)
    typemethod loops {tags} {
	# Tags have no successors, therefore cannot cause loops
	return {}
    }

    # result = list (changeset-id)
    typemethod cs_successors {tags} {
	# Tags have no successors.
	return
    }

    # result = symbol name
    typemethod cs_lod {sid tags} {
	# Determines the name of the symbol which is the line of
	# development for the tags in a changeset. Comes directly from
	# the symbol which is the changeset's source and its prefered
	# parent.

        return [state run {
 	    SELECT P.name
	    FROM preferedparent SP, symbol P
	    WHERE SP.sid = $sid
	    AND   P.sid = SP.pid
	}]
    }
}

# # ## ### ##### ######## ############# #####################
## Helper singleton. Commands for branch symbol changesets.

snit::type ::vc::fossil::import::cvs::project::rev::sym::branch {
    typemethod byrevision {} { return 0 }
    typemethod bysymbol   {} { return 1 }
    typemethod istag      {} { return 0 }
    typemethod isbranch   {} { return 1 }

    typemethod str {branch} {
	struct::list assign [state run {
	    SELECT S.name, F.name, P.name
	    FROM   branch B, symbol S, file F, project P
	    WHERE  B.bid = $branch  -- Find specified branch
	    AND    F.fid = B.fid    -- Get file of branch
	    AND    P.pid = F.pid    -- Get project of file
	    AND    S.sid = B.sid    -- Get symbol of branch
	}] sname fname pname
	return "$pname/B'${sname}'::$fname"
    }

    # result = list (mintime, maxtime)
    typemethod timerange {branches} {
	# The range of a branch is defined as the range of the
	# revisions the branches are spawned by. NOTE however that the
	# branches associated with a detached NTDB will have no root
	# spawning them, hence they have no real timerange any
	# longer. By using 0 we put them in front of everything else,
	# as they logically are.

	set theset ('[join $branches {','}]')
	return [state run [subst -nocommands -nobackslashes {
	    SELECT IFNULL(MIN(R.date),0), IFNULL(MAX(R.date),0)
	    FROM  branch B, revision R
	    WHERE B.bid IN $theset   -- Restrict to branches of interest
            AND   R.rid = B.root     -- Select branch parent revisions
	}]]
    }

    # result = 4-list (itemtype itemid nextitemtype nextitemid ...)
    typemethod loops {branches} {
	# Note: Revisions and tags cannot cause the loop. Being of a
	# fundamentally different type they cannot be in the incoming
	# set of ids.

	set theset ('[join $branches {','}]')
	return [state run [subst -nocommands -nobackslashes {
	    SELECT B.bid, BX.bid
	    FROM   branch B, preferedparent P, branch BX
	    WHERE  B.bid IN $theset   -- Restrict to branches of interest
	    AND    B.sid = P.pid      -- Get the prefered branches via
	    AND    BX.sid = P.sid     -- the branch symbols
	    AND    BX.bid IN $theset  -- Loop
	}]]
    }

    # var(dv) = dict (item -> list (item)), item  = list (type id)
    typemethod successors {dv branches} {
	upvar 1 $dv dependencies
	# The first revision committed on a branch, and all branches
	# and tags which have it as their prefered parent are the
	# successors of a branch.

	set theset ('[join $branches {','}]')
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT B.bid AS xbid, R.rid AS xchild
	    FROM   branch B, revision R
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.first = R.rid      -- Get first revision on the branch
	}] {
	    lappend dependencies([list sym::branch $xbid]) [list rev $xchild]
	}
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT B.bid AS xbid, BX.bid AS xchild
	    FROM   branch B, preferedparent P, branch BX
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.sid = P.pid        -- Get subordinate branches via the
	    AND    BX.sid = P.sid       -- prefered parents of their symbols
	}] {
	    lappend dependencies([list sym::branch $xbid]) [list sym::branch $xchild]
	}
	state foreachrow [subst -nocommands -nobackslashes {
	    SELECT B.bid AS xbid, T.tid AS xchild
	    FROM   branch B, preferedparent P, tag T
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.sid = P.pid        -- Get subordinate tags via the
	    AND    T.sid = P.sid        -- prefered parents of their symbols
	}] {
	    lappend dependencies([list sym::branch $xbid]) [list sym::tag $xchild]
	}
	return
    }

    # result = list (changeset-id)
    typemethod cs_successors {branches} {
        # This is a variant of 'successors' which maps the low-level
        # data directly to the associated changesets. I.e. instead
        # millions of dependency pairs (in extreme cases (Example: Tcl
        # CVS)) we return a very short and much more manageable list
        # of changesets.

	set theset ('[join $branches {','}]')
        return [state run [subst -nocommands -nobackslashes {
	    SELECT C.cid
	    FROM   branch B, revision R, csitem CI, changeset C
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.first = R.rid	-- Get first revision on the branch
            AND    CI.iid = R.rid       -- Select all changesets
            AND    C.cid = CI.cid	-- containing this revision
            AND    C.type = 0		-- which are revision changesets
    UNION
	    SELECT C.cid
	    FROM   branch B, preferedparent P, branch BX, csitem CI, changeset C
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.sid = P.pid	-- Get subordinate branches via the
	    AND    BX.sid = P.sid	-- prefered parents of their symbols
            AND    CI.iid = BX.bid      -- Select all changesets
            AND    C.cid = CI.cid	-- containing the subordinate branches
            AND    C.type = 2		-- which are branch changesets
    UNION
	    SELECT C.cid
	    FROM   branch B, preferedparent P, tag T, csitem CI, changeset C
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.sid = P.pid	-- Get subordinate tags via the
	    AND    T.sid = P.sid	-- prefered parents of their symbols
            AND    CI.iid = T.tid       -- Select all changesets
            AND    C.cid = CI.cid	-- containing the subordinate tags
            AND    C.type = 1		-- which are tag changesets
	}]]
	return
    }

    # result = symbol name
    typemethod cs_lod {sid branches} {
	# Determines the name of the symbol which is the line of
	# development for the branches in a changeset. Comes directly
	# from the symbol which is the changeset's source and its
	# prefered parent.

        return [state run {
 	    SELECT P.name
	    FROM preferedparent SP, symbol P
	    WHERE SP.sid = $sid
	    AND   P.sid = SP.pid
	}]
    }

    typemethod limits {branches} {
	# Notes. This method exists only for branches. It is needed to
	# get detailed information about a backward branch. It does
	# not apply to tags, nor revisions. The queries can also
	# restrict themselves to the revision sucessors/predecessors
	# of branches, as only they have ordering data and thus can
	# cause the backwardness.

	set theset ('[join $branches {','}]')

	set maxp [state run [subst -nocommands -nobackslashes {
	    -- maximal predecessor position per branch
	    SELECT B.bid, MAX (CO.pos)
	    FROM   branch B, revision R, csitem CI, changeset C, csorder CO
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.root = R.rid       -- Get branch root revisions
	    AND    CI.iid = R.rid       -- Get changesets containing the
	    AND    C.cid = CI.cid       -- root revisions, which are
	    AND    C.type = 0           -- revision changesets
	    AND    CO.cid = C.cid       -- Get their topological ordering
	    GROUP BY B.bid
	}]]

	set mins [state run [subst -nocommands -nobackslashes {
	    -- minimal successor position per branch
	    SELECT B.bid, MIN (CO.pos)
	    FROM   branch B, revision R, csitem CI, changeset C, csorder CO
	    WHERE  B.bid IN $theset     -- Restrict to branches of interest
	    AND    B.first = R.rid      -- Get the first revisions on the branches
	    AND    CI.iid = R.rid       -- Get changesets containing the
	    AND    C.cid = CI.cid	-- first revisions, which are
	    AND    C.type = 0		-- revision changesets
	    AND    CO.cid = C.cid	-- Get their topological ordering
	    GROUP BY B.bid
	}]]

        return [list $maxp $mins]
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
    pragma -hastypedestroy no ; # immortal
}

# # ## ### ##### ######## ############# #####################
##

namespace eval ::vc::fossil::import::cvs::project {
    namespace export rev
    namespace eval rev {
	namespace import ::vc::fossil::import::cvs::state
	namespace import ::vc::fossil::import::cvs::integrity
	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log
	log register csets

	# Set up the helper singletons
	namespace eval rev {
	    namespace import ::vc::fossil::import::cvs::state
	    namespace import ::vc::fossil::import::cvs::integrity
	    namespace import ::vc::tools::log
	}
	namespace eval sym::tag {
	    namespace import ::vc::fossil::import::cvs::state
	    namespace import ::vc::fossil::import::cvs::integrity
	    namespace import ::vc::tools::log
	}
	namespace eval sym::branch {
	    namespace import ::vc::fossil::import::cvs::state
	    namespace import ::vc::fossil::import::cvs::integrity
	    namespace import ::vc::tools::log
	}
    }
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::project::rev 1.0
return