df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Repository management (CVS) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Requirements df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: package require Tcl 8.4 1593006ef3 2007-09-17 aku: package require fileutil ; # Tcllib (traverse directory hierarchy) 1593006ef3 2007-09-17 aku: package require vc::rcs::parser ; # Handling the RCS archive files. 1593006ef3 2007-09-17 aku: package require vc::tools::log ; # User feedback 1593006ef3 2007-09-17 aku: package require vc::cvs::cmd ; # Access to cvs application. 1593006ef3 2007-09-17 aku: package require vc::cvs::ws::files ; # Scan CVS repository for relevant files. 1593006ef3 2007-09-17 aku: package require vc::cvs::ws::timeline ; # Manage timeline of all changes. df91d389d5 2007-09-04 aku: package require struct::tree df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 86a7f249c1 2007-09-09 aku: vc::tools::log::system cvs 86a7f249c1 2007-09-09 aku: namespace import ::vc::tools::log::write d4aa7da67d 2007-09-13 aku: namespace import ::vc::rcs::parser::process cdf5e6d8b7 2007-09-13 aku: namespace import ::vc::cvs::cmd::dova be32ebcb41 2007-09-08 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # API df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: # vc::cvs::ws::configure key value - Configure the subsystem. d8c18fc148 2007-09-17 aku: # vc::cvs::ws::check src mv - Check if src is a CVS repository directory. d8c18fc148 2007-09-17 aku: # vc::cvs::ws::begin src - Start new workspace and return the top- d8c18fc148 2007-09-17 aku: # most directory co'd files are put into. d8c18fc148 2007-09-17 aku: # vc::cvs::ws::ncsets ?-import? - Retrieve number of csets (all/to import) d8c18fc148 2007-09-17 aku: # vc::cvs::ws::foreach csvar script - Run the script for each changeset, the d8c18fc148 2007-09-17 aku: # id of the current changeset stored in d8c18fc148 2007-09-17 aku: # the variable named by csvar. d8c18fc148 2007-09-17 aku: # vc::cvs::ws::done - Close workspace and delete it. d8c18fc148 2007-09-17 aku: # vc::cvs::ws::isadmin path - Check if path is an admin file of CVS d8c18fc148 2007-09-17 aku: # vc::cvs::ws::checkout id - Have workspace contain the changeset id. d8c18fc148 2007-09-17 aku: # d8c18fc148 2007-09-17 aku: # Configuration keys: d8c18fc148 2007-09-17 aku: # d8c18fc148 2007-09-17 aku: # -project path - Sub directory under 'src' to limit the import to. d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: # ----------------------------------------------------------------------------- d8c18fc148 2007-09-17 aku: # API Implementation d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::configure {key value} { d8c18fc148 2007-09-17 aku: variable project d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: switch -exact -- $key { d8c18fc148 2007-09-17 aku: -project { set project $value } d8c18fc148 2007-09-17 aku: default { d8c18fc148 2007-09-17 aku: return -code error "Unknown switch $key, expected \ d8c18fc148 2007-09-17 aku: -project" d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: return d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::check {src mv} { d8c18fc148 2007-09-17 aku: variable project d8c18fc148 2007-09-17 aku: upvar 1 $mv msg d8c18fc148 2007-09-17 aku: if { d8c18fc148 2007-09-17 aku: ![fileutil::test $src erd msg "CVS Repository"] || d8c18fc148 2007-09-17 aku: ![fileutil::test $src/CVSROOT erd msg "CVS Admin directory"] || d8c18fc148 2007-09-17 aku: (($project ne "") && d8c18fc148 2007-09-17 aku: ![fileutil::test $src/$project erd msg "Project directory"]) d8c18fc148 2007-09-17 aku: } { d8c18fc148 2007-09-17 aku: return 0 d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: return 1 d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::begin {src} { d8c18fc148 2007-09-17 aku: variable project d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: set src [file normalize $src] 1593006ef3 2007-09-17 aku: if {![check $src msg]} { return -code error $msg } 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: DefBase $src 1593006ef3 2007-09-17 aku: MakeTimeline [ScanArchives [files::find [RootPath]]] 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: # OLD api calls ... TODO rework for more structure ... d8c18fc148 2007-09-17 aku: csets ; # Group changes into sets d8c18fc148 2007-09-17 aku: rtree ; # Build revision tree (trunk only right now). d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: set w [workspace] ; # OLD api ... TODO inline d8c18fc148 2007-09-17 aku: if {$project ne ""} { d8c18fc148 2007-09-17 aku: set w $w/$project d8c18fc148 2007-09-17 aku: file mkdir $w d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: return $w d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::done {} { d8c18fc148 2007-09-17 aku: variable cwd d8c18fc148 2007-09-17 aku: variable workspace d8c18fc148 2007-09-17 aku: cd $cwd d8c18fc148 2007-09-17 aku: file delete -force $workspace d8c18fc148 2007-09-17 aku: return d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::foreach {cv script} { d8c18fc148 2007-09-17 aku: # OLD api ... TODO inline d8c18fc148 2007-09-17 aku: uplevel 1 [list ::vc::cvs::ws::foreach_cset $cv 0 $script] d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::ncsets {args} { d8c18fc148 2007-09-17 aku: variable ncs d8c18fc148 2007-09-17 aku: variable ntrunk d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: if {[llength $args] > 1} { d8c18fc148 2007-09-17 aku: return -code error "wrong#args: Expected ?-import?" d8c18fc148 2007-09-17 aku: } elseif {[llength $args] == 1} { d8c18fc148 2007-09-17 aku: if {[set k [lindex $args 0]] ne "-import"} { d8c18fc148 2007-09-17 aku: return -code "Unknown switch $k, expected -import" d8c18fc148 2007-09-17 aku: } else { d8c18fc148 2007-09-17 aku: return $ntrunk d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: return $ncs d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::isadmin {path} { d8c18fc148 2007-09-17 aku: # Check if path is a CVS admin file. d8c18fc148 2007-09-17 aku: if {[string match CVS/* $path]} {return 1} d8c18fc148 2007-09-17 aku: if {[string match */CVS/* $path]} {return 1} d8c18fc148 2007-09-17 aku: return 0 d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: proc ::vc::cvs::ws::checkout {id} { d8c18fc148 2007-09-17 aku: variable workspace ; cd $workspace d8c18fc148 2007-09-17 aku: wssetup $id ; # OLD api ... TODO inline d8c18fc148 2007-09-17 aku: } d8c18fc148 2007-09-17 aku: d8c18fc148 2007-09-17 aku: # ----------------------------------------------------------------------------- d8c18fc148 2007-09-17 aku: # Internals - Old API for now. d8c18fc148 2007-09-17 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::DefBase {path} { 1593006ef3 2007-09-17 aku: variable project 1593006ef3 2007-09-17 aku: variable base 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: set base $path 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: write 0 cvs "Base: $base" 1593006ef3 2007-09-17 aku: if {$project eq ""} { 1593006ef3 2007-09-17 aku: write 0 cvs "Project: <ALL>" 1593006ef3 2007-09-17 aku: } else { 1593006ef3 2007-09-17 aku: write 0 cvs "Project: $project" 1593006ef3 2007-09-17 aku: } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::RootPath {} { 1593006ef3 2007-09-17 aku: variable project 1593006ef3 2007-09-17 aku: variable base 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: if {$project eq ""} { 1593006ef3 2007-09-17 aku: return $base 1593006ef3 2007-09-17 aku: } else { 1593006ef3 2007-09-17 aku: return $base/$project 1593006ef3 2007-09-17 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Scan repository, collect archives, parse them, and collect revision df91d389d5 2007-09-04 aku: # information (file, revision -> date, author, commit message) df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::ScanArchives {files} { 6f121db1e2 2007-09-17 aku: write 0 cvs "Scanning archives ..." 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: set d [RootPath] 1593006ef3 2007-09-17 aku: set r {} 1593006ef3 2007-09-17 aku: set n 0 6f121db1e2 2007-09-17 aku: 6f121db1e2 2007-09-17 aku: ::foreach {rcs f} $files { 6f121db1e2 2007-09-17 aku: write 1 cvs "Archive $rcs" 6f121db1e2 2007-09-17 aku: # Get the meta data we need (revisions, timeline, messages). 1593006ef3 2007-09-17 aku: lappend r $f [process $d/$rcs] 1593006ef3 2007-09-17 aku: incr n 1593006ef3 2007-09-17 aku: } 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: write 0 cvs "Processed [NSIPL $n file]" 1593006ef3 2007-09-17 aku: return $r 1593006ef3 2007-09-17 aku: } 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::MakeTimeline {meta} { 1593006ef3 2007-09-17 aku: write 0 cvs "Generating coalesced timeline ..." df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set n 0 1593006ef3 2007-09-17 aku: ::foreach {f meta} $meta { 1593006ef3 2007-09-17 aku: array set md $meta 1593006ef3 2007-09-17 aku: array set date $md(date) 1593006ef3 2007-09-17 aku: array set auth $md(author) 1593006ef3 2007-09-17 aku: array set cmsg $md(commit) 1593006ef3 2007-09-17 aku: array set stat $md(state) 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: ::foreach rev [lsort -dict [array names date]] { 1593006ef3 2007-09-17 aku: set operation [Operation $rev $stat($rev)] 1593006ef3 2007-09-17 aku: NoteDeadRoots $f $rev $operation 1593006ef3 2007-09-17 aku: timeline::add $date($rev) $f $rev $operation $auth($rev) $cmsg($rev) 1593006ef3 2007-09-17 aku: incr n df91d389d5 2007-09-04 aku: } 1593006ef3 2007-09-17 aku: #B Extend branch management df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: write 0 cvs "Generated [NSIPL $n entry entries]" 1593006ef3 2007-09-17 aku: return 1593006ef3 2007-09-17 aku: } 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::NoteDeadRoots {f rev operation} { 1593006ef3 2007-09-17 aku: # A dead-first revision is rev 1.1 with op R. For an example see 1593006ef3 2007-09-17 aku: # the file memchan/DEPENDENCIES. Such a file seems to exist only! 1593006ef3 2007-09-17 aku: # on its branch. The branches information is set on the revision 1593006ef3 2007-09-17 aku: # (extend rcsparser!), symbols has a tag, refering to a branch, 1593006ef3 2007-09-17 aku: # possibly magic. 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: if {($rev eq "1.1") && ($operation eq "R")} { 1593006ef3 2007-09-17 aku: write 2 cvs "Dead root revision: $f" 1593006ef3 2007-09-17 aku: } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::Operation {rev state} { 1593006ef3 2007-09-17 aku: if {$state eq "dead"} {return "R"} ; # Removed 1593006ef3 2007-09-17 aku: if {$rev eq "1.1"} {return "A"} ; # Added 1593006ef3 2007-09-17 aku: return "M" ; # Modified 1593006ef3 2007-09-17 aku: } 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Group single changes into changesets df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::csets {} { df91d389d5 2007-09-04 aku: variable timeline df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable ncs df91d389d5 2007-09-04 aku: variable cmap df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: array unset csets * ; array set csets {} df91d389d5 2007-09-04 aku: array unset cmap * ; array set cmap {} df91d389d5 2007-09-04 aku: set ncs 0 df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: write 0 cvs "Generating changesets from timeline" 1593006ef3 2007-09-17 aku: df91d389d5 2007-09-04 aku: CSClear 1593006ef3 2007-09-17 aku: timeline::foreach date file revision operation author cmsg { 1593006ef3 2007-09-17 aku: # API adaption 1593006ef3 2007-09-17 aku: set entry [list $operation $date $author $revision $file $cmsg] 1593006ef3 2007-09-17 aku: 1593006ef3 2007-09-17 aku: if {![CSNone] && [CSNew $entry]} { 1593006ef3 2007-09-17 aku: CSSave 1593006ef3 2007-09-17 aku: CSClear df91d389d5 2007-09-04 aku: } 1593006ef3 2007-09-17 aku: CSAdd $entry df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: write 0 cvs "Found [NSIPL [array size csets] changeset]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { df91d389d5 2007-09-04 aku: # Changeset data: df91d389d5 2007-09-04 aku: # ncs: Counter-based id generation df91d389d5 2007-09-04 aku: # csets: id -> (user commit start end depth (file -> (op rev))) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable ncs ; set ncs 0 ; # Counter for changesets df91d389d5 2007-09-04 aku: variable csets ; array set csets {} ; # Changeset data df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Building the revision tree from the changesets. df91d389d5 2007-09-04 aku: # Limitation: Currently only trunk csets is handled. df91d389d5 2007-09-04 aku: # Limitation: Dead files are not removed, i.e. no 'R' actions right now. df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::rtree {} { df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable rtree {} df91d389d5 2007-09-04 aku: variable ntrunk 0 df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: write 0 cvs "Extracting the trunk" be32ebcb41 2007-09-08 aku: 00228d1547 2007-09-13 aku: set rtree [struct::tree ::vc::cvs::ws::RT] df91d389d5 2007-09-04 aku: $rtree rename root 0 ; # Root is first changeset, always. df91d389d5 2007-09-04 aku: set trunk 0 df91d389d5 2007-09-04 aku: set ntrunk 1 ; # Root is on the trunk. df91d389d5 2007-09-04 aku: set b 0 ; # No branch csets found yet. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Extracting the trunk is easy, simply by looking at the involved df91d389d5 2007-09-04 aku: # version numbers. df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: ::foreach c [lrange [lsort -integer [array names csets]] 1 end] { d8c18fc148 2007-09-17 aku: ::foreach {u cm s e rd f} $csets($c) break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Ignore branch changes, just count them for the statistics. df91d389d5 2007-09-04 aku: if {$rd != 2} { df91d389d5 2007-09-04 aku: incr b df91d389d5 2007-09-04 aku: continue df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Trunk revision, connect to, and update the head. df91d389d5 2007-09-04 aku: $rtree insert $trunk end $c df91d389d5 2007-09-04 aku: set trunk $c df91d389d5 2007-09-04 aku: incr ntrunk df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: write 0 cvs "Processed $ntrunk trunk [expr {($ntrunk == 1) ? "changeset" : "changesets"}]" be32ebcb41 2007-09-08 aku: write 0 cvs "Ignored $b branch [expr {($b == 1) ? "changeset" : "changesets"}]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { df91d389d5 2007-09-04 aku: # Tree holding trunk and branch information (struct::tree). df91d389d5 2007-09-04 aku: # Node names are cset id's. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable rtree {} df91d389d5 2007-09-04 aku: variable ntrunk 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::workspace {} { df91d389d5 2007-09-04 aku: variable cwd [pwd] df91d389d5 2007-09-04 aku: variable workspace [fileutil::tempfile importF_cvs_ws_] df91d389d5 2007-09-04 aku: file delete $workspace df91d389d5 2007-09-04 aku: file mkdir $workspace df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: write 0 cvs "Workspace: $workspace" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: cd $workspace ; # Checkouts go here. df91d389d5 2007-09-04 aku: return $workspace df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::wssetup {c} { df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable base d8c18fc148 2007-09-17 aku: variable project df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # pwd = workspace df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: ::foreach {u cm s e rd fs} $csets($c) break be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: write 1 cvs "@ $s" be32ebcb41 2007-09-08 aku: d8c18fc148 2007-09-17 aku: ::foreach l [split [string trim $cm] \n] { be32ebcb41 2007-09-08 aku: write 1 cvs "| $l" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: ::foreach {f or} $fs { d8c18fc148 2007-09-17 aku: ::foreach {op r} $or break be32ebcb41 2007-09-08 aku: write 2 cvs "$op $f $r" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {$op eq "R"} { df91d389d5 2007-09-04 aku: # Remove file from workspace. Prune empty directories. df91d389d5 2007-09-04 aku: # df91d389d5 2007-09-04 aku: # NOTE: A dead-first file (rev 1.1 dead) will never have df91d389d5 2007-09-04 aku: # existed. df91d389d5 2007-09-04 aku: # df91d389d5 2007-09-04 aku: # NOTE: Logically empty directories still physically df91d389d5 2007-09-04 aku: # contain the CVS admin directory, hence the check for == df91d389d5 2007-09-04 aku: # 1, not == 0. There might also be hidden files, we count df91d389d5 2007-09-04 aku: # them as well. Always hidden are . and .. and they do not df91d389d5 2007-09-04 aku: # count as user file. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: file delete $f df91d389d5 2007-09-04 aku: set fd [file dirname $f] df91d389d5 2007-09-04 aku: if { df91d389d5 2007-09-04 aku: ([llength [glob -nocomplain -directory $fd *]] == 1) && df91d389d5 2007-09-04 aku: ([llength [glob -nocomplain -directory -type hidden $fd *]] == 2) df91d389d5 2007-09-04 aku: } { df91d389d5 2007-09-04 aku: file delete -force $fd df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } else { df91d389d5 2007-09-04 aku: # Added or modified, put the requested version of the file df91d389d5 2007-09-04 aku: # into the workspace. df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: if {$project ne ""} {set f $project/$f} df91d389d5 2007-09-04 aku: if {[catch { cdf5e6d8b7 2007-09-13 aku: dova -d $base co -r $r $f df91d389d5 2007-09-04 aku: } msg]} { df91d389d5 2007-09-04 aku: if {[string match {*invalid change text*} $msg]} { df91d389d5 2007-09-04 aku: # The archive of the file is corrupted and the df91d389d5 2007-09-04 aku: # chosen version not accessible due to that. We df91d389d5 2007-09-04 aku: # report the problem, but otherwise ignore it. As d8c18fc148 2007-09-17 aku: # a consequence the destination repository will not df91d389d5 2007-09-04 aku: # contain the full history of the named file. By df91d389d5 2007-09-04 aku: # ignoring the problem we however get as much as df91d389d5 2007-09-04 aku: # is possible. df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: write 0 cvs "EE Corrupted archive file. Inaccessible revision." df91d389d5 2007-09-04 aku: continue df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: return -code error $msg df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Provide metadata about the changeset the backend may wish to have b504674c5f 2007-09-15 aku: return [list $u $s $cm] 00228d1547 2007-09-13 aku: } 00228d1547 2007-09-13 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { df91d389d5 2007-09-04 aku: # Workspace where checkouts happen df91d389d5 2007-09-04 aku: # Current working directory to go back to after the import. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable workspace {} df91d389d5 2007-09-04 aku: variable cwd {} df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::foreach_cset {cv node script} { df91d389d5 2007-09-04 aku: upvar 1 $cv c df91d389d5 2007-09-04 aku: variable rtree df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set c $node df91d389d5 2007-09-04 aku: while {1} { 8469631cc9 2007-09-08 aku: set code [catch {uplevel 1 $script} res] 8469631cc9 2007-09-08 aku: 8469631cc9 2007-09-08 aku: # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue 8469631cc9 2007-09-08 aku: switch -- $code { 8469631cc9 2007-09-08 aku: 0 {} be32ebcb41 2007-09-08 aku: 1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res } 8469631cc9 2007-09-08 aku: 2 {} 8469631cc9 2007-09-08 aku: 3 { return } 8469631cc9 2007-09-08 aku: 4 {} 8469631cc9 2007-09-08 aku: default { 8469631cc9 2007-09-08 aku: return -code $code $result 8469631cc9 2007-09-08 aku: } 8469631cc9 2007-09-08 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Stop on reaching the head. df91d389d5 2007-09-04 aku: if {![llength [$rtree children $c]]} break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #puts <[$rtree children $c]> df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Go to next child in trunk (leftmost). df91d389d5 2007-09-04 aku: set c [lindex [$rtree children $c] 0] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Internal helper commands: Changeset inspection and construction. df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::CSClear {} { df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set start {} df91d389d5 2007-09-04 aku: set end {} df91d389d5 2007-09-04 aku: set cm {} df91d389d5 2007-09-04 aku: set user {} df91d389d5 2007-09-04 aku: set lastd {} df91d389d5 2007-09-04 aku: array unset files * df91d389d5 2007-09-04 aku: array set files {} df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::CSNone {} { df91d389d5 2007-09-04 aku: upvar 1 start start df91d389d5 2007-09-04 aku: return [expr {$start eq ""}] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::CSNew {entry} { df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd reason reason df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #puts -nonewline stdout . ; flush stdout df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: ::foreach {op ts a rev f ecm} $entry break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # User change df91d389d5 2007-09-04 aku: if {$a ne $user} {set reason user ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # File already in current cset df91d389d5 2007-09-04 aku: if {[info exists files($f)]} {set reason file ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Current cset trunk/branch different from entry. df91d389d5 2007-09-04 aku: set depth [llength [split $rev .]] df91d389d5 2007-09-04 aku: if {($lastd == 2) != ($depth == 2)} {set reason depth/$lastd/$depth/($rev)/$f ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Commit message changed df91d389d5 2007-09-04 aku: if {$cm ne $ecm} {set reason cmsg\ <<$ecm>> ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Everything is good, still the same cset df91d389d5 2007-09-04 aku: return 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::CSSave {} { df91d389d5 2007-09-04 aku: variable cmap df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable ncs df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set csets($ncs) [list $user $cm $start $end $lastd [array get files]] df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Record which revisions of a file are in what csets d8c18fc148 2007-09-17 aku: ::foreach {f or} [array get files] { d8c18fc148 2007-09-17 aku: ::foreach {_ rev} $or break df91d389d5 2007-09-04 aku: set cmap([list $f $rev]) $ncs df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #CSDump $ncs df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: incr ncs df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::CSAdd {entry} { df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: ::foreach {op ts a rev f ecm} $entry break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {$start eq ""} {set start $ts} df91d389d5 2007-09-04 aku: set end $ts df91d389d5 2007-09-04 aku: set cm $ecm df91d389d5 2007-09-04 aku: set user $a df91d389d5 2007-09-04 aku: set files($f) [list $op $rev] df91d389d5 2007-09-04 aku: set lastd [llength [split $rev .]] df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::CSDump {c} { df91d389d5 2007-09-04 aku: variable csets d8c18fc148 2007-09-17 aku: ::foreach {u cm s e rd f} $csets($c) break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: puts "$u $s"; regsub -all {.} $u { } b df91d389d5 2007-09-04 aku: puts "$b $e" d8c18fc148 2007-09-17 aku: ::foreach {f or} $f { d8c18fc148 2007-09-17 aku: ::foreach {o r} $or break df91d389d5 2007-09-04 aku: puts "$b $o $f $r" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::NSIPL {n singular {plural {}}} { 1593006ef3 2007-09-17 aku: return "$n [SIPL $n $singular $plural]" 1593006ef3 2007-09-17 aku: } 1593006ef3 2007-09-17 aku: proc ::vc::cvs::ws::SIPL {n singular {plural {}}} { 1593006ef3 2007-09-17 aku: if {$n == 1} {return $singular} 1593006ef3 2007-09-17 aku: if {$plural eq ""} {set plural ${singular}s} 1593006ef3 2007-09-17 aku: return $plural df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: # ----------------------------------------------------------------------------- d8c18fc148 2007-09-17 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { d8c18fc148 2007-09-17 aku: variable base {} ; # Toplevel repository directory d8c18fc148 2007-09-17 aku: variable project {} ; # Sub directory to limit the import to. df91d389d5 2007-09-04 aku: d8c18fc148 2007-09-17 aku: namespace export configure begin done foreach ncsets checkout df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Ready df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: package provide vc::cvs::ws 1.0 df91d389d5 2007-09-04 aku: return
File Annotation