Overview
| SHA1 Hash: | 52f2254007f2215da3639887185db73df661d60a |
|---|---|
| Date: | 2007-10-04 04:34:59 |
| User: | aku |
| Comment: | Continued work on pass I. Filled in the repository management, and basic implementation of project objects. Missing are persistence and the foundation for that (cache database). |
| Timelines: | ancestors | descendants | both | trunk |
| Other Links: | files | ZIP archive | manifest |
Tags And Properties
- branch=trunk inherited from [a28c83647d]
- sym-trunk inherited from [a28c83647d]
Changes
[hide diffs]Modified tools/cvs2fossil/lib/c2f_pcollar.tcl from [5c566fc378] to [bae64eb186].
@@ -45,12 +45,13 @@
typemethod setup {} {
# TODO ... artifact/cache - drop projects/files, create projects/files
}
typemethod run {} {
+ set rbase [repository base?]
foreach project [repository projects] {
- set base [$project base]
+ set base [file join $rbase [$project base]]
log write 1 collar "Scan $base"
set traverse [fileutil::traverse %AUTO% $base]
set n 0
set r {}
@@ -61,31 +62,38 @@
if {![IsRCSArchive $path]} continue
set usr [UserPath $rcs isattic]
if {[IsSuperceded $base $rcs $usr $isattic]} continue
- log write 1 collar "Found $rcs"
+ log write 4 collar "Found $rcs"
$project add $rcs $usr
incr n
- log progress 0 collar $n {}
+ if {[log verbosity?] < 4} {
+ log progress 0 collar $n {}
+ }
}
$traverse destroy
}
+
+ repository printstatistics
+ repository persist
+
+ log write 1 collar "Scan completed"
return
}
typemethod ignore_conflicting_attics {} {
- set ignore 1
+ set myignore 1
return
}
# # ## ### ##### ######## #############
## Internal methods
- typevariable ignore 0
+ typevariable myignore 0
proc IsRCSArchive {path} {
if {![string match *,v $path]} {return 0}
if {[fileutil::test $path fr msg]} {return 1}
trouble warn $msg
@@ -92,11 +100,11 @@
return 0
}
proc IsCVSAdmin {rcs} {
if {![string match CVSROOT/* $rcs]} {return 0}
- log write 2 collar "Ignored $rcs, administrative archive"
+ log write 4 collar "Ignored $rcs, administrative archive"
return 1
}
proc UserPath {rcs iav} {
upvar 1 $iav isattic
@@ -133,11 +141,12 @@
# By default this is a problem causing an abort after the pass
# has completed. The user can however force us to ignore it.
# In that case the warning is still printed, but will not
# induce an abort any longer.
- if {$ignore} {
+ upvar 1 myignore myignore
+ if {$myignore} {
log write 2 collar "Ignored $rcs, superceded archive"
} else {
trouble warn "Ignored $rcs, superceded archive"
}
return 1
Added tools/cvs2fossil/lib/c2f_project.tcl version [116b688f65]
@@ -1,1 +1,74 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2007 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
+# # ## ### ##### ######## ############# #####################
+
+## Project, part of a CVS repository. Multiple instances are possible.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.4 ; # Required runtime.
+package require snit ; # OO system.
+
+# # ## ### ##### ######## ############# #####################
+##
+
+snit::type ::vc::fossil::import::cvs::project {
+ # # ## ### ##### ######## #############
+ ## Public API
+
+ constructor {path} {
+ set mybase $path
+ return
+ }
+
+ method base {} { return $mybase }
+
+ method printbase {} {
+ if {$mybase eq ""} {return <Repository>}
+ return $mybase
+ }
+
+ method add {rcs usr} {
+ set myfiles($rcs) $usr
+ return
+ }
+
+ method files {} {
+ return [array names myfiles]
+ }
+
+ # # ## ### ##### ######## #############
+ ## State
+
+ variable mybase {} ; # Project directory
+ variable myfiles -array {} ; # Maps rcss archive to their user files.
+
+ # # ## ### ##### ######## #############
+ ## Internal methods
+
+ pragma -hastypeinfo no ; # no type introspection
+ pragma -hasinfo no ; # no object introspection
+ pragma -hastypemethods no ; # type is not relevant.
+ pragma -simpledispatch yes ; # simple fast dispatch
+
+ # # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::fossil::import::cvs {
+ namespace export project
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
+package provide vc::fossil::import::cvs::project 1.0
+return
Modified tools/cvs2fossil/lib/c2f_repository.tcl from [1272254724] to [ccb926d285].
@@ -13,30 +13,168 @@
## Repository manager. Keeps projects and their files around.
# # ## ### ##### ######## ############# #####################
## Requirements
-package require Tcl 8.4 ; # Required runtime.
-package require snit ; # OO system.
+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::fossil::import::cvs::project ; # CVS projects
+package require struct::list ; # List 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} {
+ # Cannot be checked immediately, the base is not known while
+ # projects are added.
+ lappend myprojpaths $path
+ return
}
typemethod projects {} {
+ # TODO: Loading from the state database if CollAr is skipped
+ # in a run.
+
+ 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 printstatistics {} {
+ set prlist [TheProjects]
+ set npr [llength $prlist]
+
+ log write 2 repository "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 files]]
+ set line "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
+ }
+
+ typemethod persist {} {
+ }
+
+ # # ## ### ##### ######## #############
+ ## State
+
+ typevariable mybase {}
+ typevariable myprojpaths {}
+ typevariable myprojects {}
+
+ # # ## ### ##### ######## #############
+ ## Internal methods
+
+ proc .BaseLength {p} {
+ return [string length [$p printbase]]
+ }
+
+ proc .NFileLength {p} {
+ return [string length [llength [$p files]]]
+ }
+
+ proc IsRepositoryBase {path mv} {
+ upvar 1 $mv msg mybase mybase
+ 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 myprojects myprojects myprojpaths myprojpaths mybase mybase
+
+ if {![llength $myprojects]} {
+ set myprojects [EmptyProjects $myprojpaths]
+ }
+ return $myprojects
+ }
+
+ proc EmptyProjects {projpaths} {
+ upvar 1 mybase mybase
+ set res {}
+ if {[llength $projpaths]} {
+ foreach pp $projpaths {
+ lappend res [project %AUTO% $pp]
+ }
+ } else {
+ # Base is the single project.
+ lappend res [project %AUTO% ""]
+ }
+ return $res
}
# # ## ### ##### ######## #############
## Configuration
@@ -48,16 +186,18 @@
}
namespace eval ::vc::fossil::import::cvs {
namespace export repository
namespace eval repository {
- #namespace import ::vc::tools::trouble
- #namespace import ::vc::tools::log
- #log register collar
+ namespace import ::vc::fossil::import::cvs::project
+ namespace import ::vc::tools::trouble
+ namespace import ::vc::tools::log
+ namespace import ::vc::tools::misc::*
+ log register repository
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::repository 1.0
return
Modified tools/cvs2fossil/lib/cvs2fossil.tcl from [afcd4ba6f1] to [00e210c971].
@@ -29,10 +29,11 @@
# # ## ### ##### ######## ############# #####################
## Support for passes etc.
package require vc::fossil::import::cvs::option ; # Cmd line parsing & database
package require vc::fossil::import::cvs::pass ; # Pass management
+package require vc::tools::log ; # User feedback
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs {
@@ -45,10 +46,12 @@
# are actually run is determined through the specified options
# and their defaults.
option process $arguments
pass run
+
+ vc::tools::log write 0 cvs2fossil Done
return
}
# # ## ### ##### ######## #############
## Configuration
Added tools/cvs2fossil/lib/misc.tcl version [d5db2a2c74]
@@ -1,1 +1,64 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2007 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
+# # ## ### ##### ######## ############# #####################
+
+## Utilities for various things: text formatting, max, ...
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.4 ; # Required runtime
+
+# # ## ### ##### ######## ############# #####################
+##
+
+namespace eval ::vc::tools::misc {
+ # # ## ### ##### ######## #############
+ ## Public API, Methods
+
+ # Choose singular vs plural forms of a word based on a number.
+
+ proc sp {n singular {plural {}}} {
+ if {$n == 1} {return $singular}
+ if {$plural eq ""} {set plural ${singular}s}
+ return $plural
+ }
+
+ # As above, with the number automatically put in front of the
+ # string.
+
+ proc nsp {n singular {plural {}}} {
+ return "$n [sp $n $singular $plural]"
+ }
+
+ # Find maximum in a list.
+
+ proc max {list} {
+ set max -1
+ foreach e $list {
+ if {$e < $max} continue
+ set max $e
+ }
+ return $max
+ }
+
+ # # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::tools::misc {
+ namespace export sp nsp max
+}
+
+# -----------------------------------------------------------------------------
+# Ready
+package provide vc::tools::misc 1.0
+return
Modified tools/cvs2fossil/lib/pkgIndex.tcl from [2c71099183] to [e327e448a1].
@@ -6,7 +6,10 @@ package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir cvs2fossil.tcl]] package ifneeded vc::fossil::import::cvs::option 1.0 [list source [file join $dir c2f_option.tcl]] package ifneeded vc::fossil::import::cvs::pass 1.0 [list source [file join $dir c2f_pass.tcl]] package ifneeded vc::fossil::import::cvs::pass::collar 1.0 [list source [file join $dir c2f_pcollar.tcl]] package ifneeded vc::fossil::import::cvs::repository 1.0 [list source [file join $dir c2f_repository.tcl]] +package ifneeded vc::fossil::import::cvs::project 1.0 [list source [file join $dir c2f_project.tcl]] package ifneeded vc::tools::trouble 1.0 [list source [file join $dir trouble.tcl]] package ifneeded vc::tools::log 1.0 [list source [file join $dir log.tcl]] +package ifneeded vc::tools::misc 1.0 [list source [file join $dir misc.tcl]] +
Modified tools/cvs2fossil/lib/trouble.tcl from [a28d3a5333] to [2697d806a7].
@@ -58,11 +58,18 @@
if {
![llength $myinfo] &&
![llength $mywarn] &&
![llength $myfatal]
} return
- # We have error messages to print, so stop.
+
+ # Frame the pending messages to make them more clear as the
+ # cause of the abort.
+
+ set myinfo [linsert $myinfo 0 "" "Encountered problems." ""]
+ lappend myfatal "Stopped due to problems."
+
+ # We have error messages to print, so stop now.
exit 1
}
# # ## ### ##### ######## #############
## Internal, state