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

## Repository manager. Keeps projects and their files around.

package provide vc::fossil::import::cvs::repository 1.0

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

package require Tcl 8.4                          ; # Required runtime.
package require snit                             ; # OO system.
package require vc::tools::trouble               ; # Error reporting.
package require vc::tools::log                   ; # User feedback.
package require vc::tools::misc                  ; # Text formatting.
package require vc::tools::id                    ; # Indexing and id generation.
package require vc::fossil::import::cvs::project ; # CVS projects.
package require vc::fossil::import::cvs::state   ; # State storage.
package require struct::list                     ; # List operations.
package require fileutil                         ; # File operations.

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

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

    typemethod base {path} {
	# Could be checked, easier to defer to the overall validation.
	set mybase $path
	return
    }

    typemethod add {path} {
	# Most things cannot be checked immediately, as the base is
	# not known while projects are added. We can and do check for
	# uniqueness. We accept multiple occurences of a name, and
	# treat them as a single project.

	if {[lsearch -exact $myprojpaths $path] >= 0} return
	lappend myprojpaths $path
	return
    }

    typemethod trunkonly! {} { set mytrunkonly 1 ; return }
    typemethod trunkonly  {} { return $mytrunkonly }

    typemethod projects {} {
	return [TheProjects]
    }

    typemethod base? {} { return $mybase }

    typemethod validate {} {
	if {![IsRepositoryBase $mybase msg]} {
	    trouble fatal $msg
	    # Without a good base directory checking any projects is
	    # wasted time, so we leave now.
	    return
	}
	foreach pp $myprojpaths {
	    if {![IsProjectBase $mybase/$pp $mybase/CVSROOT msg]} {
		trouble fatal $msg
	    }
	}
	return
    }

    typemethod defauthor   {a}               { $myauthor put $a }
    typemethod defcmessage {cm}              { $mycmsg   put $cm }
    typemethod defsymbol   {pid name}        { $mysymbol put [list $pid $name] }
    typemethod defmeta     {pid bid aid cid} { $mymeta   put [list $pid $bid $aid $cid] }

    typemethod commitmessageof {mid} {
	struct::list assign [$mymeta keyof $mid] pid bid aid cid
	return [$mycmsg keyof $cid]
    }

    typemethod getmeta {mid} {
	struct::list assign [$mymeta keyof $mid] pid bid aid cid
	return [list \
		    $myprojmap($pid) \
		    [$mysymbol keyof $bid] \
		    [$myauthor keyof $aid] \
		    [$mycmsg   keyof $cid]]
    }

    # pass I results
    typemethod printstatistics {} {
	set prlist [TheProjects]
	set npr [llength $prlist]

	log write 2 repository "Statistics: Scanned [nsp $npr project]"

	if {$npr > 1} {
	    set  bmax [max [struct::list map $prlist [myproc .BaseLength]]]
	    incr bmax 2
	    set  bfmt %-${bmax}s

	    set  nmax [max [struct::list map $prlist [myproc .NFileLength]]]
	    set  nfmt %${nmax}s
	} else {
	    set bfmt %s
	    set nfmt %s
	}

	set keep {}
	foreach p $prlist {
	    set nfiles [llength [$p filenames]]
	    set line "Statistics: Project [format $bfmt \"[$p printbase]\"] : [format $nfmt $nfiles] [sp $nfiles file]"
	    if {$nfiles < 1} {
		append line ", dropped"
	    } else {
		lappend keep $p
	    }
	    log write 2 repository $line
	}

	if {![llength $keep]} {
	    trouble warn "Dropped all projects"
	} elseif {$npr == [llength $keep]} {
	    log write 2 repository "Keeping all projects"
	} else {
	    log write 2 repository "Keeping [nsp [llength $keep] project]"
	    trouble warn "Dropped [nsp [expr {$npr - [llength $keep]}] {empty project}]"
	}

	# Keep reduced set of projects.
	set projects $keep
	return
    }

    # pass I persistence
    typemethod persist {} {
	::variable myprojmap
	state transaction {
	    foreach p [TheProjects] {
		$p persist
		set myprojmap([$p id]) $p
	    }
	}
	return
    }

    typemethod load {} {
	state transaction {
	    state foreachrow {
		SELECT pid, name FROM project ;
	    } {
		set project [project %AUTO% $name $type]

		lappend myprojpaths $name
		lappend myprojects  $project
		set myprojmap($pid) $project
		$project setid $pid
	    }
	    state foreachrow {
		SELECT fid, pid, name, visible, exec FROM file ;
	    } {
		$myprojmap($pid) addfile $name $visible $exec $fid
	    }
	}
	return
    }

    # pass II results
    typemethod printrevstatistics {} {
	log write 2 repository "Revision statistics"
	# number of revisions, symbols, repository wide, and per project ...

	set rcount [state one { SELECT COUNT (*) FROM revision }]
	set tcount [state one { SELECT COUNT (*) FROM tag      }]
	set bcount [state one { SELECT COUNT (*) FROM branch   }]
	set scount [state one { SELECT COUNT (*) FROM symbol   }]
	set acount [state one { SELECT COUNT (*) FROM author   }]
	set ccount [state one { SELECT COUNT (*) FROM cmessage }]
	set fmt %[string length [max [list $rcount $tcount $bcount $scount $acount $ccount]]]s

	log write 2 repository "Statistics: [format $fmt $rcount] [sp $rcount revision]"
	log write 2 repository "Statistics: [format $fmt $tcount] [sp $tcount tag]"
	log write 2 repository "Statistics: [format $fmt $bcount] [sp $bcount branch branches]"
	log write 2 repository "Statistics: [format $fmt $scount] [sp $scount symbol]"
	log write 2 repository "Statistics: [format $fmt $acount] [sp $acount author]"
	log write 2 repository "Statistics: [format $fmt $ccount] [sp $ccount {log message}]"

	set prlist [TheProjects]
	set npr [llength $prlist]

	if {$npr > 1} {
	    set  bmax [max [struct::list map $prlist [myproc .BaseLength]]]
	    incr bmax 2
	    set  bfmt %-${bmax}s
	} else {
	    set bfmt %s
	}

	foreach p $prlist {
	    set pid [$p id]
	    set prefix "Project [format $bfmt \"[$p printbase]\"]"
	    regsub -all {[^	]} $prefix { } blanks
	    set sep " : "

	    set rcount [state one { SELECT COUNT (*) FROM revision R, file F WHERE R.fid = F.fid AND F.pid = $pid }]
	    set tcount [state one { SELECT COUNT (*) FROM tag T,      file F WHERE T.fid = F.fid AND F.pid = $pid }]
	    set bcount [state one { SELECT COUNT (*) FROM branch B,   file F WHERE B.fid = F.fid AND F.pid = $pid }]
	    set scount [state one { SELECT COUNT (*) FROM symbol             WHERE pid = $pid                     }]
	    set acount [state one { SELECT COUNT (*) FROM author   WHERE aid IN (SELECT DISTINCT aid FROM meta WHERE pid = $pid) }]
	    set ccount [state one { SELECT COUNT (*) FROM cmessage WHERE cid IN (SELECT DISTINCT cid FROM meta WHERE pid = $pid) }]

	    log write 2 repository "Statistics: $prefix$sep[format $fmt $rcount] [sp $rcount revision]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $tcount] [sp $tcount tag]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $bcount] [sp $bcount branch branches]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $scount] [sp $scount symbol]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $acount] [sp $acount author]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $ccount] [sp $ccount {log message}]"
	}
	return
    }

    # pass II persistence
    typemethod persistrev {} {
	state transaction {
	    SaveAuthors
	    SaveCommitMessages
	    # TODO: Save symbols of all projects (before the revisions
	    # in the projects, as they are referenced by the meta
	    # tuples)
	    SaveMeta
	    foreach p [TheProjects] { $p persistrev }
	}
	return
    }

    typemethod loadsymbols {} {
	state transaction {
	    # We load the symbol ids at large to have the mapping
	    # right from the beginning.

	    state foreachrow {
		SELECT sid, pid, name, tag_count AS tc, branch_count AS bc, commit_count AS cc
		FROM symbol
	    } {
		$mysymbol map $sid [list $pid $name]
		set project $myprojmap($pid)

		set force  [$project hassymbol $name]
		set symbol [$project getsymbol $name]

		# Forcing happens only for the trunks.
		if {$force} { $symbol forceid $sid }

		# Set the loaded counts.
		$symbol defcounts $tc $bc $cc

		# Note: The type is neither retrieved nor set, for
		# this is used to load the pass II data, which means
		# that everything is 'undefined' at this point anyway.

		# future: $symbol load (blockers, and parents)
	    }

	    # Beyond the symbols we also load the author, commit log,
	    # and meta information.

	    state foreachrow {
		SELECT aid, name AS aname FROM author
	    } {
		$myauthor map $aid $aname
	    }
	    state foreachrow {
		SELECT cid, text FROM cmessage
	    } {
		$mycmsg map $cid $text
	    }
	    state foreachrow {
		SELECT mid, pid, bid, aid, cid FROM meta
	    } {
		$mymeta map $mid [list $pid $bid $aid $cid]
	    }
	}
	return
    }

    typemethod determinesymboltypes {} {
	foreach project [TheProjects] {
	    $project determinesymboltypes
	}
	return
    }

    typemethod projectof {pid} {
	return $myprojmap($pid)
    }


    # pass IV+ results
    typemethod printcsetstatistics {} {
	log write 2 repository "Changeset statistics"
	# number of revisions, symbols, repository wide, and per project ...

	set ccount [state one { SELECT COUNT (*) FROM changeset                }]
	set rcount [state one { SELECT COUNT (*) FROM changeset WHERE type = 0 }]
	set tcount [state one { SELECT COUNT (*) FROM changeset WHERE type = 1 }]
	set bcount [state one { SELECT COUNT (*) FROM changeset WHERE type = 2 }]
	set fmt %[string length [max [list $ccount $rcount $tcount $bcount]]]s

	log write 2 repository "Statistics: [format $fmt $ccount] [sp $ccount changeset]"
	log write 2 repository "Statistics: [format $fmt $rcount] [sp $rcount {revision changeset}]"
	log write 2 repository "Statistics: [format $fmt $tcount] [sp $tcount {tag symbol changeset}]"
	log write 2 repository "Statistics: [format $fmt $bcount] [sp $bcount {branch symbol changeset}]"

	set prlist [TheProjects]
	set npr [llength $prlist]

	if {$npr > 1} {
	    set  bmax [max [struct::list map $prlist [myproc .BaseLength]]]
	    incr bmax 2
	    set  bfmt %-${bmax}s
	} else {
	    set bfmt %s
	}

	foreach p $prlist {
	    set pid [$p id]
	    set prefix "Project [format $bfmt \"[$p printbase]\"]"
	    regsub -all {[^	]} $prefix { } blanks
	    set sep " : "

	    set ccount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid              }]
	    set rcount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid AND type = 0 }]
	    set tcount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid AND type = 1 }]
	    set bcount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid AND type = 2 }]

	    log write 2 repository "Statistics: $prefix$sep[format $fmt $ccount] [sp $ccount changeset]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $rcount] [sp $rcount {revision changeset}]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $tcount] [sp $tcount {tag symbol changeset}]"
	    log write 2 repository "Statistics: $blanks$sep[format $fmt $bcount] [sp $bcount {branch symbol changeset}]"
	}
	return
    }

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

    typevariable mybase           {} ; # Base path to CVS repository.
    typevariable myprojpaths      {} ; # List of paths to all declared
				       # projects, relative to mybase.
    typevariable myprojects       {} ; # List of objects for all
				       # declared projects.
    typevariable myprojmap -array {} ; # Map from project ids to their
				       # objects.
    typevariable myauthor         {} ; # Names of all authors found,
				       # maps to their ids.
    typevariable mycmsg           {} ; # All commit messages found,
				       # maps to their ids.
    typevariable mymeta           {} ; # Maps all meta data tuples
				       # (project, branch, author,
				       # cmessage) to their ids.
    typevariable mysymbol         {} ; # Map symbols identified by
				       # project and name to their
				       # id. This information is not
				       # saved directly.
    typevariable mytrunkonly      0  ; # Boolean flag. Set by option
				       # processing when the user
				       # requested a trunk-only import

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

    typeconstructor {
	set myauthor [vc::tools::id %AUTO%]
	set mycmsg   [vc::tools::id %AUTO%]
	set mymeta   [vc::tools::id %AUTO%]
	set mysymbol [vc::tools::id %AUTO%]
	return
    }

    proc .BaseLength {p} {
	return [string length [$p printbase]]
    }

    proc .NFileLength {p} {
	return [string length [llength [$p filenames]]]
    }

    proc IsRepositoryBase {path mv} {
	::variable mybase
	upvar 1 $mv msg
	if {![fileutil::test $mybase         edr msg {CVS Repository}]}      {return 0}
	if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0}
	return 1
    }

    proc IsProjectBase {path admin mv} {
	upvar 1 $mv msg
	if {![fileutil::test $path edr msg Project]} {return 0}
	if {
	    ($path eq $admin) ||
	    [string match $admin/* $path]
	} {
	    set msg "Administrative subdirectory $path cannot be a project"
	    return 0
	}
	return 1
    }

    proc TheProjects {} {
	upvar 1 type type
	::variable myprojects
	::variable myprojpaths

	if {![llength $myprojects]} {
	    set myprojects [EmptyProjects $myprojpaths]
	}
	return $myprojects
    }

    proc EmptyProjects {projpaths} {
	::variable mybase
	upvar 1 type type
	set res {}
	if {[llength $projpaths]} {
	    foreach pp $projpaths {
		lappend res [project %AUTO% $pp $type]
	    }
	} else {
	    # Base is the single project.
	    lappend res [project %AUTO% "" $type]
	}
	return $res
    }

    proc SaveAuthors {} {
	::variable myauthor
	foreach {name aid} [$myauthor get] {
	    state run {
		INSERT INTO author ( aid,  name)
		VALUES             ($aid, $name);
	    }
	}
	return
    }

    proc SaveCommitMessages {} {
	::variable mycmsg
	foreach {text cid} [$mycmsg get] {
	    state run {
		INSERT INTO cmessage ( cid,  text)
		VALUES               ($cid, $text);
	    }
	}
	return
    }

    proc SaveMeta {} {
	::variable mymeta
	foreach {key mid} [$mymeta get] {
	    struct::list assign $key pid bid aid cid
	    state run {
		INSERT INTO meta ( mid,  pid,  bid,  aid,  cid)
		VALUES           ($mid, $pid, $bid, $aid, $cid);
	    }
	}
	return
    }

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

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

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

namespace eval ::vc::fossil::import::cvs {
    namespace export repository
    namespace eval repository {
	namespace import ::vc::fossil::import::cvs::project
	namespace import ::vc::fossil::import::cvs::state
	namespace import ::vc::tools::misc::*
	namespace import ::vc::tools::id
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log
	log register repository
    }
}

# # ## ### ##### ######## ############# #####################
## Ready
return