## -*- 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
# # ## ### ##### ######## ############# #####################

## File, part of a project, part of a CVS repository. Multiple
## instances are possible.

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

package require Tcl 8.4                             ; # Required runtime.
package require snit                                ; # OO system.
package require struct::set                         ; # Set operations.
package require struct::list                        ; # Higher order operations.
package require vc::fossil::import::cvs::blobstore  ; # Blob storage.
package require vc::fossil::import::cvs::file::rev  ; # CVS per file revisions.
package require vc::fossil::import::cvs::file::sym  ; # CVS per file symbols.
package require vc::fossil::import::cvs::state      ; # State storage.
package require vc::fossil::import::cvs::integrity  ; # State integrity checks.
package require vc::fossil::import::cvs::gtcore     ; # Graph traversal core.
package require vc::tools::trouble                  ; # Error reporting.
package require vc::tools::log                      ; # User feedback
package require vc::tools::misc                     ; # Text formatting

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

snit::type ::vc::fossil::import::cvs::file {
    # # ## ### ##### ######## #############
    ## Public API

    constructor {id path usrpath executable project} {
	set myid         $id
	set mypath       $path
	set myusrpath    $usrpath
	set myexecutable $executable
	set myproject    $project
	set mytrunk      [$myproject trunk]
	set myblob       [blobstore ${selfns}::%AUTO% $id]
	return
    }

    method setid {id} {
	integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'}
	set myid $id
	$myblob setid $id
	return
    }

    method id      {} { return $myid }
    method path    {} { return $mypath }
    method usrpath {} { return $myusrpath }
    method project {} { return $myproject }

    delegate method commitmessageof to myproject

    # # ## ### ##### ######## #############
    ## Methods required for the class to be a sink of the rcs parser

    #method begin {} {puts begin}
    #method sethead {h} {puts head=$h}
    #method setprincipalbranch {b} {puts pb=$b}
    #method deftag {s r} {puts $s=$r}
    #method setcomment {c} {puts comment=$c}
    #method admindone {} {puts admindone}
    #method def {rev date author state next branches} {puts "def $rev $date $author $state $next $branches"}
    #method defdone {} {puts def-done}
    #method setdesc {d} {puts desc=$d}
    #method extend {rev commitmsg deltarange} {puts "extend $commitmsg $deltarange"}
    #method done {} {puts done}

    # # ## ### ##### ######## #############
    ## Persistence (pass II)

    method persist {} {
	# First collect the reachable revisions and symbols, then
	# assign id's to all. They are sorted so that we will have ids
	# which sort in order of creation. Then we can save them. This
	# is done bottom up. Revisions, then symbols. __NOTE__ This
	# works only because sqlite is not checking foreign key
	# references during insert. This allows to have dangling
	# references which are fixed later. The longest dangling
	# references are for the project level symbols, these we do
	# not save here, but at the end of the pass. What we need are
	# the ids, hence the two phases.

	struct::list assign [$self Active] revisions symbols
	foreach rev $revisions { $rev defid }
	foreach sym $symbols   { $sym defid }

	state transaction {
	    foreach rev $revisions { $rev persist }
	    foreach sym $symbols   { $sym persist }
	    $myblob persist
	}
	return
    }

    method drop {} {
	foreach {_ rev}    [array get myrev]      { $rev destroy }
	foreach {_ branch} [array get mybranches] { $branch destroy }
	foreach {_ taglist} [array get mytags] {
	    foreach tag $taglist { $tag destroy }
	}
	return
    }

    # # ## ### ##### ######## #############
    ## Implement the sink

    method begin {} {#ignore}

    method sethead {revnr} {
	set myheadrevnr $revnr
	return
    }

    method setprincipalbranch {branchnr} {
	set myprincipal $branchnr
	return
    }

    method deftag {name revnr} {
	# FUTURE: Perform symbol transformation here.

	if {[struct::set contains $mysymbols $name]} {
	    trouble fatal "Multiple definitions of the symbol '$name' in '$mypath'"
	    return
	}

	struct::set add mysymbols $name

	if {[rev isbranchrevnr $revnr -> branchnr]} {
	    $self AddBranch $name $branchnr
	} else {
	    $self AddTag $name $revnr
	}
	return
    }

    method setcomment {c} {# ignore}

    method admindone {} {
	# We do nothing at the boundary of admin and revision data
    }

    method def {revnr date author state next branches} {
	$self RecordBranchCommits $branches

	if {[info exists myrev($revnr)]} {
	    trouble fatal "File $mypath contains duplicate definitions for revision $revnr."
	    return
	}

	set myaid($revnr) [$myproject defauthor $author]
	set myrev($revnr) [rev %AUTO% $revnr $date $state $self]

	$myblob add $revnr $myrev($revnr)

	if {$next ne ""} {
	    # parent revision NEXT is a delta of current.
	    $myblob delta $next $revnr
	}
	foreach b $branches {
	    # branch child revision B is a delta of current.
	    $myblob delta $b $revnr
	}

	$self RecordBasicDependencies $revnr $next
	return
    }

    method defdone {} {
	# This is all done after the revision tree has been extracted
	# from the file, before the commit mesages and delta texts are
	# processed.

	$self ProcessPrimaryDependencies
	$self ProcessBranchDependencies
	$self SortBranches
	$self ProcessTagDependencies
	$self DetermineTheRootRevision
	return
    }

    method setdesc {d} {# ignore}

    method extend {revnr commitmsg textrange} {
	set cmid [$myproject defcmessage [string trim $commitmsg]]

	set rev $myrev($revnr)

	if {[$rev hasmeta]} {
	    # Apparently repositories exist in which the delta data
	    # for revision 1.1 is provided several times, at least
	    # twice. The actual cause of this duplication is not
	    # known. Speculation centers on RCS/CVS bugs, or from
	    # manual edits of the repository which borked the
	    # internals. Whatever the cause, testing showed that both
	    # cvs and rcs use the first definition when performing a
	    # checkout, and we follow their lead. Side notes: 'cvs
	    # log' fails on such a file, and 'cvs rlog' prints the log
	    # message from the first delta, ignoring the second.

	    log write 1 file "In file $mypath : Duplicate delta data for revision $revnr"
	    log write 1 file "Ignoring the duplicate"
	    return
	}

	# Determine the line of development for the revision (project
	# level). This gives us the branchid too, required for the
	# meta data group the revision is in. (Note: By putting both
	# branch/lod and project information into the group we ensure
	# that any cross-project and cross-branch commits are
	# separated into multiple commits, one in each of the projects
	# and/or branches).

	set lod [$self GetLOD $revnr]

	$rev setmeta [$myproject defmeta [$lod id] $myaid($revnr) $cmid]
	# Note: We keep settext on file::rev for the hastext queries
	# used by several checks.
	$rev settext $textrange
	$rev setlod  $lod

	$myblob extend $revnr $textrange

	# If this is revision 1.1, we have to determine whether the
	# file seems to have been created through 'cvs add' instead of
	# 'cvs import'. This can be done by looking at the un-
	# adulterated commit message, as CVS uses a hardwired magic
	# message for the latter, i.e. "Initial revision\n", no
	# period.  (This fact also helps us when the time comes to
	# determine whether this file might have had a default branch
	# in the past.)

	if {$revnr eq "1.1"} {
	    set myimported [expr {$commitmsg eq "Initial revision\n"}]
	}

	# Here we also keep track of the order in which the revisions
	# were added to the file.

	lappend myrevisions $rev
	return
    }

    method done {} {
	# Complete the revisions, branches, and tags. This includes
	# looking for a non-trunk default branch, marking its members
	# and linking them into the trunk, possibly excluding
	# non-trunk data, and collecting aggregate symbol statistics.

	$self DetermineRevisionOperations
	$self DetermineLinesOfDevelopment
	$self HandleNonTrunkDefaultBranch
	$self RemoveIrrelevantDeletions
	$self RemoveInitialBranchDeletions

	if {[$myproject trunkonly]} {
	    $self ExcludeNonTrunkInformation
	}

	$self AggregateSymbolData
	return
    }

    # # ## ### ##### ######## #############
    ## Pass XII (Import).

    method pushto {repository} {
	log write 2 file {Importing file "$mypath"}

	set ws [$repository workspace]
	struct::list assign [$self Expand $ws] filemap revmap
	# filemap = dict (path -> uuid)
	# revmap  = dict (path -> rid)

	array set idmap [$repository importfiles $filemap]

	# Wipe workspace clean of the imported files.
	foreach x [glob -directory $ws r*] { ::file delete $x }

	foreach {path rid} $revmap {
	    set uuid $idmap($path)
	    state run {
		INSERT INTO revuuid (rid,  uuid)
		VALUES              ($rid, $uuid)
	    }
	}
	return
    }

    method Expand {dir} {
	set ex [struct::graph ex] ; # Expansion graph.
	set zp [struct::graph zp] ; # Zip/Import graph.

	close [open $dir/r__empty__ w];# Base for detached roots on branches.

	# Phase I: Pull blobs and referenced revisions from the state
	#          and fill the graphs with them...

	# Note: We use the blobs for expansion because we need them
	#       all, even those without revision, for both proper
	#       ordering and exact patch application.

	set earcs   {} ; # Arcs for expansion graph
	set zarcs   {} ; # Arcs for zip graph
	set revmap  {} ; # path -> rid map to later merge uuid information

	state foreachrow {
	    SELECT B.rid    AS xrid,
	           R.rev    AS revnr,
	           R.child  AS xchild,
	           B.coff   AS xcoff,
	           B.clen   AS xclen,
	           B.bid    AS cid,
	           B.pid    AS cparent
	    FROM            blob B
	    LEFT OUTER JOIN revision R
	    ON              B.rid = R.rid
	    WHERE  B.fid = $myid
	} {
	    # Main data are blobs, most will have revisions, but not
	    # all. The expansion graph is blob based, whereas the
	    # recompression graph is revision based.

	    if {$revnr ne ""} {
		# Blob has revision, extend recompression graph.

		lappend revmap r$revnr $xrid

		$zp node insert $xrid
		$zp node set    $xrid revnr $revnr
		$zp node set    $xrid label <$revnr>

		if {$xchild ne ""} {
		    lappend zarcs $xchild $xrid
		}
	    } else {
		# We fake a revnr for the blobs which have no
		# revision, for use in the expansion graph.
		set revnr ghost$cid
	    }

	    # Now the expansion graph.

	    $ex node insert $cid
	    $ex node set    $cid text  [list $xcoff $xclen]
	    $ex node set    $cid revnr $revnr
	    $ex node set    $cid label <$revnr>

	    if {$cparent ne ""} {
		# The expansion arcs go from baseline to delta
		# descendant, based on the blob information.
		lappend earcs $cparent $cid
	    }
	}

	# Phase II: Insert the accumulated dependencies

	foreach {from to} $earcs { $ex arc insert $from $to }
	foreach {from to} $zarcs { $zp arc insert $from $to }

	# Phase III: Traverse the graphs, expand the file, and
	#            generate import instructions.

	set archive [::file join [$myproject fullpath] $mypath]
	set ac      [open $archive r]
	fconfigure $ac -translation binary

	# First traverse the expansion graph, this gives us the
	# revisions in the order we have to expand them, which we do.

	set max [llength [$ex nodes]]
	set myimport 0

	gtcore datacmd   [mymethod ExpandData]
	gtcore formatcmd [mymethod ExpandFormat]
	gtcore sortcmd   [mymethod ExpandSort]
	gtcore savecmd   [mymethod Expand1 $ac $dir $max]

	gtcore traverse $ex {Expanding revisions...}
	close $ac

	# Now traverse the import graph, this builds the instruction
	# map for the fossil deltas.

	gtcore datacmd   [mymethod ExpandData]
	gtcore formatcmd [mymethod ExpandFormat]
	gtcore sortcmd   [mymethod ExpandSort]
	gtcore savecmd   [mymethod Expand2]

	set myimport {}
	gtcore traverse $zp {Generating revision order for import...}
	set filemap $myimport
	unset myimport

	# And back to import control

	$ex destroy
	$zp destroy

	return [list $filemap $revmap]
    }

    method ExpandData   {graph node} { return [$graph node get $node revnr] }
    method ExpandFormat {graph item} { return <[lindex $item 1]> } ; # revnr
    method ExpandSort   {graph candidates} {
	# candidates = list(item), item = list(node revnr)
	# Sort by node and revnr -> Trunk revisions come first.
	return [lsort -index 1 -dict [lsort -index 0 -dict $candidates]]
    }
    method Expand1 {chan dir max graph node} {
	log progress 3 file $myimport $max ; incr myimport

	set revnr           [$graph node get $node revnr]
	set fname          r$revnr
	struct::list assign [$graph node get $node text] offset length

	if {$length < 0} {
	    set data ""
	} else {
	    seek $chan $offset start
	    set data [string map {@@ @} [read $chan $length]]
	}

	if {![$graph node keyexists $node __base__]} {
	    # Full text node. Get the data, decode it, and save.

	    log write 8 file {Expanding <$revnr>, full text}

	    fileutil::writeFile -translation binary $dir/$fname $data
	} else {
	    # Delta node. __base__ is the name of the file containing
	    # the baseline. The patch is at the specified location of
	    # the archive file.

	    set fbase [$graph node get $node __base__]
	    log write 8 file {Expanding <$revnr>, is delta of <$fbase>}

	    set base [fileutil::cat -translation binary $dir/$fbase]

	    # Writing the patch to disk is just for better
	    # debugging. It is not used otherwise.
	    fileutil::writeFile $dir/rpatch $data
	    fileutil::writeFile -translation binary $dir/$fname \
		[Apply $base $data]
	}

	# Post to all successors that the just generated file is their
	# baseline.

	foreach out [$graph nodes -out $node] {
	    $graph node set $out __base__ $fname
	}
	return
    }

    proc Apply {base delta} {
	# base  = base text.
	# delta = delta in rcs format.
	#
	# Both strings are unencoded, i.e. things like @@, etc. have
	# already been replaced with their proper characters.
	#
	# Return value is the patched text.

	set base [split $base \n]
	set blen [llength $base]
	set ooff 0
	set res ""

	set lines  [split $delta \n]
	set nlines [llength $lines]

	log write 11 file {Base  lines = $blen}
	log write 11 file {Delta lines = $nlines}

	for {set i 0} {$i < $nlines} {} {
	    log write 11 file {    @ $i = [lindex $lines $i]}
	    log write 11 file { ooff $ooff}

	    if {![regexp {^([ad])(\d+)\s(\d+)$} [lindex $lines $i] -> cmd sl cn]} {
		trouble internal "Bad ed command '[lindex $lines $i]'"
	    }

	    log write 11 file {  cmd $cmd}
	    log write 11 file {   sl $sl}
	    log write 11 file {   cn $cn}

	    incr i
	    set el [expr {$sl + $cn}]

	    log write 11 file {   el $el}

	    switch -exact -- $cmd {
		d {
		    incr sl -1
		    incr el -1
		    if {$sl < $ooff} { trouble internal {Deletion before last edit} }
		    if {$sl > $blen} { trouble internal {Deletion past file end} }
		    if {$el > $blen} { trouble internal {Deletion beyond file end} }
		    foreach x [lrange $base $ooff [expr {$sl - 1}]] {
			log write 15 file {.|$x|}
			lappend res $x
		    }
		    set  ooff $el
		}
		a {
		    if {$sl < $ooff} { trouble internal {Insert before last edit} }
		    if {$sl > $blen} { trouble internal {Insert past file end} }

		    foreach x [lrange $base $ooff [expr {$sl - 1}]] {
			log write 15 file {.|$x|}
			lappend res $x
		    }
		    foreach x [lrange $lines $i [expr {$i + $cn - 1}]] {
			log write 15 file {+|$x|}
			lappend res $x
		    }
		    set ooff $sl
		    incr i $cn
		}
	    }
	}
	foreach x [lrange $base $ooff end] { lappend res $x }
	return [join $res \n]
    }

    method Expand2 {graph node} {
	set revnr [$graph node get $node revnr]

	# First import the file.
	lappend myimport [list A r$revnr {}]

	if {[$graph node keyexists $node __base__]} {
	    # Delta node. __base__ is the name of the file containing
	    # the baseline. Generate instruction to make the delta as
	    # well.

	    set fbase [$graph node get $node __base__]
	    lappend myimport [list D r$revnr r$fbase]
	}

	# Post to all successors that the just generated file is their
	# baseline. Exception: Those which ave already a baseline set.
	# Together with the sorting of trunk revisions first the trunk
	# should one uninterupted line, with branch roots _not_ delta
	# compressed per their branches.

	foreach out [$graph nodes -out $node] {
	    if {[$graph node keyexists $out __base__]} continue
	    $graph node set $out __base__ $revnr
	}
	return
    }

    variable myimport

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

    variable myid              {} ; # File id in the persistent state.
    variable mypath            {} ; # Path of the file's rcs archive.
    variable myusrpath         {} ; # Path of the file as seen by users.
    variable myexecutable      0  ; # Boolean flag 'file executable'.
    variable myproject         {} ; # Reference to the project object
				    # the file belongs to.
    variable myrev -array      {} ; # Maps revision number to the
				    # associated revision object.
    variable myrevisions       {} ; # Same as myrev, but a list,
				    # giving us the order of
				    # revisions.
    variable myaid      -array {} ; # Map revision numbers to the id
				    # of the author who committed
				    # it. This is later aggregated
				    # with commit message, branch name
				    # and project id for a meta id.
    variable myheadrevnr       {} ; # Head revision (revision number)
    variable myprincipal       {} ; # Principal branch (branch number).
				    # Contrary to the name this is the
				    # default branch.
    variable mydependencies    {} ; # Dictionary parent -> child,
				    # records primary dependencies.
    variable myimported        0  ; # Boolean flag. Set if and only if
				    # rev 1.1 of the file seemingly
				    # was imported instead of added
				    # normally.
    variable myroot            {} ; # Reference to the revision object
				    # holding the root revision.  Its
				    # number usually is '1.1'. Can be
				    # a different number, because of
				    # gaps created via 'cvsadmin -o'.
    variable mybranches -array {} ; # Maps branch number to the symbol
				    # object handling the branch.
    variable mytags     -array {} ; # Maps revision number to the list
				    # of symbol objects for the tags
				    # associated with the revision.
    variable mysymbols         {} ; # Set of the symbol names found in
				    # this file.

    variable mybranchcnt 0 ; # Counter for branches, to record their
			     # order of definition. This also defines
			     # their order of creation, which is the
			     # reverse of definition.  I.e. a smaller
			     # number means 'Defined earlier', means
			     # 'Created later'.

    variable mytrunk {} ; # Direct reference to myproject -> trunk.
    variable myroots {} ; # List of roots in the forest of
			  # lod's. Object references to revisions and
			  # branches. The latter can appear when they
			  # are severed from their parent.

    variable myblob {} ; # Reference to the object managing the blob
			 # information (textrange of revisions, and
			 # delta dependencies) of this file.

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

    method RecordBranchCommits {branches} {
	foreach branchrevnr $branches {
	    if {[catch {
		set branch [$self Rev2Branch $branchrevnr]
	    }]} {
		set branch [$self AddUnlabeledBranch [rev 2branchnr $branchrevnr]]
	    }

	    # Record the commit, just as revision number for
	    # now. ProcesBranchDependencies will extend that ito a
	    # proper object reference.

	    $branch setchildrevnr $branchrevnr
	}
	return
    }

    method Rev2Branch {revnr} {
        integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number}
	return $mybranches([rev 2branchnr $revnr])
    }

    method AddUnlabeledBranch {branchnr} {
	return [$self AddBranch unlabeled-$branchnr $branchnr]
    }

    method AddBranch {name branchnr} {
	if {[info exists mybranches($branchnr)]} {
	    log write 1 file "In '$mypath': Branch '$branchnr' named '[$mybranches($branchnr) name]'"
	    log write 1 file "Cannot have second name '$name', ignoring it"
	    return
	}
	set branch [sym %AUTO% branch $branchnr [$myproject getsymbol $name] $self]
	$branch setposition [incr mybranchcnt]
	set mybranches($branchnr) $branch
	return $branch
    }

    method AddTag {name revnr} {
	set tag [sym %AUTO% tag $revnr [$myproject getsymbol $name] $self]
	lappend mytags($revnr) $tag
	return $tag
    }

    method RecordBasicDependencies {revnr next} {
	# Handle the revision dependencies. Record them for now, do
	# nothing with them yet.

	# On the trunk the 'next' field points to the previous
	# revision, i.e. the _parent_ of the current one. Example:
	# 1.6's next is 1.5 (modulo cvs admin -o).

	# Contrarily on a branch the 'next' field points to the
	# primary _child_ of the current revision. As example,
	# 1.1.3.2's 'next' will be 1.1.3.3.

	# The 'next' field actually always refers to the revision
	# containing the delta needed to retrieve that revision.

	# The dependencies needed here are the logical structure,
	# parent/child, and not the implementation dependent delta
	# pointers.

	if {$next eq ""} return
	#                          parent -> child
	if {[rev istrunkrevnr $revnr]} {
	    lappend mydependencies $next $revnr
	} else {
	    lappend mydependencies $revnr $next
	}
	return
    }

    method ProcessPrimaryDependencies {} {
	foreach {parentrevnr childrevnr} $mydependencies {
	    set parent $myrev($parentrevnr)
	    set child  $myrev($childrevnr)
	    $parent setchild $child
	    $child setparent $parent
	}
	return
    }

    method ProcessBranchDependencies {} {
	foreach {branchnr branch} [array get mybranches] {
	    set revnr [$branch parentrevnr]

	    if {![info exists myrev($revnr)]} {
		log write 1 file "In '$mypath': The branch '[$branch name]' references"
		log write 1 file "the bogus revision '$revnr' and will be ignored."
		$branch destroy
		unset mybranches($branchnr)
	    } else {
		set rev $myrev($revnr)
		$rev addbranch $branch
		$branch setparent $rev

		# If revisions were committed on the branch we store a
		# reference to the branch there, and further declare
		# the first child's parent to be branch's parent, and
		# list this child in the parent revision.

		if {[$branch haschildrev]} {
		    set childrevnr [$branch childrevnr]
		    set child $myrev($childrevnr)
		    $branch setchild $child

		    $child setparentbranch $branch
		    $child setparent       $rev
		    $rev addchildonbranch $child
		}
	    }
	}
	return
    }

    method SortBranches {} {
	foreach {revnr rev} [array get myrev] { $rev sortbranches }
	return
    }

    method ProcessTagDependencies {} {
	foreach {revnr taglist} [array get mytags] {
	    if {![info exists myrev($revnr)]} {
		set n [llength $taglist]
		log write 1 file "In '$mypath': The following [nsp $n tag] reference"
		log write 1 file "the bogus revision '$revnr' and will be ignored."
		foreach tag $taglist {
		    log write 1 file "    [$tag name]"
		    $tag destroy
		}
		unset mytags($revnr)
	    } else {
		set rev $myrev($revnr)
		foreach tag $taglist {
		    $rev addtag    $tag
		    $tag settagrev $rev
		}
	    }
	}
	return
    }

    method DetermineTheRootRevision {} {
	# The root is the one revision which has no parent. By
	# checking all revisions we ensure that we can detect and
	# report the case of multiple roots. Without that we could
	# simply take one revision and follow the parent links to
	# their root (sic!).

	foreach {revnr rev} [array get myrev] {
	    if {[$rev hasparent]} continue
	    integrity assert {$myroot eq ""} {Multiple root revisions found}
	    set myroot $rev
	}

	# In the future we also need a list, as branches can become
	# severed from their parent, making them their own root.
	set myroots [list $myroot]
	return
    }

    method DetermineRevisionOperations {} {
	foreach rev $myrevisions { $rev determineoperation }
	return
    }

    method DetermineLinesOfDevelopment {} {
	# For revisions this has been done already, in 'extend'. Now
	# we do this for the branches and tags.

	foreach {_ branch} [array get mybranches] {
	    $branch setlod [$self GetLOD [$branch parentrevnr]]
	}

	foreach {_ taglist} [array get mytags] {
	    foreach tag $taglist {
		$tag setlod [$self GetLOD [$tag tagrevnr]]
	    }
	}
	return
    }

    method GetLOD {revnr} {
	if {[rev istrunkrevnr $revnr]} {
	    return $mytrunk
	} else {
	    return [$self Rev2Branch $revnr]
	}
    }

    method HandleNonTrunkDefaultBranch {} {
	set revlist [$self NonTrunkDefaultRevisions]
	if {![llength $revlist]} return

	$self AdjustNonTrunkDefaultBranch $revlist
	$self CheckLODs
	return
    }

    method NonTrunkDefaultRevisions {} {
	# From cvs2svn the following explanation (with modifications
	# for our algorithm):

	# Determine whether there are any non-trunk default branch
	# revisions.

	# If a non-trunk default branch is determined to have existed,
	# return a list of objects for all revisions that were once
	# non-trunk default revisions, in dependency order (i.e. root
	# first).

	# There are two cases to handle:

	# One case is simple.  The RCS file lists a default branch
	# explicitly in its header, such as '1.1.1'.  In this case, we
	# know that every revision on the vendor branch is to be
	# treated as head of trunk at that point in time.

	# But there's also a degenerate case.  The RCS file does not
	# currently have a default branch, yet we can deduce that for
	# some period in the past it probably *did* have one.  For
	# example, the file has vendor revisions 1.1.1.1 -> 1.1.1.96,
	# all of which are dated before 1.2, and then it has 1.1.1.97
	# -> 1.1.1.100 dated after 1.2.  In this case, we should
	# record 1.1.1.96 as the last vendor revision to have been the
	# head of the default branch.

	if {$myprincipal ne ""} {
	    # There is still a default branch; that means that all
	    # revisions on that branch get marked.

	    log write 5 file "Found explicitly marked NTDB"

	    set rnext [$myroot child]
	    if {$rnext ne ""} {
		trouble fatal "File with default branch $myprincipal also has revision [$rnext revnr]"
		return
	    }

	    set rev [$mybranches($myprincipal) child]
	    set res {}

	    while {$rev ne ""} {
		lappend res $rev
		set rev [$rev child]
	    }

	    return $res

	} elseif {$myimported} {
	    # No default branch, but the file appears to have been
	    # imported.  So our educated guess is that all revisions
	    # on the '1.1.1' branch with timestamps prior to the
	    # timestamp of '1.2' were non-trunk default branch
	    # revisions.

	    # This really only processes standard '1.1.1.*'-style
	    # vendor revisions.  One could conceivably have a file
	    # whose default branch is 1.1.3 or whatever, or was that
	    # at some point in time, with vendor revisions 1.1.3.1,
	    # 1.1.3.2, etc.  But with the default branch gone now,
	    # we'd have no basis for assuming that the non-standard
	    # vendor branch had ever been the default branch anyway.

	    # Note that we rely on comparisons between the timestamps
	    # of the revisions on the vendor branch and that of
	    # revision 1.2, even though the timestamps might be
	    # incorrect due to clock skew.  We could do a slightly
	    # better job if we used the changeset timestamps, as it is
	    # possible that the dependencies that went into
	    # determining those timestamps are more accurate.  But
	    # that would require an extra pass or two.

	    if {![info exists mybranches(1.1.1)]} { return {} }

	    log write 5 file "Deduced existence of NTDB"

	    set rev  [$mybranches(1.1.1) child]
	    set res  {}
	    set stop [$myroot child]

	    if {$stop eq ""} {
		# Get everything on the branch
		while {$rev ne ""} {
		    lappend res $rev
		    set rev [$rev child]
		}
	    } else {
		# Collect everything on the branch which seems to have
		# been committed before the first primary child of the
		# root revision.
		set stopdate [$stop date]
		while {$rev ne ""} {
		    if {[$rev date] >= $stopdate} break
		    lappend res $rev
		    set rev [$rev child]
		}
	    }

	    return $res

	} else {
	    return {}
	}
    }

    # General note: In the following methods we only modify the links
    # between revisions and symbols to restructure the revision
    # tree. We do __not__ destroy the objects. Given the complex links
    # GC is difficult at this level. It is much easier to drop
    # everything when we we are done. This happens in 'drop', using
    # the state variable 'myrev', 'mybranches', and 'mytags'. What we
    # have to persist, performed by 'persist', we know will be
    # reachable through the revisions listed in 'myroots' and their
    # children and symbols.

    method AdjustNonTrunkDefaultBranch {revlist} {
	set stop [$myroot child] ;# rev '1.2'

	log write 5 file "Adjusting NTDB containing [nsp [llength $revlist] revision]"

	# From cvs2svn the following explanation (with modifications
	# for our algorithm):

	# Adjust the non-trunk default branch revisions found in the
	# 'revlist'.

	# 'myimported' is a boolean flag indicating whether this file
	# appears to have been imported, which also means that
	# revision 1.1 has a generated log message that need not be
	# preserved.  'revlist' is a list of object references for the
	# revisions that have been determined to be non-trunk default
	# branch revisions.

	# Note that the first revision on the default branch is
	# handled strangely by CVS.  If a file is imported (as opposed
	# to being added), CVS creates a 1.1 revision, then creates a
	# vendor branch 1.1.1 based on 1.1, then creates a 1.1.1.1
	# revision that is identical to the 1.1 revision (i.e., its
	# deltatext is empty).  The log message that the user typed
	# when importing is stored with the 1.1.1.1 revision.  The 1.1
	# revision always contains a standard, generated log message,
	# 'Initial revision\n'.

	# When we detect a straightforward import like this, we want
	# to handle it by deleting the 1.1 revision (which doesn't
	# contain any useful information) and making 1.1.1.1 into an
	# independent root in the file's dependency tree.  In SVN,
	# 1.1.1.1 will be added directly to the vendor branch with its
	# initial content.  Then in a special 'post-commit', the
	# 1.1.1.1 revision is copied back to trunk.

	# If the user imports again to the same vendor branch, then CVS
	# creates revisions 1.1.1.2, 1.1.1.3, etc. on the vendor branch,
	# *without* counterparts in trunk (even though these revisions
	# effectively play the role of trunk revisions).  So after we add
	# such revisions to the vendor branch, we also copy them back to
	# trunk in post-commits.

	# We mark the revisions found in 'revlist' as default branch
	# revisions.  Also, if the root revision has a primary child
	# we set that revision to depend on the last non-trunk default
	# branch revision and possibly adjust its type accordingly.

	set first [lindex $revlist 0]

	log write 6 file "<[$first revnr]> [expr {$myimported ? "imported" : "not imported"}], [$first operation], [expr {[$first hastext] ? "has text" : "no text"}]"

	if {$myimported &&
	    [$first revnr] eq "1.1.1.1" &&
	    [$first operation] eq "change" &&
	    ![$first hastext]} {

	    set rev11 [$first parent] ; # Assert: Should be myroot.
	    log write 3 file "Removing irrelevant revision [$rev11 revnr]"

	    # Cut out the old myroot revision.

	    ldelete myroots $rev11 ; # Not a root any longer.

	    $first cutfromparent ; # Sever revision from parent revision.
	    if {$stop ne ""} {
		$stop cutfromparent
		lappend myroots $stop ; # New root, after vendor branch
	    }

	    # Cut out the vendor branch symbol

	    set vendor [$first parentbranch]
	    integrity assert {$vendor ne ""} {First NTDB revision has no branch}
	    if {[$vendor parent] eq $rev11} {
		$rev11 removebranch        $vendor
		$rev11 removechildonbranch $first
		$vendor cutbranchparent    ;# bp = rev11, about to be gone
		$first cutfromparentbranch ;# pb = vendor, to be a detached LOD
		lappend myroots $first
	    }

	    # Change the type of first (typically from Change to Add):
	    $first retype add

	    # Move any tags and branches from the old to the new root.
	    $rev11 movesymbolsto $first
	}

	# Mark all the special revisions as such
	foreach rev $revlist {
	    log write 3 file "Revision on default branch: [$rev revnr]"
	    $rev setondefaultbranch 1
	}

	if {$stop ne ""} {
	    # Revision 1.2 logically follows the imported revisions,
	    # not 1.1.  Accordingly, connect it to the last NTDBR and
	    # possibly change its type.

	    set last [lindex $revlist end]
	    $stop setdefaultbranchparent $last ; # Retypes the revision too.
	    $last setdefaultbranchchild  $stop
	}
	return
    }

    method CheckLODs {} {
	foreach {_ branch}  [array get mybranches] { $branch checklod }
	foreach {_ taglist} [array get mytags] {
	    foreach tag $taglist { $tag checklod }
	}
	return
    }

    method RemoveIrrelevantDeletions {} {
	# From cvs2svn: If a file is added on a branch, then a trunk
	# revision is added at the same time in the 'Dead' state.
	# This revision doesn't do anything useful, so delete it.

	foreach root $myroots {
	    if {[$root isneeded]} continue
	    log write 2 file "Removing unnecessary dead revision [$root revnr]"

	    # Remove as root, make its child new root after
	    # disconnecting it from the revision just going away.

	    ldelete myroots $root
	    if {[$root haschild]} {
		set child [$root child]
		$child cutfromparent
		lappend myroots $child
	    }

	    # Cut out the branches spawned by the revision to be
	    # deleted. If the branch has revisions they should already
	    # use operation 'add', no need to change that. The first
	    # revision on each branch becomes a new and disconnected
	    # root.

	    foreach branch [$root branches] {
		$branch cutbranchparent
		if {![$branch haschild]} continue
		set first [$branch child]
		$first cutfromparent
		lappend myroots $first
	    }
	    $root removeallbranches

	    # Tagging a dead revision doesn't do anything, so remove
	    # any tags that were set on it.

	    $root removealltags

	    # This can only happen once per file, and we might have
	    # just changed myroots, so end the loop
	    break
	}
	return
    }

    method RemoveInitialBranchDeletions {} {
	# From cvs2svn: If the first revision on a branch is an
	# unnecessary delete, remove it.
	#
	# If a file is added on a branch (whether or not it already
	# existed on trunk), then new versions of CVS add a first
	# branch revision in the 'dead' state (to indicate that the
	# file did not exist on the branch when the branch was
	# created) followed by the second branch revision, which is an
	# add.  When we encounter this situation, we sever the branch
	# from trunk and delete the first branch revision.

	# At this point we may have already multiple roots in myroots,
	# we have to process them all.

	foreach root [$self LinesOfDevelopment] {
	    if {[$root isneededbranchdel]} continue
	    log write 2 file "Removing unnecessary initial branch delete [$root revnr]"

	    set branch [$root parentbranch]
	    set parent [$root parent]
	    set child  [$root child]

	    ldelete myroots $root
	    lappend myroots $child

	    $branch cutbranchparent
	    $branch cutchild
	    $child  cutfromparent

	    $branch setchild        $child
	    $child  setparentbranch $branch

	    $parent removebranch        $branch
	    $parent removechildonbranch $root
	}
	return
    }

    method LinesOfDevelopment {} {
	# Determine all lines of development for the file. This are
	# the known roots, and the root of all branches found on the
	# line of primary children.

	set lodroots {}
	foreach root $myroots {
	    $self AddBranchedLinesOfDevelopment lodroots $root
	    lappend lodroots $root
	}
	return $lodroots
    }

    method AddBranchedLinesOfDevelopment {lv root} {
	upvar 1 $lv lodroots
	while {$root ne ""} {
	    foreach branch [$root branches] {
		if {![$branch haschild]} continue
		set child [$branch child]
		# Recurse into the branch for deeper branches.
		$self AddBranchedLinesOfDevelopment lodroots $child
		lappend lodroots $child
	    }
	    set root [$root child]
	}
	return
    }

    method ExcludeNonTrunkInformation {} {
	# Remove all non-trunk branches, revisions, and tags. We do
	# keep the tags which are on the trunk.

	set ntdbroot ""
	foreach root [$self LinesOfDevelopment] {
	    # Note: Here the order of the roots is important,
	    # i.e. that we get them in depth first order. This ensures
	    # that the removal of a branch happens only after the
	    # branches spawned from it were removed. Otherwise the
	    # system might try to access deleted objects.

	    # Do not exclude the trunk.
	    if {[[$root lod] istrunk]} continue
	    $self ExcludeBranch $root ntdbroot
	}

	if {$ntdbroot ne ""} {
	    $self GraftNTDB2Trunk $ntdbroot
	}
	return
    }

    method ExcludeBranch {root nv} {
	# Exclude the branch/lod starting at root, a revision.
	#
	# If the LOD starts with non-trunk default branch revisions,
	# we leave them in place and do not delete the branch. In that
	# case the command sets the variable in NV so that we can
	# later rework these revisons to be purely trunk.

	if {[$root isondefaultbranch]} {
	    # Handling a NTDB. This branch may consists not only of
	    # NTDB revisions, but also some non-NTDB. The latter are
	    # truly on a branch and have to be excluded. The following
	    # loop determines if there are such revisions.

	    upvar 1 $nv ntdbroot
	    set ntdbroot $root
	    $root cutfromparentbranch

	    set rev $root
	    while {$rev ne ""} {
		$rev removeallbranches
		# See note [x].

		if {[$rev isondefaultbranch]} {
		    set rev [$rev child]
		} else {
		    break
		}
	    }

	    # rev now contains the first non-NTDB revision after the
	    # NTDB, or is empty if there is no such. If we have some
	    # they have to removed.

	    if {$rev ne ""}  {
		set lastntdb [$rev parent]
		$lastntdb cutfromchild
		while {$rev ne ""} {
		    $rev removealltags
		    $rev removeallbranches
		    # Note [x]: We may still have had branches on the
		    # revision. Branches without revisions committed
		    # on them do not show up in the list of roots aka
		    # lines of development.
		    set rev [$rev child]
		}
	    }
	    return
	}

	# No NTDB stuff to deal with. First delete the branch object
	# itself, after cutting all the various connections.

	set branch [$root parentbranch]
	if {$branch ne ""} {
	    set branchparent [$branch parent]
	    $branchparent removebranch        $branch
	    $branchparent removechildonbranch $root
	}

	# The root is no such any longer either.
	ldelete myroots $root

	# Now go through the line and remove all its revisions.

	while {$root ne ""} {
	    $root removealltags
	    $root removeallbranches
	    # Note: See the note [x].

	    # From cvs2svn: If this is the last default revision on a
	    # non-trunk default branch followed by a 1.2 revision,
	    # then the 1.2 revision depends on this one.  FIXME: It is
	    # questionable whether this handling is correct, since the
	    # non-trunk default branch revisions affect trunk and
	    # should therefore not just be discarded even if
	    # --trunk-only.

	    if {[$root hasdefaultbranchchild]} {
		set ntdbchild [$root defaultbranchchild]
		integrity assert {
		    [$ntdbchild defaultbranchparent] eq $ntdbchild
		} {ntdb - trunk linkage broken}
		$ntdbchild cutdefaultbranchparent
		if {[$ntdbchild hasparent]} {
		    lappend myroots [$ntdbchild parent]
		}
	    }

	    set root [$root child]
	}

	return
    }

    method GraftNTDB2Trunk {root} {
	# We can now graft the non-trunk default branch revisions to
	# trunk. They should already be alone on a CVSBranch-less
	# branch.

	integrity assert {![$root hasparentbranch]} {NTDB root still has its branch symbol}
	integrity assert {![$root hasbranches]}     {NTDB root still has spawned branches}

	set last $root
	while {[$last haschild]} {set last [$last child]}

	if {[$last hasdefaultbranchchild]} {

	    set rev12 [$last defaultbranchchild]
	    $rev12 cutdefaultbranchparent
	    $last  cutdefaultbranchchild

	    $rev12 changeparent $last
	    $last  changechild $rev12

	    ldelete myroots $rev12

	    # Note and remember that the type of rev12 was already
	    # adjusted by AdjustNonTrunkDefaultBranch, so we don't
	    # have to change its type here.
	}

	while {$root ne ""} {
	    $root setondefaultbranch 0
	    $root setlod $mytrunk
	    foreach tag [$root tags] {
		$tag setlod $mytrunk
	    }
	    set root [$root child]
	}

        return
    }

    method Active {} {
	set revisions {}
	set symbols   {}

	foreach root [$self LinesOfDevelopment] {
	    if {[$root hasparentbranch]} { lappend symbols [$root parentbranch] }
	    while {$root ne ""} {
		lappend revisions $root
		foreach tag    [$root tags]     { lappend symbols $tag    }
		foreach branch [$root branches] {
		    integrity assert {
			[$branch parent] eq $root
		    } {Backreference branch to its root is missing or wrong}
		    lappend symbols $branch
		}
		set lod [$root lod]
		if {![$lod istrunk]} {
		    integrity assert {
			[$lod haschild]
		    } {Branch is LOD symbol without revisions}
		    lappend symbols $lod
		}
		set root [$root child]
	    }
	}

	return [list [lsort -unique -dict $revisions] [lsort -unique -dict $symbols]]
    }


    method AggregateSymbolData {} {
	# Now that the exact set of revisions (and through that
	# branches and tags) is known we can update the aggregate
	# symbol statistics.

	foreach root [$self LinesOfDevelopment] {
	    set lod [$root lod]

	    # Note: If the LOD is the trunk the count*, etc. methods
	    # will do nothing, as it is always present (cannot be
	    # excluded), and is always a branch too.

	    # Lines of development count as branches and have a commit
	    # on them (root). If they are still attached to a tree we
	    # have to compute and register possible parents.

	    $lod countasbranch
	    $lod countacommit

	    if {[$root hasparentbranch]} {
		# Note lod == [$root parentbranch]
		$lod possibleparents
	    } elseif {![$lod istrunk] && [$root isondefaultbranch]} {
		# This is the root revision of a detached NTDB. We
		# have to manually set the only possible parent for
		# this LOD, the trunk itself.

		[$lod symbol] possibleparent $mytrunk
	    }

	    # For the revisions in the line we register their branches
	    # and tags as blockers for the lod, and update the type
	    # counters as well. As branch symbols without commits on
	    # them are not listed as lines of development, we have to
	    # count them here as well, as plain branches. At last we
	    # have to compute and register the possible parents of the
	    # tags, in case they are later converted as branches.

	    while {$root ne ""} {
		foreach branch [$root branches] {
		    $lod blockedby $branch
		    $branch possibleparents
		    if {[$branch haschild]} continue
		    $branch countasbranch
		}

		foreach tag [$root tags] {
		    $lod blockedby $tag
		    $tag possibleparents
		    $tag countastag
		}

		set root [$root child]
	    }
	}

	return
    }

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

    pragma -hastypeinfo    no  ; # no type introspection
    pragma -hasinfo        no  ; # no object introspection
    pragma -hastypemethods no  ; # type is not relevant.

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

namespace eval ::vc::fossil::import::cvs {
    namespace export file
    namespace eval file {
	# Import not required, already a child namespace.
	# namespace import ::vc::fossil::import::cvs::file::rev
	# namespace import ::vc::fossil::import::cvs::file::sym
	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log
	namespace import ::vc::fossil::import::cvs::blobstore
	namespace import ::vc::fossil::import::cvs::state
	namespace import ::vc::fossil::import::cvs::integrity
	namespace import ::vc::fossil::import::cvs::gtcore
    }
}

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

package provide vc::fossil::import::cvs::file 1.0
return