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: 3d88cfd05d 2007-10-06 aku: typemethod author {a} { 3d88cfd05d 2007-10-06 aku: set myauthor($a) "" 3d88cfd05d 2007-10-06 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: 3d88cfd05d 2007-10-06 aku: typemethod cmessage {cm} { 3d88cfd05d 2007-10-06 aku: set mycmsg($cm) "" 6d1811d61e 2007-10-06 aku: return 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]] 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 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. 3d88cfd05d 2007-10-06 aku: typevariable myprojpaths {} ; # Paths to all declared projects, relative to mybase. 3d88cfd05d 2007-10-06 aku: typevariable myprojects {} ; # Objects for all declared projects. 3d88cfd05d 2007-10-06 aku: typevariable myauthor -array {} ; # Names of all authors found, later with id. 3d88cfd05d 2007-10-06 aku: typevariable mycmsg -array {} ; # All commit messages found, later with id. 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 3d88cfd05d 2007-10-06 aku: foreach a [lsort -dict [array names myauthor]] { 3d88cfd05d 2007-10-06 aku: state run { 3d88cfd05d 2007-10-06 aku: INSERT INTO author (aid, name) 3d88cfd05d 2007-10-06 aku: VALUES (NULL, $a); 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: # Save id for use by the project/file persistence code. 3d88cfd05d 2007-10-06 aku: set myauthor($a) [state id] 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 3d88cfd05d 2007-10-06 aku: foreach t [lsort -dict [array names mycmsg]] { 3d88cfd05d 2007-10-06 aku: state run { 3d88cfd05d 2007-10-06 aku: INSERT INTO cmessage (cid, text) 3d88cfd05d 2007-10-06 aku: VALUES (NULL, $t); 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: # Save id for use by the project/file persistence code. 3d88cfd05d 2007-10-06 aku: set mycmsg($t) [state id] 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