47740cc1f6 2007-10-03 aku: ## -*- tcl -*- 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# ##################### 47740cc1f6 2007-10-03 aku: ## Copyright (c) 2007 Andreas Kupries. 47740cc1f6 2007-10-03 aku: # 47740cc1f6 2007-10-03 aku: # This software is licensed as described in the file LICENSE, which 47740cc1f6 2007-10-03 aku: # you should have received as part of this distribution. 47740cc1f6 2007-10-03 aku: # 47740cc1f6 2007-10-03 aku: # This software consists of voluntary contributions made by many 47740cc1f6 2007-10-03 aku: # individuals. For exact contribution history, see the revision 47740cc1f6 2007-10-03 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# ##################### 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: ## Repository manager. Keeps projects and their files around. 47740cc1f6 2007-10-03 aku: 3d88cfd05d 2007-10-06 aku: package provide vc::fossil::import::cvs::repository 1.0 3d88cfd05d 2007-10-06 aku: 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# ##################### 47740cc1f6 2007-10-03 aku: ## Requirements 47740cc1f6 2007-10-03 aku: 52f2254007 2007-10-04 aku: package require Tcl 8.4 ; # Required runtime. 52f2254007 2007-10-04 aku: package require snit ; # OO system. 52f2254007 2007-10-04 aku: package require vc::tools::trouble ; # Error reporting. 52f2254007 2007-10-04 aku: package require vc::tools::log ; # User feedback. 8487172254 2007-10-06 aku: package require vc::tools::misc ; # Text formatting. 8487172254 2007-10-06 aku: package require vc::fossil::import::cvs::project ; # CVS projects. 8487172254 2007-10-06 aku: package require vc::fossil::import::cvs::state ; # State storage. 52f2254007 2007-10-04 aku: package require struct::list ; # List operations. eb656de7d9 2007-10-05 aku: package require fileutil ; # File operations. 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# ##################### 47740cc1f6 2007-10-03 aku: ## 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: snit::type ::vc::fossil::import::cvs::repository { 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# 47740cc1f6 2007-10-03 aku: ## Public API 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: typemethod base {path} { 52f2254007 2007-10-04 aku: # Could be checked, easier to defer to the overall validation. 52f2254007 2007-10-04 aku: set mybase $path 52f2254007 2007-10-04 aku: return 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: typemethod add {path} { d174affb48 2007-10-05 aku: # Most things cannot be checked immediately, as the base is d174affb48 2007-10-05 aku: # not known while projects are added. We can and do check for d174affb48 2007-10-05 aku: # uniqueness. We accept multiple occurences of a name, and d174affb48 2007-10-05 aku: # treat them as a single project. d174affb48 2007-10-05 aku: d174affb48 2007-10-05 aku: if {[lsearch -exact $myprojpaths $path] >= 0} return 52f2254007 2007-10-04 aku: lappend myprojpaths $path 52f2254007 2007-10-04 aku: return 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: typemethod projects {} { 52f2254007 2007-10-04 aku: return [TheProjects] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: typemethod base? {} { return $mybase } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: typemethod validate {} { 52f2254007 2007-10-04 aku: if {![IsRepositoryBase $mybase msg]} { 52f2254007 2007-10-04 aku: trouble fatal $msg 52f2254007 2007-10-04 aku: # Without a good base directory checking any projects is 52f2254007 2007-10-04 aku: # wasted time, so we leave now. 52f2254007 2007-10-04 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: foreach pp $myprojpaths { 52f2254007 2007-10-04 aku: if {![IsProjectBase $mybase/$pp $mybase/CVSROOT msg]} { 52f2254007 2007-10-04 aku: trouble fatal $msg 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 67c24820c7 2007-10-14 aku: typemethod defauthor {a} { 67c24820c7 2007-10-14 aku: if {![info exists myauthor($a)]} { 67c24820c7 2007-10-14 aku: set myauthor($a) [incr myauthorcnt] 67c24820c7 2007-10-14 aku: log write 6 repository "author '$a' = $myauthor($a)" 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: return $myauthor($a) 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: 67c24820c7 2007-10-14 aku: typemethod defcmessage {cm} { 67c24820c7 2007-10-14 aku: if {![info exists mycmsg($cm)]} { 67c24820c7 2007-10-14 aku: set mycmsg($cm) [incr mycmsgcnt] 67c24820c7 2007-10-14 aku: log write 6 repository "cmessage '$cm' = $mycmsg($cm)" 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: return $mycmsg($cm) 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: 67c24820c7 2007-10-14 aku: typemethod defsymbol {pid name} { 67c24820c7 2007-10-14 aku: set key [list $pid $name] 67c24820c7 2007-10-14 aku: if {![info exists mysymbol($key)]} { 67c24820c7 2007-10-14 aku: set mysymbol($key) [incr mysymbolcnt] 67c24820c7 2007-10-14 aku: log write 6 repository "symbol ($key) = $mysymbol($key)" 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: return $mysymbol($key) 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: 67c24820c7 2007-10-14 aku: typemethod defmeta {pid bid aid cid} { 67c24820c7 2007-10-14 aku: set key [list $pid $bid $aid $cid] 67c24820c7 2007-10-14 aku: if {![info exists mymeta($key)]} { 67c24820c7 2007-10-14 aku: set mymeta($key) [incr mymetacnt] 67c24820c7 2007-10-14 aku: log write 6 repository "meta ($key) = $mymeta($key)" 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: return $mymeta($key) 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: 6d1811d61e 2007-10-06 aku: # pass I results 52f2254007 2007-10-04 aku: typemethod printstatistics {} { 52f2254007 2007-10-04 aku: set prlist [TheProjects] 52f2254007 2007-10-04 aku: set npr [llength $prlist] 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: log write 2 repository "Scanned [nsp $npr project]" 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: if {$npr > 1} { 52f2254007 2007-10-04 aku: set bmax [max [struct::list map $prlist [myproc .BaseLength]]] 52f2254007 2007-10-04 aku: incr bmax 2 52f2254007 2007-10-04 aku: set bfmt %-${bmax}s 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: set nmax [max [struct::list map $prlist [myproc .NFileLength]]] 52f2254007 2007-10-04 aku: set nfmt %${nmax}s 52f2254007 2007-10-04 aku: } else { 52f2254007 2007-10-04 aku: set bfmt %s 52f2254007 2007-10-04 aku: set nfmt %s 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: set keep {} 52f2254007 2007-10-04 aku: foreach p $prlist { 8a93ffa9c1 2007-10-06 aku: set nfiles [llength [$p filenames]] 52f2254007 2007-10-04 aku: set line "Project [format $bfmt \"[$p printbase]\"] : [format $nfmt $nfiles] [sp $nfiles file]" 52f2254007 2007-10-04 aku: if {$nfiles < 1} { 52f2254007 2007-10-04 aku: append line ", dropped" 52f2254007 2007-10-04 aku: } else { 52f2254007 2007-10-04 aku: lappend keep $p 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: log write 2 repository $line 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: if {![llength $keep]} { 52f2254007 2007-10-04 aku: trouble warn "Dropped all projects" 52f2254007 2007-10-04 aku: } elseif {$npr == [llength $keep]} { 52f2254007 2007-10-04 aku: log write 2 repository "Keeping all projects" 52f2254007 2007-10-04 aku: } else { 52f2254007 2007-10-04 aku: log write 2 repository "Keeping [nsp [llength $keep] project]" 52f2254007 2007-10-04 aku: trouble warn "Dropped [nsp [expr {$npr - [llength $keep]}] {empty project}]" 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # Keep reduced set of projects. 52f2254007 2007-10-04 aku: set projects $keep 52f2254007 2007-10-04 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 6d1811d61e 2007-10-06 aku: # pass I persistence 52f2254007 2007-10-04 aku: typemethod persist {} { 042d54bae5 2007-10-05 aku: state transaction { 042d54bae5 2007-10-05 aku: foreach p [TheProjects] { $p persist } 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: return 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: 54ac684df7 2007-10-13 aku: typemethod load {} { 54ac684df7 2007-10-13 aku: array set pr {} 54ac684df7 2007-10-13 aku: state transaction { 54ac684df7 2007-10-13 aku: foreach {pid name} [state run { 54ac684df7 2007-10-13 aku: SELECT pid, name FROM project ; 54ac684df7 2007-10-13 aku: }] { 54ac684df7 2007-10-13 aku: lappend myprojpaths $name 54ac684df7 2007-10-13 aku: lappend myprojects [set pr($pid) [project %AUTO% $name $type]] 67c24820c7 2007-10-14 aku: $pr($pid) setid $pid 54ac684df7 2007-10-13 aku: } 54ac684df7 2007-10-13 aku: foreach {fid pid name visible exec} [state run { 54ac684df7 2007-10-13 aku: SELECT fid, pid, name, visible, exec FROM file ; 54ac684df7 2007-10-13 aku: }] { 54ac684df7 2007-10-13 aku: $pr($pid) addfile $name $visible $exec 54ac684df7 2007-10-13 aku: } 54ac684df7 2007-10-13 aku: } 54ac684df7 2007-10-13 aku: return 54ac684df7 2007-10-13 aku: } 54ac684df7 2007-10-13 aku: 6d1811d61e 2007-10-06 aku: # pass II results 6d1811d61e 2007-10-06 aku: typemethod printrevstatistics {} { 6d1811d61e 2007-10-06 aku: log write 2 repository "Scanned ..." 6d1811d61e 2007-10-06 aku: # number of revisions, symbols, repository wide, per project ... 6d1811d61e 2007-10-06 aku: return 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: 6d1811d61e 2007-10-06 aku: # pass II persistence 6d1811d61e 2007-10-06 aku: typemethod persistrev {} { 6d1811d61e 2007-10-06 aku: state transaction { 3d88cfd05d 2007-10-06 aku: SaveAuthors 3d88cfd05d 2007-10-06 aku: SaveCommitMessages 67c24820c7 2007-10-14 aku: # TODO: Save symbols of all projects (before the revisions 67c24820c7 2007-10-14 aku: # in the projects, as they are referenced by the meta 67c24820c7 2007-10-14 aku: # tuples) 67c24820c7 2007-10-14 aku: SaveMeta 6d1811d61e 2007-10-06 aku: foreach p [TheProjects] { $p persistrev } 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# 52f2254007 2007-10-04 aku: ## State 52f2254007 2007-10-04 aku: 3d88cfd05d 2007-10-06 aku: typevariable mybase {} ; # Base path to CVS repository. 67c24820c7 2007-10-14 aku: typevariable myprojpaths {} ; # List of paths to all declared 67c24820c7 2007-10-14 aku: # projects, relative to mybase. 67c24820c7 2007-10-14 aku: typevariable myprojects {} ; # List of objects for all 67c24820c7 2007-10-14 aku: # declared projects. 67c24820c7 2007-10-14 aku: typevariable myauthor -array {} ; # Names of all authors found, 67c24820c7 2007-10-14 aku: # maps to their ids. 67c24820c7 2007-10-14 aku: typevariable myauthorcnt 0 ; # Counter for author ids. 67c24820c7 2007-10-14 aku: typevariable mycmsg -array {} ; # All commit messages found, 67c24820c7 2007-10-14 aku: # maps to their ids. 67c24820c7 2007-10-14 aku: typevariable mycmsgcnt 0 ; # Counter for message ids. 67c24820c7 2007-10-14 aku: typevariable mymeta -array {} ; # Maps all meta data tuples 67c24820c7 2007-10-14 aku: # (project, branch, author, 67c24820c7 2007-10-14 aku: # cmessage) to their ids. 67c24820c7 2007-10-14 aku: typevariable mymetacnt 0 ; # Counter for meta ids. 67c24820c7 2007-10-14 aku: typevariable mysymbol -array {} ; # Map symbols identified by 67c24820c7 2007-10-14 aku: # project and name to their 67c24820c7 2007-10-14 aku: # id. This information is not 67c24820c7 2007-10-14 aku: # saved directly. 67c24820c7 2007-10-14 aku: typevariable mysymbolcnt 0 ; # Counter for symbol ids. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# 52f2254007 2007-10-04 aku: ## Internal methods 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc .BaseLength {p} { 52f2254007 2007-10-04 aku: return [string length [$p printbase]] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc .NFileLength {p} { 8a93ffa9c1 2007-10-06 aku: return [string length [llength [$p filenames]]] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc IsRepositoryBase {path mv} { 70b0aa899a 2007-10-06 aku: ::variable mybase 70b0aa899a 2007-10-06 aku: upvar 1 $mv msg 52f2254007 2007-10-04 aku: if {![fileutil::test $mybase edr msg {CVS Repository}]} {return 0} 52f2254007 2007-10-04 aku: if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0} 52f2254007 2007-10-04 aku: return 1 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc IsProjectBase {path admin mv} { 52f2254007 2007-10-04 aku: upvar 1 $mv msg 52f2254007 2007-10-04 aku: if {![fileutil::test $path edr msg Project]} {return 0} 52f2254007 2007-10-04 aku: if { 52f2254007 2007-10-04 aku: ($path eq $admin) || 52f2254007 2007-10-04 aku: [string match $admin/* $path] 52f2254007 2007-10-04 aku: } { 52f2254007 2007-10-04 aku: set msg "Administrative subdirectory $path cannot be a project" 52f2254007 2007-10-04 aku: return 0 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: return 1 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc TheProjects {} { 70b0aa899a 2007-10-06 aku: upvar 1 type type 70b0aa899a 2007-10-06 aku: ::variable myprojects 70b0aa899a 2007-10-06 aku: ::variable myprojpaths 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: if {![llength $myprojects]} { 52f2254007 2007-10-04 aku: set myprojects [EmptyProjects $myprojpaths] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: return $myprojects 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc EmptyProjects {projpaths} { 70b0aa899a 2007-10-06 aku: ::variable mybase 70b0aa899a 2007-10-06 aku: upvar 1 type type 52f2254007 2007-10-04 aku: set res {} 52f2254007 2007-10-04 aku: if {[llength $projpaths]} { 52f2254007 2007-10-04 aku: foreach pp $projpaths { 8487172254 2007-10-06 aku: lappend res [project %AUTO% $pp $type] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: } else { 52f2254007 2007-10-04 aku: # Base is the single project. 8487172254 2007-10-06 aku: lappend res [project %AUTO% "" $type] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: return $res 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: 3d88cfd05d 2007-10-06 aku: proc SaveAuthors {} { 3d88cfd05d 2007-10-06 aku: ::variable myauthor 67c24820c7 2007-10-14 aku: foreach {name aid} [array get myauthor] { 3d88cfd05d 2007-10-06 aku: state run { 67c24820c7 2007-10-14 aku: INSERT INTO author ( aid, name) 67c24820c7 2007-10-14 aku: VALUES ($aid, $name); 67c24820c7 2007-10-14 aku: } 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: 3d88cfd05d 2007-10-06 aku: proc SaveCommitMessages {} { 3d88cfd05d 2007-10-06 aku: ::variable mycmsg 67c24820c7 2007-10-14 aku: foreach {text cid} [array get mycmsg] { 3d88cfd05d 2007-10-06 aku: state run { 67c24820c7 2007-10-14 aku: INSERT INTO cmessage ( cid, text) 67c24820c7 2007-10-14 aku: VALUES ($cid, $text); 3d88cfd05d 2007-10-06 aku: } 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: return 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: 67c24820c7 2007-10-14 aku: proc SaveMeta {} { 67c24820c7 2007-10-14 aku: ::variable mymeta 67c24820c7 2007-10-14 aku: foreach {key mid} [array get mymeta] { 67c24820c7 2007-10-14 aku: struct::list assign $key pid bid aid cid 67c24820c7 2007-10-14 aku: if {$bid eq ""} { 67c24820c7 2007-10-14 aku: # Trunk. Encoded as NULL. 67c24820c7 2007-10-14 aku: state run { 67c24820c7 2007-10-14 aku: INSERT INTO meta ( mid, pid, bid, aid, cid) 67c24820c7 2007-10-14 aku: VALUES ($mid, $pid, NULL, $aid, $cid); 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: } else { 67c24820c7 2007-10-14 aku: state run { 67c24820c7 2007-10-14 aku: INSERT INTO meta ( mid, pid, bid, aid, cid) 67c24820c7 2007-10-14 aku: VALUES ($mid, $pid, $bid, $aid, $cid); 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 aku: } 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: return 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# 47740cc1f6 2007-10-03 aku: ## Configuration 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: pragma -hasinstances no ; # singleton 47740cc1f6 2007-10-03 aku: pragma -hastypeinfo no ; # no introspection 47740cc1f6 2007-10-03 aku: pragma -hastypedestroy no ; # immortal 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: namespace eval ::vc::fossil::import::cvs { 47740cc1f6 2007-10-03 aku: namespace export repository 47740cc1f6 2007-10-03 aku: namespace eval repository { 52f2254007 2007-10-04 aku: namespace import ::vc::fossil::import::cvs::project 042d54bae5 2007-10-05 aku: namespace import ::vc::fossil::import::cvs::state 43d72c6246 2007-10-06 aku: namespace import ::vc::tools::misc::* 52f2254007 2007-10-04 aku: namespace import ::vc::tools::trouble 52f2254007 2007-10-04 aku: namespace import ::vc::tools::log 52f2254007 2007-10-04 aku: log register repository 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: # # ## ### ##### ######## ############# ##################### 47740cc1f6 2007-10-03 aku: ## Ready 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: return
File Annotation