6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: # Repository management (CVS), archive files 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: # Requirements 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: package require Tcl 8.4 6f121db1e2 2007-09-17 aku: package require fileutil::traverse ; # Tcllib (traverse directory hierarchy) 6f121db1e2 2007-09-17 aku: package require vc::tools::log ; # User feedback 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: namespace eval ::vc::cvs::ws::files { 6f121db1e2 2007-09-17 aku: namespace import ::vc::tools::log::write 6f121db1e2 2007-09-17 aku: namespace import ::vc::tools::log::progress 6f121db1e2 2007-09-17 aku: namespace import ::vc::tools::log::verbosity? 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: # API 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # vc::cvs::ws::files::find path - Find all RCS archives under the path. 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: # API Implementation 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: proc ::vc::cvs::ws::files::find {path} { 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: write 0 cvs "Scanning directory hierarchy $path ..." 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: set t [fileutil::traverse %AUTO% $path] 6f121db1e2 2007-09-17 aku: set n 0 6f121db1e2 2007-09-17 aku: set r {} 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: $t foreach rcs { 6f121db1e2 2007-09-17 aku: if {![string match *,v $rcs]} continue 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # Now make rcs is relative to the base/project 6f121db1e2 2007-09-17 aku: set rcs [fileutil::stripPath $path $rcs] 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: if {[string match CVSROOT/* $rcs]} { 6f121db1e2 2007-09-17 aku: write 2 cvs "Ignoring administrative file: $rcs" 6f121db1e2 2007-09-17 aku: continue 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: set f [UserFile $rcs isattic] 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: if {$isattic && [file exists $path/$f,v]} { 6f121db1e2 2007-09-17 aku: # We have a regular archive and an Attic archive refering 6f121db1e2 2007-09-17 aku: # to the same user visible file. Ignore the file in the 6f121db1e2 2007-09-17 aku: # Attic. 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: write 2 cvs "Ignoring superceded attic: $rcs" 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # TODO/CHECK. My method of co'ing exact file revisions per 6f121db1e2 2007-09-17 aku: # the info in the collected csets has the flaw that I may 6f121db1e2 2007-09-17 aku: # have to know exactly when what archive file to use, see 6f121db1e2 2007-09-17 aku: # above. It might be better to use the info only to gather 6f121db1e2 2007-09-17 aku: # when csets begin and end, and then to co complete slices 6f121db1e2 2007-09-17 aku: # per exact timestamp (-D) instead of file revisions 6f121db1e2 2007-09-17 aku: # (-r). The flaw in that is that csets can occur in the 6f121db1e2 2007-09-17 aku: # same second (trf, memchan - check for examples). For 6f121db1e2 2007-09-17 aku: # that exact checkout may be needed to recreate exact 6f121db1e2 2007-09-17 aku: # sequence of changes. Grr. Six of one ... 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: continue 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: lappend r $rcs $f 6f121db1e2 2007-09-17 aku: incr n 6f121db1e2 2007-09-17 aku: progress 0 cvs $n {} 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: $t destroy 6f121db1e2 2007-09-17 aku: return $r 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: # Internals 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: proc ::vc::cvs::ws::files::UserFile {rcs iav} { 6f121db1e2 2007-09-17 aku: upvar 1 $iav isattic 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # Derive the regular path from the rcs path. Meaning: Chop of the 6f121db1e2 2007-09-17 aku: # ",v" suffix, and remove a possible "Attic". 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: set f [string range $rcs 0 end-2] 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: if {"Attic" eq [lindex [file split $rcs] end-1]} { 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # The construction below ensures that Attic/X maps to X 6f121db1e2 2007-09-17 aku: # instead of ./X. Otherwise, Y/Attic/X maps to Y/X. 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: set fx [file dirname [file dirname $f]] 6f121db1e2 2007-09-17 aku: set f [file tail $f] 6f121db1e2 2007-09-17 aku: if {$fx ne "."} { set f [file join $fx $f] } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: set isattic 1 6f121db1e2 2007-09-17 aku: } else { 6f121db1e2 2007-09-17 aku: set isattic 0 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: return $f 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: namespace eval ::vc::cvs::ws::files { 6f121db1e2 2007-09-17 aku: namespace export find 6f121db1e2 2007-09-17 aku: } 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: # ----------------------------------------------------------------------------- 6f121db1e2 2007-09-17 aku: # Ready 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: package provide vc::cvs::ws::files 1.0 6f121db1e2 2007-09-17 aku: return
File Annotation