package require Tcl 8.4                             ; # Required runtime.
package require snit                                ; # OO system.
package require struct::set                         ; # Set operations.
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::tools::trouble                  ; # Error reporting.
package require vc::tools::log                      ; # User feedback
package require vc::tools::misc                     ; # Text formatting

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

	set myexecutable $executable
	set myproject    $project
	set mytrunk      [$myproject trunk]
	return
    }

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

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

	    $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]
    }

	# 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

		$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 cutchild
		$first cutfromparentbranch
		lappend myroots $first
	    }

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

	# 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::state
	namespace import ::vc::fossil::import::cvs::integrity
    }
}

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

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

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

package require Tcl 8.4                             ; # Required runtime.
package require snit                                ; # OO system.
package require vc::tools::misc                     ; # Text formatting
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::file::rev {
    # # ## ### ##### ######## #############
    ## Public API

    # Basic parent/child linkage __________

    method hasparent {} { return [expr {$myparent ne ""}] }
    method haschild  {} { return [expr {$mychild  ne ""}] }

    method setparent {parent} {
	integrity assert {$myparent eq ""} {Parent already defined}
	set myparent $parent
	return
    }

    method cutfromparent {} { set myparent "" ; return }
    method cutfromchild  {} { set mychild  "" ; return }

    method setchild {child} {
	integrity assert {$mychild eq ""} {Child already defined}
	set mychild $child
	return
    }

    method changeparent {parent} { set myparent $parent ; return }
    method changechild  {child}  { set mychild  $child  ; return }

    method parent {} { return $myparent }
    method child  {} { return $mychild  }

    # Branch linkage ______________________

    method setparentbranch {branch} {
	integrity assert {$myparentbranch eq ""} {Branch parent already defined}
	set myparentbranch $branch
	return
    }

    method hasparentbranch {} { return [expr {$myparentbranch ne ""}] }
    method hasbranches     {} { return [llength $mybranches] }

}

namespace eval ::vc::fossil::import::cvs::file {
    namespace export rev
    namespace eval rev {
	namespace import ::vc::tools::misc::*
	namespace import ::vc::fossil::import::cvs::state
	namespace import ::vc::fossil::import::cvs::integrity
    }
}

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

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

## Requirements

package require Tcl 8.4                             ; # Required runtime.
package require snit                                ; # OO system.
package require vc::tools::trouble                  ; # Error reporting.
package require vc::fossil::import::cvs::file::rev  ; # CVS per file revisions.
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::file::sym {
    # # ## ### ##### ######## #############
    ## Public API

    constructor {symtype nr symbol file} {
	set myfile   $file
	set mytype   $symtype
	set mynr     $nr
	set mysymbol $symbol

	switch -exact -- $mytype {
	    branch  { SetupBranch ; return }
	    tag     { return }

	}
	integrity assert 0 {Bad symbol type '$mytype'}
	return
    }

    method defid {} {
	set myid [incr myidcounter]
	return
    }

    #

    method istrunk {} { return 0 }

    # Branch acessor methods.

    method setchildrevnr  {revnr} {
	integrity assert {$mybranchchildrevnr eq ""} {Child already defined}
	set mybranchchildrevnr $revnr
	return
    }

    method setposition {n}   { set mybranchposition $n ; return }
    method setparent   {rev} { set mybranchparent $rev ; return }
    method setchild    {rev} { set mybranchchild  $rev ; return }

}

namespace eval ::vc::fossil::import::cvs::file {
    namespace export sym
    namespace eval sym {
	namespace import ::vc::fossil::import::cvs::file::rev
	namespace import ::vc::fossil::import::cvs::state
	namespace import ::vc::fossil::import::cvs::integrity
	namespace import ::vc::tools::trouble
    }
}

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

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

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

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

    typemethod assert {expression failmessage} {
	set ok [uplevel 1 [list ::expr $expression]]
	if {$ok} return
	trouble internal [uplevel 1 [list ::subst $failmessage]]
	return
    }

    typemethod strict {} {
	log write 4 integrity {Check database consistency}

	set n 0
	AllButMeta
	Meta

    proc Check {header label sql} {
	upvar 1 n n
	set ok 1
	foreach {fname revnr} [state run $sql] {
	    set ok 0
	    trouble fatal "$fname <$revnr> $label"
	}
	log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok    " : "Failed"}] ... $header}
	return
    }

    proc CheckCS {header label sql} {
	upvar 1 n n
	set ok 1
	foreach {ctype cid} [state run $sql] {
	    set ok 0
	    trouble fatal "<$ctype $cid> $label"
	}
	log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok    " : "Failed"}] ... $header}
	return
    }

    proc CheckInCS {header label sql} {
	upvar 1 n n
	set ok 1
	foreach {cstype csid fname revnr} [state run $sql] {
	    set ok 0
	    set b "<$cstype $csid>"
	    trouble fatal "$fname <$revnr> [string map [list @ $b] $label]"
	}
	log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok    " : "Failed"}] ... $header}
	return
    }

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

    pragma -hasinstances   no ; # singleton

## Pass manager. All passes register here, with code, description, and
## callbacks (... setup, run, finalize). Option processing and help
## query this manager to dynamically create the relevant texts.

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

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

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

snit::type ::vc::fossil::import::cvs::pass {
    # # ## ### ##### ######## #############
    ## Public API, Methods (Setup, query)

    typemethod define {name description command} {
	integrity assert {
	    ![info exists mydesc($name)]
	} {Multiple definitions for pass code '$name'}

	lappend mypasses $name
	set mydesc($name) $description
	set mycmd($name)  $command
	return
    }

    typemethod help {} {

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

namespace eval ::vc::fossil::import::cvs {
    namespace export pass
    namespace eval pass {
	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 pass
    }
}

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

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

	    cyclebreaker replace $graph $cset $replacements

	    # At last check that the normal frament is indeed not
	    # backward, and iterate over the possibly still backward
	    # second fragment.

	    struct::list assign $replacements normal backward
	    integrity assert {
		![IsBackward $graph $normal]
	    } {The normal fragment is unexpectedly backward}


	    set cset $backward
	}
	return
    }

    proc IsBackward {dg cset} {

	# Check that the ordering at the file level is correct. We
	# cannot have backward ordering per revision, or something is
	# wrong.

	foreach revision [array names limits] {
	    struct::list assign $limits($revision) maxp mins
	    # Handle min successor position "" as representing infinity
	    integrity assert {
		($mins eq "") || ($maxp < $mins) 

	    } {Branch revision $revision is backward at file level ($maxp >= $mins)}
	}

	# Save the limits for the splitter, and compute the border at
	# which to split as the minimum of all minimal successor
	# positions.

	set thelimits [array get limits]

	    if {$maxp >= $border} {
		lappend backwardrevisions  $rev
	    } else {
		lappend normalrevisions $rev
	    }
	}

	integrity assert {[llength $normalrevisions]}   {Set of normal revisions is empty}
	integrity assert {[llength $backwardrevisions]} {Set of backward revisions is empty}
	return
    }


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

    proc KeepOrder {graph at cset} {

	    if {$mylastpos < 0} {
		set old "<NONE>"
	    } else {
		::variable mycset
		set old [$mycset($mylastpos) str]@$mylastpos
	    }

	    integrity assert 0 {Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old}
	}

	set mylastpos $new
	return
    }

    proc FormatTR {graph cset} {

	    set tagname $sn($id)
	    set oldname $sx($lod)
	    struct::list assign $fpn($fid) fname prname

	    # Do the grafting.

	    log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting tag '$tagname' on $fname/$revnr from '$oldname' onto '$preferedname'}
	    state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
	    incr n
	}

	log write 3 filtersym "Reparented [nsp $n tag]"

	log write 3 filtersym "Adjust branch parents"

	    set braname $sn($id)
	    set oldname $sx($lod)
	    struct::list assign $fpn($fid) fname prname

	    # Do the grafting.

	    log write 4 filtersym {\[[format $fmt $n]/$mxs\] $prname : Grafting branch '$braname' on $fname/$revnr from '$oldname' onto '$preferedname'}
	    state run { UPDATE tag SET lod = $pid WHERE tid = $id ; }
	    incr n
	}

	log write 3 filtersym "Reparented [nsp $n branch branches]"
	return
    }

package require Tcl 8.4                               ; # Required runtime.
package require snit                                  ; # OO system.
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.
package require vc::fossil::import::cvs::project::sym ; # Project level symbols

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

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

	set pending   [list $range]
	set at        0
	array set breaks {}

	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

		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 pending $fragbefore $fragafter
		CutAt $best
	    }

	    incr at
	}

	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 $myrevisions $s $e]]

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

	    set laste $e
	}

	integrity assert {
	    $laste == ([llength $myrevisions]-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
	# revisions because we cleared the previously existing
	# information, see (*) above. Persistence does not matter
	# here, none of the changesets has been saved to the
	# persistent state yet.

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

	$cset drop
	$cset destroy

	set newcsets {}
	foreach fragmentrevisions $args {
	    integrity assert {
		[llength $fragmentrevisions]
	    } {Attempted to create an empty changeset, i.e. without revisions}

	    lappend newcsets [$type %AUTO% $project $cstype $cssrc $fragmentrevisions]
	}

	foreach c $newcsets { $c persist }
	return $newcsets
    }

	    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 {$rid != $child} {Revision $rid depends on itself.}

	    lappend dependencies($rid) $child
	    set dep($rid,$child) .
	}

	# 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

	    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 {$rid != $child} {Revision $rid depends on itself.}

	    lappend dependencies($rid) $child
	}
	return
    }

    proc PullPredecessorRevisions {dv revisions} {
	upvar 1 $dv dependencies

	    WHERE R.rid IN $theset       -- Restrict to revisions of interest
	    AND NOT R.isdefault          -- not on NTDB
	    AND R.parent IS NOT NULL     -- which are not root
	    AND RA.rid = R.parent        -- go to their parent
	    AND RA.dbparent IS NOT NULL  -- which has to refer to NTDB's root
	"] {
	    # Consider moving this to the integrity module.

	    integrity assert {$rid != $parent} {Revision $rid depends on itself.}

	    lappend dependencies($rid) $parent
	}
	return
    }

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

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

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 eval project {
	    namespace import ::vc::fossil::import::cvs::project::sym
	}
	::variable mybranchcode [project::sym branch]
	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log

package require Tcl 8.4                               ; # Required runtime.
package require snit                                  ; # OO system.
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.
package require vc::fossil::import::cvs::project::rev ; # Project level changesets

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

snit::type ::vc::fossil::import::cvs::project::revlink {
    # # ## ### ##### ######## #############

	if {$smove < $omove} { return 1 } ; # self is better.

	return 0 ; # Self is worse or equal, i.e. not better.
    }

    method break {} {

	integrity assert {[$self breakable]} {Changeset [$mycset str] is not breakable.}


	# One thing to choose when splitting CSET is where the
	# revision in categories 1 and 2 (none and passthrough
	# respectively) are moved to. This is done using the counters.

	if {!$mycount(prev)} {
	    # Nothing in category 3 => 1,2 go there, 4 the other.

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

namespace eval ::vc::fossil::import::cvs::project {
    namespace export revlink
    namespace eval revlink {
	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 eval project {
	    namespace import ::vc::fossil::import::cvs::project::rev
	}
	namespace import ::vc::tools::log
	log register csets

	if {$mytagcount > $mybranchcount} { return $mytag }
	if {$mytagcount < $mybranchcount} { return $mybranch }
	return $myundef
    }

    method MarkAs {label chosen} {
	log write 3 symbol {\[$label\] Converting symbol '$myname' as $mysymtype($chosen)}

	set mytype $chosen
	incr myrulecount($label)

	# This is stored directly into the database.
	state run {
	    UPDATE symbol

	    SELECT name
	    FROM sqlite_master
	    WHERE type = 'table'
	    AND   name = $name
	    ;
	}]]

	# No assert, would cause cycle in package dependencies
	if {$found} return

	trouble internal "The required table \"$name\" is not defined."
	# Not reached
	return
    }

    typemethod discard {name} {
	# Method for a user to remove outdated information from the

    # Write the message 'text' to log, for the named 'system'. The
    # message is written if and only if the message verbosity is less
    # or equal the chosen verbosity. A message of verbosity 0 cannot
    # be blocked.

    typemethod write {verbosity system text} {
	if {$verbosity > $myloglevel} return
	uplevel #0 [linsert $mylogcmd end write [System $system] \
	    [uplevel 1 [list ::subst $text]]]
	return
    }

    # Similar to write, especially in the handling of the verbosity,
    # to drive progress displays. It signals that for some long
    # running operation we are at tick 'n' of at most 'max' ticks. An
    # empty 'max' indicates an infinite progress display.