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: 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. 52f2254007 2007-10-04 aku: package require vc::tools::misc ; # Text formatting 52f2254007 2007-10-04 aku: package require vc::fossil::import::cvs::project ; # CVS projects 042d54bae5 2007-10-05 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: # TODO: Loading from the state database if CollAr is skipped 52f2254007 2007-10-04 aku: # in a run. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: return [TheProjects] 47740cc1f6 2007-10-03 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: 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 { 52f2254007 2007-10-04 aku: set nfiles [llength [$p files]] 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: 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 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: 52f2254007 2007-10-04 aku: typevariable mybase {} 52f2254007 2007-10-04 aku: typevariable myprojpaths {} 52f2254007 2007-10-04 aku: typevariable myprojects {} 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} { 52f2254007 2007-10-04 aku: return [string length [llength [$p files]]] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: proc IsRepositoryBase {path mv} { 52f2254007 2007-10-04 aku: upvar 1 $mv msg mybase mybase 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 {} { 52f2254007 2007-10-04 aku: upvar 1 myprojects myprojects myprojpaths myprojpaths mybase mybase 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} { 52f2254007 2007-10-04 aku: upvar 1 mybase mybase 52f2254007 2007-10-04 aku: set res {} 52f2254007 2007-10-04 aku: if {[llength $projpaths]} { 52f2254007 2007-10-04 aku: foreach pp $projpaths { 52f2254007 2007-10-04 aku: lappend res [project %AUTO% $pp] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: } else { 52f2254007 2007-10-04 aku: # Base is the single project. 52f2254007 2007-10-04 aku: lappend res [project %AUTO% ""] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: return $res 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 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: namespace import ::vc::tools::misc::* 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: package provide vc::fossil::import::cvs::repository 1.0 47740cc1f6 2007-10-03 aku: return
File Annotation