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. edc46651c7 2008-01-29 aku: package require vc::tools::misc ; # Local file utilities. 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: e288af3995 2007-12-02 aku: state extend 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: } e288af3995 2007-12-02 aku: state extend 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, 27470a9304 2007-10-13 aku: exec INTEGER NOT NULL, -- boolean, 'file executable'. 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 fb1e36d290 2007-10-05 aku: } fb1e36d290 2007-10-05 aku: ae19c0fcb4 2007-10-13 aku: typemethod load {} { ae19c0fcb4 2007-10-13 aku: # Pass manager interface. Executed for all passes before the ae19c0fcb4 2007-10-13 aku: # run passes, to load all data of their pass from the state, ae19c0fcb4 2007-10-13 aku: # as if it had been computed by the pass itself. ae19c0fcb4 2007-10-13 aku: e288af3995 2007-12-02 aku: state use project e288af3995 2007-12-02 aku: state use file 54ac684df7 2007-10-13 aku: 54ac684df7 2007-10-13 aku: repository load ae19c0fcb4 2007-10-13 aku: return 47740cc1f6 2007-10-03 aku: } 47740cc1f6 2007-10-03 aku: 47740cc1f6 2007-10-03 aku: typemethod run {} { ae19c0fcb4 2007-10-13 aku: # Pass manager interface. Executed to perform the ae19c0fcb4 2007-10-13 aku: # functionality of the pass. ae19c0fcb4 2007-10-13 aku: 52f2254007 2007-10-04 aku: set rbase [repository base?] 47740cc1f6 2007-10-03 aku: foreach project [repository projects] { 7208c7ac4d 2008-01-28 mjanssen: 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: 7208c7ac4d 2008-01-28 mjanssen: # XXX Checkme: not sure if this will still fail in the case where a directory does conflict with a file XXX a10f654ac7 2007-10-10 aku: if { ed13b28b13 2008-01-30 aku: [fileexists_cs $base/$usr] && ed13b28b13 2008-01-30 aku: [fileisdir_cs $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: } a10f654ac7 2007-10-10 aku: 52f2254007 2007-10-04 aku: log write 4 collar "Found $rcs" 27470a9304 2007-10-13 aku: $project addfile $rcs $usr [file executable $rcs] 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" 52f2254007 2007-10-04 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: ae19c0fcb4 2007-10-13 aku: typemethod discard {} { ae19c0fcb4 2007-10-13 aku: # Pass manager interface. Executed for all passes after the ae19c0fcb4 2007-10-13 aku: # run passes, to remove all data of this pass from the state, ae19c0fcb4 2007-10-13 aku: # as being out of date. ae19c0fcb4 2007-10-13 aku: ae19c0fcb4 2007-10-13 aku: state discard project ae19c0fcb4 2007-10-13 aku: state discard file 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: edc46651c7 2008-01-29 aku: if {!$isattic} {return 0} ed13b28b13 2008-01-30 aku: if {![fileexists_cs $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 edc46651c7 2008-01-29 aku: namespace import ::vc::tools::misc::file* 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