summaryrefslogtreecommitdiff
path: root/tools/cvs2fossil/lib/c2f_repository.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/cvs2fossil/lib/c2f_repository.tcl')
-rw-r--r--tools/cvs2fossil/lib/c2f_repository.tcl502
1 files changed, 502 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/c2f_repository.tcl b/tools/cvs2fossil/lib/c2f_repository.tcl
new file mode 100644
index 0000000..ada5926
--- /dev/null
+++ b/tools/cvs2fossil/lib/c2f_repository.tcl
@@ -0,0 +1,502 @@
+## -*- 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