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: ## Pass I. This pass scans the repository to import for RCS archives,
47740cc1f6 2007-10-03       aku: ## and sorts and filters them into the declared projects, if any
47740cc1f6 2007-10-03       aku: ## Without declared projects the whole repository is treated as a
47740cc1f6 2007-10-03       aku: ## single project.
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: # # ## ### ##### ######## ############# #####################
47740cc1f6 2007-10-03       aku: ## Requirements
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: package require Tcl 8.4                             ; # Required runtime.
47740cc1f6 2007-10-03       aku: package require snit                                ; # OO system.
47740cc1f6 2007-10-03       aku: package require fileutil::traverse                  ; # Directory traversal.
47740cc1f6 2007-10-03       aku: package require fileutil                            ; # File & path utilities.
47740cc1f6 2007-10-03       aku: package require vc::tools::trouble                  ; # Error reporting.
47740cc1f6 2007-10-03       aku: package require vc::tools::log                      ; # User feedback.
47740cc1f6 2007-10-03       aku: package require vc::fossil::import::cvs::pass       ; # Pass management.
47740cc1f6 2007-10-03       aku: package require vc::fossil::import::cvs::repository ; # Repository management.
fb1e36d290 2007-10-05       aku: package require vc::fossil::import::cvs::state      ; # State storage
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: # # ## ### ##### ######## ############# #####################
47740cc1f6 2007-10-03       aku: ## Register the pass with the management
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: vc::fossil::import::cvs::pass define \
47740cc1f6 2007-10-03       aku:     CollectAr \
47740cc1f6 2007-10-03       aku:     {Collect archives in repository} \
47740cc1f6 2007-10-03       aku:     ::vc::fossil::import::cvs::pass::collar
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::pass::collar {
47740cc1f6 2007-10-03       aku:     # # ## ### ##### ######## #############
47740cc1f6 2007-10-03       aku:     ## Public API
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     typemethod setup {} {
fb1e36d290 2007-10-05       aku: 	# Define names and structure of the persistent state of this
fb1e36d290 2007-10-05       aku: 	# pass.
fb1e36d290 2007-10-05       aku: 
78da61db0e 2007-10-05       aku: 	# We deal with repository projects, and the rcs archive files
78da61db0e 2007-10-05       aku: 	# in the projects.
78da61db0e 2007-10-05       aku: 
78da61db0e 2007-10-05       aku: 	# For the first, projects, we keep their names, which are
78da61db0e 2007-10-05       aku: 	# their paths relative to the base directory of the whole
78da61db0e 2007-10-05       aku: 	# repository. These have to be globally unique, i.e. no two
78da61db0e 2007-10-05       aku: 	# projects can have the same name.
78da61db0e 2007-10-05       aku: 
78da61db0e 2007-10-05       aku: 	# For the files we keep their names, which are their paths
78da61db0e 2007-10-05       aku: 	# relative to the base directory of the whole project! These
78da61db0e 2007-10-05       aku: 	# have to be unique within a project, however globally this
78da61db0e 2007-10-05       aku: 	# does not hold, a name may occur several times, in different
78da61db0e 2007-10-05       aku: 	# projects. We further store the user visible file name
78da61db0e 2007-10-05       aku: 	# associated with the rcs archive.
78da61db0e 2007-10-05       aku: 
78da61db0e 2007-10-05       aku: 	# Both projects and files are identified by globally unique
78da61db0e 2007-10-05       aku: 	# integer ids, automatically assigned by the database.
78da61db0e 2007-10-05       aku: 
fb1e36d290 2007-10-05       aku: 	state writing project {
fb1e36d290 2007-10-05       aku: 	    pid  INTEGER  NOT NULL  PRIMARY KEY AUTOINCREMENT,
fb1e36d290 2007-10-05       aku: 	    name TEXT     NOT NULL  UNIQUE
fb1e36d290 2007-10-05       aku: 	}
78da61db0e 2007-10-05       aku: 	state writing file {
fb1e36d290 2007-10-05       aku: 	    fid     INTEGER  NOT NULL  PRIMARY KEY AUTOINCREMENT,
fb1e36d290 2007-10-05       aku: 	    pid     INTEGER  NOT NULL  REFERENCES project,
78da61db0e 2007-10-05       aku: 	    name    TEXT     NOT NULL,
78da61db0e 2007-10-05       aku: 	    visible TEXT     NOT NULL,
78da61db0e 2007-10-05       aku: 	    UNIQUE (pid, name)
fb1e36d290 2007-10-05       aku: 	}
fb1e36d290 2007-10-05       aku: 	return
47740cc1f6 2007-10-03       aku:     }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     typemethod run {} {
52f2254007 2007-10-04       aku: 	set rbase [repository base?]
47740cc1f6 2007-10-03       aku: 	foreach project [repository projects] {
52f2254007 2007-10-04       aku: 	    set base [file join $rbase [$project base]]
47740cc1f6 2007-10-03       aku: 	    log write 1 collar "Scan $base"
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	    set traverse [fileutil::traverse %AUTO% $base]
47740cc1f6 2007-10-03       aku: 	    set n 0
47740cc1f6 2007-10-03       aku: 	    set r {}
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	    $traverse foreach path {
47740cc1f6 2007-10-03       aku: 		set rcs [fileutil::stripPath $base $path]
47740cc1f6 2007-10-03       aku: 		if {[IsCVSAdmin    $rcs]}  continue
47740cc1f6 2007-10-03       aku: 		if {![IsRCSArchive $path]} continue
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 		set usr [UserPath $rcs isattic]
47740cc1f6 2007-10-03       aku: 		if {[IsSuperceded $base $rcs $usr $isattic]} continue
47740cc1f6 2007-10-03       aku: 
52f2254007 2007-10-04       aku: 		log write 4 collar "Found   $rcs"
47740cc1f6 2007-10-03       aku: 		$project add $rcs $usr
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 		incr n
52f2254007 2007-10-04       aku: 		if {[log verbosity?] < 4} {
52f2254007 2007-10-04       aku: 		    log progress 0 collar $n {}
52f2254007 2007-10-04       aku: 		}
47740cc1f6 2007-10-03       aku: 	    }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	    $traverse destroy
47740cc1f6 2007-10-03       aku: 	}
52f2254007 2007-10-04       aku: 
52f2254007 2007-10-04       aku: 	repository printstatistics
52f2254007 2007-10-04       aku: 	repository persist
52f2254007 2007-10-04       aku: 
52f2254007 2007-10-04       aku: 	log write 1 collar "Scan completed"
47740cc1f6 2007-10-03       aku: 	return
47740cc1f6 2007-10-03       aku:     }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     typemethod ignore_conflicting_attics {} {
52f2254007 2007-10-04       aku: 	set myignore 1
47740cc1f6 2007-10-03       aku: 	return
47740cc1f6 2007-10-03       aku:     }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     # # ## ### ##### ######## #############
47740cc1f6 2007-10-03       aku:     ## Internal methods
47740cc1f6 2007-10-03       aku: 
52f2254007 2007-10-04       aku:     typevariable myignore 0
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     proc IsRCSArchive {path} {
47740cc1f6 2007-10-03       aku: 	if {![string match *,v $path]}     {return 0}
47740cc1f6 2007-10-03       aku: 	if {[fileutil::test $path fr msg]} {return 1}
47740cc1f6 2007-10-03       aku: 	trouble warn $msg
47740cc1f6 2007-10-03       aku: 	return 0
47740cc1f6 2007-10-03       aku:     }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     proc IsCVSAdmin {rcs} {
47740cc1f6 2007-10-03       aku: 	if {![string match CVSROOT/* $rcs]} {return 0}
52f2254007 2007-10-04       aku: 	log write 4 collar "Ignored $rcs, administrative archive"
47740cc1f6 2007-10-03       aku: 	return 1
47740cc1f6 2007-10-03       aku:     }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     proc UserPath {rcs iav} {
47740cc1f6 2007-10-03       aku: 	upvar 1 $iav isattic
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	# Derive the user-visible path from the rcs path. Meaning:
47740cc1f6 2007-10-03       aku: 	# Chop off the ",v" suffix, and remove a possible "Attic".
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	set f [string range $rcs 0 end-2]
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	if {"Attic" eq [lindex [file split $rcs] end-1]} {
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	    # The construction below ensures that Attic/X maps to X
47740cc1f6 2007-10-03       aku: 	    # instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	    set fx [file dirname [file dirname $f]]
47740cc1f6 2007-10-03       aku: 	    set f  [file tail $f]
47740cc1f6 2007-10-03       aku: 	    if {$fx ne "."} { set f [file join $fx $f] }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	    set isattic 1
47740cc1f6 2007-10-03       aku: 	} else {
47740cc1f6 2007-10-03       aku: 	    set isattic 0
47740cc1f6 2007-10-03       aku: 	}
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	return $f
47740cc1f6 2007-10-03       aku:     }
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku:     proc IsSuperceded {base rcs usr isattic} {
47740cc1f6 2007-10-03       aku: 	if {!$isattic}                   {return 0}
47740cc1f6 2007-10-03       aku: 	if {![file exists $base/$usr,v]} {return 0}
47740cc1f6 2007-10-03       aku: 
47740cc1f6 2007-10-03       aku: 	# We have a regular archive and an Attic archive refering to
47740cc1f6 2007-10-03       aku: 	# the same user visible file. Ignore the file in the Attic.
47740cc1f6 2007-10-03       aku: 	#
47740cc1f6 2007-10-03       aku: 	# By default this is a problem causing an abort after the pass
47740cc1f6 2007-10-03       aku: 	# has completed. The user can however force us to ignore it.
47740cc1f6 2007-10-03       aku: 	# In that case the warning is still printed, but will not
47740cc1f6 2007-10-03       aku: 	# induce an abort any longer.
47740cc1f6 2007-10-03       aku: 
52f2254007 2007-10-04       aku: 	upvar 1 myignore myignore
52f2254007 2007-10-04       aku: 	if {$myignore} {
47740cc1f6 2007-10-03       aku: 	    log write 2 collar "Ignored $rcs, superceded archive"
47740cc1f6 2007-10-03       aku: 	} else {
47740cc1f6 2007-10-03       aku: 	    trouble warn       "Ignored $rcs, superceded archive"
47740cc1f6 2007-10-03       aku: 	}
47740cc1f6 2007-10-03       aku: 	return 1
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::pass {
47740cc1f6 2007-10-03       aku:     namespace export collar
47740cc1f6 2007-10-03       aku:     namespace eval collar {
47740cc1f6 2007-10-03       aku: 	namespace import ::vc::fossil::import::cvs::repository
fb1e36d290 2007-10-05       aku: 	namespace import ::vc::fossil::import::cvs::state
47740cc1f6 2007-10-03       aku: 	namespace import ::vc::tools::trouble
47740cc1f6 2007-10-03       aku: 	namespace import ::vc::tools::log
47740cc1f6 2007-10-03       aku: 	log register collar
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::pass::collar 1.0
47740cc1f6 2007-10-03       aku: return