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, 10f9d51bb2 2007-10-06 aku: pid INTEGER NOT NULL REFERENCES project, -- project the file belongs to 78da61db0e 2007-10-05 aku: name TEXT NOT NULL, 78da61db0e 2007-10-05 aku: visible TEXT NOT NULL, 10f9d51bb2 2007-10-06 aku: UNIQUE (pid, name) -- file names are unique within a project 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: a10f654ac7 2007-10-10 aku: set traverse [fileutil::traverse %AUTO% $base \ a10f654ac7 2007-10-10 aku: -prefilter [myproc FilterAtticSubdir $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: a10f654ac7 2007-10-10 aku: if { a10f654ac7 2007-10-10 aku: [file exists $base/$usr] && a10f654ac7 2007-10-10 aku: [file isdirectory $base/$usr] a10f654ac7 2007-10-10 aku: } { a10f654ac7 2007-10-10 aku: trouble fatal "Directory name conflicts with filename." a10f654ac7 2007-10-10 aku: trouble fatal "Please remove or rename one of the following:" a10f654ac7 2007-10-10 aku: trouble fatal " $base/$usr" a10f654ac7 2007-10-10 aku: trouble fatal " $base/$rcs" a10f654ac7 2007-10-10 aku: continue a10f654ac7 2007-10-10 aku: } 52f2254007 2007-10-04 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 a10f654ac7 2007-10-10 aku: a10f654ac7 2007-10-10 aku: proc FilterAtticSubdir {base path} { a10f654ac7 2007-10-10 aku: # This command is used by the traverser to prevent it from a10f654ac7 2007-10-10 aku: # scanning into subdirectories of an Attic. We get away with a10f654ac7 2007-10-10 aku: # checking the immediate parent directory of the current path a10f654ac7 2007-10-10 aku: # as our rejection means that deeper path do not occur. a10f654ac7 2007-10-10 aku: a10f654ac7 2007-10-10 aku: if {[file tail [file dirname $path]] eq "Attic"} { a10f654ac7 2007-10-10 aku: set ad [fileutil::stripPath $base $path] a10f654ac7 2007-10-10 aku: log write 1 collar "Directory $ad found in Attic, ignoring." a10f654ac7 2007-10-10 aku: return 0 a10f654ac7 2007-10-10 aku: } a10f654ac7 2007-10-10 aku: return 1 a10f654ac7 2007-10-10 aku: } 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} { 70b0aa899a 2007-10-06 aku: ::variable myignore 70b0aa899a 2007-10-06 aku: 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: 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
File Annotation