8a93ffa9c1 2007-10-06 aku: ## -*- tcl -*- 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# ##################### 8a93ffa9c1 2007-10-06 aku: ## Copyright (c) 2007 Andreas Kupries. 8a93ffa9c1 2007-10-06 aku: # 8a93ffa9c1 2007-10-06 aku: # This software is licensed as described in the file LICENSE, which 8a93ffa9c1 2007-10-06 aku: # you should have received as part of this distribution. 8a93ffa9c1 2007-10-06 aku: # 8a93ffa9c1 2007-10-06 aku: # This software consists of voluntary contributions made by many 8a93ffa9c1 2007-10-06 aku: # individuals. For exact contribution history, see the revision 8a93ffa9c1 2007-10-06 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# ##################### 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: ## File, part of a project, part of a CVS repository. Multiple 8a93ffa9c1 2007-10-06 aku: ## instances are possible. 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# ##################### 8a93ffa9c1 2007-10-06 aku: ## Requirements 8a93ffa9c1 2007-10-06 aku: 3d88cfd05d 2007-10-06 aku: package require Tcl 8.4 ; # Required runtime. 3d88cfd05d 2007-10-06 aku: package require snit ; # OO system. bd131addb9 2007-10-12 aku: package require struct::set ; # Set operations. e100314ec2 2007-12-05 aku: package require struct::list ; # Higher order operations. bd131addb9 2007-10-12 aku: package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. da9295c6f6 2007-10-12 aku: package require vc::fossil::import::cvs::file::sym ; # CVS per file symbols. adf168e23e 2007-10-24 aku: package require vc::fossil::import::cvs::state ; # State storage. 47d52d1efd 2007-11-28 aku: package require vc::fossil::import::cvs::integrity ; # State integrity checks. e100314ec2 2007-12-05 aku: package require vc::fossil::import::cvs::gtcore ; # Graph traversal core. cb70cf4ad6 2007-10-13 aku: package require vc::tools::trouble ; # Error reporting. 177a0cc55c 2007-10-17 aku: package require vc::tools::log ; # User feedback cb70cf4ad6 2007-10-13 aku: package require vc::tools::misc ; # Text formatting 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# ##################### 8a93ffa9c1 2007-10-06 aku: ## 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: snit::type ::vc::fossil::import::cvs::file { 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# 8a93ffa9c1 2007-10-06 aku: ## Public API 8a93ffa9c1 2007-10-06 aku: adf168e23e 2007-10-24 aku: constructor {id path usrpath executable project} { adf168e23e 2007-10-24 aku: set myid $id 27470a9304 2007-10-13 aku: set mypath $path cfe4b269ac 2007-10-17 aku: set myusrpath $usrpath 27470a9304 2007-10-13 aku: set myexecutable $executable 27470a9304 2007-10-13 aku: set myproject $project e5441b908d 2007-10-15 aku: set mytrunk [$myproject trunk] e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: adf168e23e 2007-10-24 aku: method setid {id} { 47d52d1efd 2007-11-28 aku: integrity assert {$myid eq ""} {File '$mypath' already has an id, '$myid'} adf168e23e 2007-10-24 aku: set myid $id adf168e23e 2007-10-24 aku: return adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: method id {} { return $myid } bd131addb9 2007-10-12 aku: method path {} { return $mypath } cfe4b269ac 2007-10-17 aku: method usrpath {} { return $myusrpath } bd131addb9 2007-10-12 aku: method project {} { return $myproject } cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: delegate method commitmessageof to myproject 2e3815c3b4 2007-10-06 aku: 2e3815c3b4 2007-10-06 aku: # # ## ### ##### ######## ############# 2e3815c3b4 2007-10-06 aku: ## Methods required for the class to be a sink of the rcs parser 2e3815c3b4 2007-10-06 aku: 2e3815c3b4 2007-10-06 aku: #method begin {} {puts begin} 2e3815c3b4 2007-10-06 aku: #method sethead {h} {puts head=$h} 2e3815c3b4 2007-10-06 aku: #method setprincipalbranch {b} {puts pb=$b} bd131addb9 2007-10-12 aku: #method deftag {s r} {puts $s=$r} 2e3815c3b4 2007-10-06 aku: #method setcomment {c} {puts comment=$c} 2e3815c3b4 2007-10-06 aku: #method admindone {} {puts admindone} 2e3815c3b4 2007-10-06 aku: #method def {rev date author state next branches} {puts "def $rev $date $author $state $next $branches"} 40eaf58ec7 2007-10-12 aku: #method defdone {} {puts def-done} 2e3815c3b4 2007-10-06 aku: #method setdesc {d} {puts desc=$d} 2e3815c3b4 2007-10-06 aku: #method extend {rev commitmsg deltarange} {puts "extend $commitmsg $deltarange"} 2e3815c3b4 2007-10-06 aku: #method done {} {puts done} 2e3815c3b4 2007-10-06 aku: 2e3815c3b4 2007-10-06 aku: # # ## ### ##### ######## ############# 6d1811d61e 2007-10-06 aku: ## Persistence (pass II) 6d1811d61e 2007-10-06 aku: 6d1811d61e 2007-10-06 aku: method persist {} { adf168e23e 2007-10-24 aku: # First collect the reachable revisions and symbols, then adf168e23e 2007-10-24 aku: # assign id's to all. They are sorted so that we will have ids adf168e23e 2007-10-24 aku: # which sort in order of creation. Then we can save them. This adf168e23e 2007-10-24 aku: # is done bottom up. Revisions, then symbols. __NOTE__ This adf168e23e 2007-10-24 aku: # works only because sqlite is not checking foreign key adf168e23e 2007-10-24 aku: # references during insert. This allows to have dangling adf168e23e 2007-10-24 aku: # references which are fixed later. The longest dangling adf168e23e 2007-10-24 aku: # references are for the project level symbols, these we do adf168e23e 2007-10-24 aku: # not save here, but at the end of the pass. What we need are adf168e23e 2007-10-24 aku: # the ids, hence the two phases. adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: struct::list assign [$self Active] revisions symbols adf168e23e 2007-10-24 aku: foreach rev $revisions { $rev defid } adf168e23e 2007-10-24 aku: foreach sym $symbols { $sym defid } adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: state transaction { adf168e23e 2007-10-24 aku: foreach rev $revisions { $rev persist } adf168e23e 2007-10-24 aku: foreach sym $symbols { $sym persist } adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: return 3a00ac5aa2 2007-10-23 aku: } 3a00ac5aa2 2007-10-23 aku: 3a00ac5aa2 2007-10-23 aku: method drop {} { a766b08198 2007-10-23 aku: foreach {_ rev} [array get myrev] { $rev destroy } a766b08198 2007-10-23 aku: foreach {_ branch} [array get mybranches] { $branch destroy } a766b08198 2007-10-23 aku: foreach {_ taglist} [array get mytags] { a766b08198 2007-10-23 aku: foreach tag $taglist { $tag destroy } a766b08198 2007-10-23 aku: } a766b08198 2007-10-23 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: 3d88cfd05d 2007-10-06 aku: # # ## ### ##### ######## ############# 3d88cfd05d 2007-10-06 aku: ## Implement the sink 3d88cfd05d 2007-10-06 aku: 40eaf58ec7 2007-10-12 aku: method begin {} {#ignore} bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method sethead {revnr} { 67c24820c7 2007-10-14 aku: set myheadrevnr $revnr bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method setprincipalbranch {branchnr} { bd131addb9 2007-10-12 aku: set myprincipal $branchnr bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method deftag {name revnr} { bd131addb9 2007-10-12 aku: # FUTURE: Perform symbol transformation here. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {[struct::set contains $mysymbols $name]} { bd131addb9 2007-10-12 aku: trouble fatal "Multiple definitions of the symbol '$name' in '$mypath'" bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: struct::set add mysymbols $name bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {[rev isbranchrevnr $revnr -> branchnr]} { bd131addb9 2007-10-12 aku: $self AddBranch $name $branchnr bd131addb9 2007-10-12 aku: } else { bd131addb9 2007-10-12 aku: $self AddTag $name $revnr bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: 3d88cfd05d 2007-10-06 aku: method setcomment {c} {# ignore} 40eaf58ec7 2007-10-12 aku: 40eaf58ec7 2007-10-12 aku: method admindone {} { 40eaf58ec7 2007-10-12 aku: # We do nothing at the boundary of admin and revision data 40eaf58ec7 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method def {revnr date author state next branches} { cb70cf4ad6 2007-10-13 aku: $self RecordBranchCommits $branches bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {[info exists myrev($revnr)]} { bd131addb9 2007-10-12 aku: trouble fatal "File $mypath contains duplicate definitions for revision $revnr." bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: 67c24820c7 2007-10-14 aku: set myaid($revnr) [$myproject defauthor $author] 67c24820c7 2007-10-14 aku: set myrev($revnr) [rev %AUTO% $revnr $date $state $self] 67c24820c7 2007-10-14 aku: b5b2d61527 2007-10-17 aku: $self RecordBasicDependencies $revnr $next 40eaf58ec7 2007-10-12 aku: return 40eaf58ec7 2007-10-12 aku: } 40eaf58ec7 2007-10-12 aku: 40eaf58ec7 2007-10-12 aku: method defdone {} { cb70cf4ad6 2007-10-13 aku: # This is all done after the revision tree has been extracted cb70cf4ad6 2007-10-13 aku: # from the file, before the commit mesages and delta texts are cb70cf4ad6 2007-10-13 aku: # processed. cb70cf4ad6 2007-10-13 aku: b5b2d61527 2007-10-17 aku: $self ProcessPrimaryDependencies b5b2d61527 2007-10-17 aku: $self ProcessBranchDependencies b5b2d61527 2007-10-17 aku: $self SortBranches b5b2d61527 2007-10-17 aku: $self ProcessTagDependencies b5b2d61527 2007-10-17 aku: $self DetermineTheRootRevision cb70cf4ad6 2007-10-13 aku: return 40eaf58ec7 2007-10-12 aku: } 40eaf58ec7 2007-10-12 aku: 40eaf58ec7 2007-10-12 aku: method setdesc {d} {# ignore} 40eaf58ec7 2007-10-12 aku: 67c24820c7 2007-10-14 aku: method extend {revnr commitmsg textrange} { 67c24820c7 2007-10-14 aku: set cmid [$myproject defcmessage [string trim $commitmsg]] bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: set rev $myrev($revnr) bd131addb9 2007-10-12 aku: 67c24820c7 2007-10-14 aku: if {[$rev hasmeta]} { bd131addb9 2007-10-12 aku: # Apparently repositories exist in which the delta data bd131addb9 2007-10-12 aku: # for revision 1.1 is provided several times, at least bd131addb9 2007-10-12 aku: # twice. The actual cause of this duplication is not bd131addb9 2007-10-12 aku: # known. Speculation centers on RCS/CVS bugs, or from bd131addb9 2007-10-12 aku: # manual edits of the repository which borked the bd131addb9 2007-10-12 aku: # internals. Whatever the cause, testing showed that both bd131addb9 2007-10-12 aku: # cvs and rcs use the first definition when performing a bd131addb9 2007-10-12 aku: # checkout, and we follow their lead. Side notes: 'cvs bd131addb9 2007-10-12 aku: # log' fails on such a file, and 'cvs rlog' prints the log bd131addb9 2007-10-12 aku: # message from the first delta, ignoring the second. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: log write 1 file "In file $mypath : Duplicate delta data for revision $revnr" bd131addb9 2007-10-12 aku: log write 1 file "Ignoring the duplicate" bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: e5441b908d 2007-10-15 aku: # Determine the line of development for the revision (project e5441b908d 2007-10-15 aku: # level). This gives us the branchid too, required for the e5441b908d 2007-10-15 aku: # meta data group the revision is in. (Note: By putting both e5441b908d 2007-10-15 aku: # branch/lod and project information into the group we ensure e5441b908d 2007-10-15 aku: # that any cross-project and cross-branch commits are e5441b908d 2007-10-15 aku: # separated into multiple commits, one in each of the projects e5441b908d 2007-10-15 aku: # and/or branches). e5441b908d 2007-10-15 aku: b5b2d61527 2007-10-17 aku: set lod [$self GetLOD $revnr] e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: $rev setmeta [$myproject defmeta [$lod id] $myaid($revnr) $cmid] 67c24820c7 2007-10-14 aku: $rev settext $textrange e5441b908d 2007-10-15 aku: $rev setlod $lod bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # If this is revision 1.1, we have to determine whether the bd131addb9 2007-10-12 aku: # file seems to have been created through 'cvs add' instead of bd131addb9 2007-10-12 aku: # 'cvs import'. This can be done by looking at the un- bd131addb9 2007-10-12 aku: # adulterated commit message, as CVS uses a hardwired magic bd131addb9 2007-10-12 aku: # message for the latter, i.e. "Initial revision\n", no bd131addb9 2007-10-12 aku: # period. (This fact also helps us when the time comes to bd131addb9 2007-10-12 aku: # determine whether this file might have had a default branch bd131addb9 2007-10-12 aku: # in the past.) bd131addb9 2007-10-12 aku: 177a0cc55c 2007-10-17 aku: if {$revnr eq "1.1"} { bd131addb9 2007-10-12 aku: set myimported [expr {$commitmsg eq "Initial revision\n"}] bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # Here we also keep track of the order in which the revisions bd131addb9 2007-10-12 aku: # were added to the file. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: lappend myrevisions $rev bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: e5441b908d 2007-10-15 aku: method done {} { e5441b908d 2007-10-15 aku: # Complete the revisions, branches, and tags. This includes e5441b908d 2007-10-15 aku: # looking for a non-trunk default branch, marking its members 6f8667b03e 2007-10-31 aku: # and linking them into the trunk, possibly excluding 6f8667b03e 2007-10-31 aku: # non-trunk data, and collecting aggregate symbol statistics. b5b2d61527 2007-10-17 aku: b5b2d61527 2007-10-17 aku: $self DetermineRevisionOperations b5b2d61527 2007-10-17 aku: $self DetermineLinesOfDevelopment b5b2d61527 2007-10-17 aku: $self HandleNonTrunkDefaultBranch b5b2d61527 2007-10-17 aku: $self RemoveIrrelevantDeletions b5b2d61527 2007-10-17 aku: $self RemoveInitialBranchDeletions 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: if {[$myproject trunkonly]} { b5b2d61527 2007-10-17 aku: $self ExcludeNonTrunkInformation b5b2d61527 2007-10-17 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: $self AggregateSymbolData 6f8667b03e 2007-10-31 aku: return 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: # # ## ### ##### ######## ############# e100314ec2 2007-12-05 aku: ## Pass XII (Import). e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: method pushto {repository} { e100314ec2 2007-12-05 aku: set ws [$repository workspace] e100314ec2 2007-12-05 aku: struct::list assign [$self Expand $ws] filemap revmap e100314ec2 2007-12-05 aku: # filemap = dict (path -> uuid) e100314ec2 2007-12-05 aku: # revmap = dict (path -> rid) e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: array set idmap [$repository importfiles $filemap] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Wipe workspace clean of the imported files. e100314ec2 2007-12-05 aku: foreach x [glob -directory $ws r*] { file delete $x } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: foreach {path rid} $revmap { e100314ec2 2007-12-05 aku: set uuid $idmap($path) e100314ec2 2007-12-05 aku: state run { e100314ec2 2007-12-05 aku: INSERT INTO revuuid (rid, uuid) e100314ec2 2007-12-05 aku: VALUES ($rid, $uuid) e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: return e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: method Expand {dir} { e100314ec2 2007-12-05 aku: set ex [struct::graph ex] ; # Expansion graph. e100314ec2 2007-12-05 aku: set zp [struct::graph zp] ; # Zip/Import graph. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: close [open $dir/r__empty__ w];# Base for detached roots on branches. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Phase I: Pull the revisions from memory and fill the graphs e100314ec2 2007-12-05 aku: # with them... e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set earcs {} ; # Arcs for expansion graph e100314ec2 2007-12-05 aku: set zarcs {} ; # Arcs for zip graph e100314ec2 2007-12-05 aku: set revmap {} ; # path -> rid map to later merge uuid information e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: foreach {rid revnr parent child coff clen} [state run { e100314ec2 2007-12-05 aku: SELECT R.rid, R.rev, R.parent, R.child, R.coff, R.clen e100314ec2 2007-12-05 aku: FROM revision R e100314ec2 2007-12-05 aku: WHERE R.fid = $myid e100314ec2 2007-12-05 aku: }] { e100314ec2 2007-12-05 aku: lappend revmap r$revnr $rid e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: $zp node insert $rid e100314ec2 2007-12-05 aku: $zp node set $rid revnr $revnr e100314ec2 2007-12-05 aku: $zp node set $rid label <$revnr> e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: if {$child ne ""} { e100314ec2 2007-12-05 aku: lappend zarcs $child $rid e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: $ex node insert $rid e100314ec2 2007-12-05 aku: $ex node set $rid text [list $coff $clen] e100314ec2 2007-12-05 aku: $ex node set $rid revnr $revnr e100314ec2 2007-12-05 aku: $ex node set $rid label <$revnr> e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: if {[rev istrunkrevnr $revnr]} { e100314ec2 2007-12-05 aku: # On the trunk, this revision is a delta based on the e100314ec2 2007-12-05 aku: # child. That makes the child our predecessor. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: if {$child eq ""} continue e100314ec2 2007-12-05 aku: lappend earcs $child $rid e100314ec2 2007-12-05 aku: } else { e100314ec2 2007-12-05 aku: # On a branch this revision is a delta based on the e100314ec2 2007-12-05 aku: # parent. That makes the parent our predecessor. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: if {$parent eq ""} { e100314ec2 2007-12-05 aku: # Detached branch root, this is a patch based on e100314ec2 2007-12-05 aku: # the empty string. e100314ec2 2007-12-05 aku: $ex node set $rid __base__ r__empty__ e100314ec2 2007-12-05 aku: continue e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: lappend earcs $parent $rid e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Phase II: Insert the accumulated dependencies e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: foreach {from to} $earcs { $ex arc insert $from $to } e100314ec2 2007-12-05 aku: foreach {from to} $zarcs { $zp arc insert $from $to } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Phase III: Traverse the graphs, expand the file, and e100314ec2 2007-12-05 aku: # generate import instructions. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set archive [file join [$myproject fullpath] $mypath] e100314ec2 2007-12-05 aku: set ac [open $archive r] e100314ec2 2007-12-05 aku: fconfigure $ac -translation binary e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # First traverse the expansion graph, this gives us the e100314ec2 2007-12-05 aku: # revisions in the order we have to expand them, which we do. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: gtcore datacmd [mymethod ExpandData] e100314ec2 2007-12-05 aku: gtcore formatcmd [mymethod ExpandFormat] e100314ec2 2007-12-05 aku: gtcore sortcmd [mymethod ExpandSort] e100314ec2 2007-12-05 aku: gtcore savecmd [mymethod Expand1 $ac $dir] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: gtcore traverse $ex ; # The graph is gone after the call e100314ec2 2007-12-05 aku: close $ac e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Now traverse the import graph, this builds the instruction e100314ec2 2007-12-05 aku: # map for the fossil deltas. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: gtcore datacmd [mymethod ExpandData] e100314ec2 2007-12-05 aku: gtcore formatcmd [mymethod ExpandFormat] e100314ec2 2007-12-05 aku: gtcore sortcmd [mymethod ExpandSort] e100314ec2 2007-12-05 aku: gtcore savecmd [mymethod Expand2] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set myimport {} e100314ec2 2007-12-05 aku: gtcore traverse $zp ; # The graph is gone after the call e100314ec2 2007-12-05 aku: set filemap $myimport e100314ec2 2007-12-05 aku: unset myimport e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # And back to import control e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: return [list $filemap $revmap] e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: method ExpandData {graph node} { return [$graph node get $node revnr] } e100314ec2 2007-12-05 aku: method ExpandFormat {graph item} { return <[lindex $item 1]> } ; # revnr e100314ec2 2007-12-05 aku: method ExpandSort {graph candidates} { e100314ec2 2007-12-05 aku: # candidates = list(item), item = list(node revnr) e100314ec2 2007-12-05 aku: # Sort by node and revnr -> Trunk revisions come first. e100314ec2 2007-12-05 aku: return [lsort -index 1 -dict [lsort -index 0 -dict $candidates]] e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: method Expand1 {chan dir graph node} { e100314ec2 2007-12-05 aku: set revnr [$graph node get $node revnr] e100314ec2 2007-12-05 aku: set fname r$revnr e100314ec2 2007-12-05 aku: struct::list assign [$graph node get $node text] offset length e100314ec2 2007-12-05 aku: bf0b70d5e0 2007-12-06 aku: if {$length < 0} { bf0b70d5e0 2007-12-06 aku: set data "" bf0b70d5e0 2007-12-06 aku: } else { bf0b70d5e0 2007-12-06 aku: seek $chan $offset start bf0b70d5e0 2007-12-06 aku: set data [string map {@@ @} [read $chan $length]] bf0b70d5e0 2007-12-06 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: if {![$graph node keyexists $node __base__]} { e100314ec2 2007-12-05 aku: # Full text node. Get the data, decode it, and save. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: log write 2 file {Expanding <$revnr>, full text} e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: fileutil::writeFile -translation binary $dir/$fname $data e100314ec2 2007-12-05 aku: } else { e100314ec2 2007-12-05 aku: # Delta node. __base__ is the name of the file containing e100314ec2 2007-12-05 aku: # the baseline. The patch is at the specified location of e100314ec2 2007-12-05 aku: # the archive file. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set fbase [$graph node get $node __base__] e100314ec2 2007-12-05 aku: log write 2 file {Expanding <$revnr>, is delta of <$fbase>} e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set base [fileutil::cat -translation binary $dir/$fbase] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Writing the patch to disk is just for better e100314ec2 2007-12-05 aku: # debugging. It is not used otherwise. e100314ec2 2007-12-05 aku: fileutil::writeFile $dir/rpatch $data e100314ec2 2007-12-05 aku: fileutil::writeFile -translation binary $dir/$fname \ e100314ec2 2007-12-05 aku: [Apply $base $data] e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Post to all successors that the just generated file is their e100314ec2 2007-12-05 aku: # baseline. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: foreach out [$graph nodes -out $node] { e100314ec2 2007-12-05 aku: $graph node set $out __base__ $fname e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: return e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: proc Apply {base delta} { e100314ec2 2007-12-05 aku: # base = base text. e100314ec2 2007-12-05 aku: # delta = delta in rcs format. e100314ec2 2007-12-05 aku: # e100314ec2 2007-12-05 aku: # Both strings are unencoded, i.e. things like @@, etc. have e100314ec2 2007-12-05 aku: # already been replaced with their proper characters. e100314ec2 2007-12-05 aku: # e100314ec2 2007-12-05 aku: # Return value is the patched text. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set base [split $base \n] e100314ec2 2007-12-05 aku: set blen [llength $base] e100314ec2 2007-12-05 aku: set ooff 0 e100314ec2 2007-12-05 aku: set res "" e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set lines [split $delta \n] e100314ec2 2007-12-05 aku: set nlines [llength $lines] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: for {set i 0} {$i < $nlines} {} { e100314ec2 2007-12-05 aku: if {![regexp {^([ad])(\d+)\s(\d+)$} [lindex $lines $i] -> cmd sl cn]} { e100314ec2 2007-12-05 aku: trouble internal "Bad ed command '[lindex $lines $i]'" e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: incr i e100314ec2 2007-12-05 aku: set el [expr {$sl + $cn}] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: switch -exact -- $cmd { e100314ec2 2007-12-05 aku: d { e100314ec2 2007-12-05 aku: incr sl -1 e100314ec2 2007-12-05 aku: incr el -1 e100314ec2 2007-12-05 aku: if {$sl < $ooff} { trouble internal {Deletion before last edit} } e100314ec2 2007-12-05 aku: if {$sl > $blen} { trouble internal {Deletion past file end} } e100314ec2 2007-12-05 aku: if {$el > $blen} { trouble internal {Deletion beyond file end} } e100314ec2 2007-12-05 aku: foreach x [lrange $base $ooff $sl] { lappend res $x } e100314ec2 2007-12-05 aku: set ooff $el e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: a { e100314ec2 2007-12-05 aku: if {$sl < $ooff} { trouble internal {Insert before last edit} } e100314ec2 2007-12-05 aku: if {$sl > $blen} { trouble internal {Insert past file end} } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: foreach x [lrange $base $ooff $sl] { lappend res $x } e100314ec2 2007-12-05 aku: foreach x [lrange $lines $i [expr {$i + $cn}]] { lappend res $x } e100314ec2 2007-12-05 aku: set ooff $sl e100314ec2 2007-12-05 aku: incr i $cn e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: foreach x [lrange $base $ooff end] { lappend res $x } e100314ec2 2007-12-05 aku: return [join $res \n] e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: method Expand2 {graph node} { e100314ec2 2007-12-05 aku: set revnr [$graph node get $node revnr] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # First import the file. e100314ec2 2007-12-05 aku: lappend myimport [list A r$revnr {}] e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: if {[$graph node keyexists $node __base__]} { e100314ec2 2007-12-05 aku: # Delta node. __base__ is the name of the file containing e100314ec2 2007-12-05 aku: # the baseline. Generate instruction to make the delta as e100314ec2 2007-12-05 aku: # well. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: set fbase [$graph node get $node __base__] e100314ec2 2007-12-05 aku: lappend myimport [list D r$revnr r$fbase] e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: # Post to all successors that the just generated file is their e100314ec2 2007-12-05 aku: # baseline. Exception: Those which ave already a baseline set. e100314ec2 2007-12-05 aku: # Together with the sorting of trunk revisions first the trunk e100314ec2 2007-12-05 aku: # should one uninterupted line, with branch roots _not_ delta e100314ec2 2007-12-05 aku: # compressed per their branches. e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: foreach out [$graph nodes -out $node] { e100314ec2 2007-12-05 aku: if {[$graph node keyexists $out __base__]} continue e100314ec2 2007-12-05 aku: $graph node set $out __base__ $revnr e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: return e100314ec2 2007-12-05 aku: } e100314ec2 2007-12-05 aku: e100314ec2 2007-12-05 aku: variable myimport 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# 8a93ffa9c1 2007-10-06 aku: ## State 8a93ffa9c1 2007-10-06 aku: adf168e23e 2007-10-24 aku: variable myid {} ; # File id in the persistent state. 27470a9304 2007-10-13 aku: variable mypath {} ; # Path of the file's rcs archive. cfe4b269ac 2007-10-17 aku: variable myusrpath {} ; # Path of the file as seen by users. 27470a9304 2007-10-13 aku: variable myexecutable 0 ; # Boolean flag 'file executable'. cb70cf4ad6 2007-10-13 aku: variable myproject {} ; # Reference to the project object cb70cf4ad6 2007-10-13 aku: # the file belongs to. cb70cf4ad6 2007-10-13 aku: variable myrev -array {} ; # Maps revision number to the cb70cf4ad6 2007-10-13 aku: # associated revision object. cb70cf4ad6 2007-10-13 aku: variable myrevisions {} ; # Same as myrev, but a list, cb70cf4ad6 2007-10-13 aku: # giving us the order of cb70cf4ad6 2007-10-13 aku: # revisions. 67c24820c7 2007-10-14 aku: variable myaid -array {} ; # Map revision numbers to the id 67c24820c7 2007-10-14 aku: # of the author who committed 67c24820c7 2007-10-14 aku: # it. This is later aggregated 67c24820c7 2007-10-14 aku: # with commit message, branch name 67c24820c7 2007-10-14 aku: # and project id for a meta id. 67c24820c7 2007-10-14 aku: variable myheadrevnr {} ; # Head revision (revision number) cb70cf4ad6 2007-10-13 aku: variable myprincipal {} ; # Principal branch (branch number). cb70cf4ad6 2007-10-13 aku: # Contrary to the name this is the cb70cf4ad6 2007-10-13 aku: # default branch. cb70cf4ad6 2007-10-13 aku: variable mydependencies {} ; # Dictionary parent -> child, cb70cf4ad6 2007-10-13 aku: # records primary dependencies. cb70cf4ad6 2007-10-13 aku: variable myimported 0 ; # Boolean flag. Set if and only if cb70cf4ad6 2007-10-13 aku: # rev 1.1 of the file seemingly cb70cf4ad6 2007-10-13 aku: # was imported instead of added cb70cf4ad6 2007-10-13 aku: # normally. cb70cf4ad6 2007-10-13 aku: variable myroot {} ; # Reference to the revision object cb70cf4ad6 2007-10-13 aku: # holding the root revision. Its cb70cf4ad6 2007-10-13 aku: # number usually is '1.1'. Can be cb70cf4ad6 2007-10-13 aku: # a different number, because of cb70cf4ad6 2007-10-13 aku: # gaps created via 'cvsadmin -o'. cb70cf4ad6 2007-10-13 aku: variable mybranches -array {} ; # Maps branch number to the symbol cb70cf4ad6 2007-10-13 aku: # object handling the branch. cb70cf4ad6 2007-10-13 aku: variable mytags -array {} ; # Maps revision number to the list cb70cf4ad6 2007-10-13 aku: # of symbol objects for the tags cb70cf4ad6 2007-10-13 aku: # associated with the revision. cb70cf4ad6 2007-10-13 aku: variable mysymbols {} ; # Set of the symbol names found in cb70cf4ad6 2007-10-13 aku: # this file. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mybranchcnt 0 ; # Counter for branches, to record their cb70cf4ad6 2007-10-13 aku: # order of definition. This also defines cb70cf4ad6 2007-10-13 aku: # their order of creation, which is the cb70cf4ad6 2007-10-13 aku: # reverse of definition. I.e. a smaller cb70cf4ad6 2007-10-13 aku: # number means 'Defined earlier', means cb70cf4ad6 2007-10-13 aku: # 'Created later'. cb70cf4ad6 2007-10-13 aku: e5441b908d 2007-10-15 aku: variable mytrunk {} ; # Direct reference to myproject -> trunk. 177a0cc55c 2007-10-17 aku: variable myroots {} ; # List of roots in the forest of 177a0cc55c 2007-10-17 aku: # lod's. Object references to revisions and 177a0cc55c 2007-10-17 aku: # branches. The latter can appear when they 177a0cc55c 2007-10-17 aku: # are severed from their parent. 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# 8a93ffa9c1 2007-10-06 aku: ## Internal methods 8a93ffa9c1 2007-10-06 aku: cb70cf4ad6 2007-10-13 aku: method RecordBranchCommits {branches} { bd131addb9 2007-10-12 aku: foreach branchrevnr $branches { bd131addb9 2007-10-12 aku: if {[catch { bd131addb9 2007-10-12 aku: set branch [$self Rev2Branch $branchrevnr] bd131addb9 2007-10-12 aku: }]} { bd131addb9 2007-10-12 aku: set branch [$self AddUnlabeledBranch [rev 2branchnr $branchrevnr]] bd131addb9 2007-10-12 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Record the commit, just as revision number for cb70cf4ad6 2007-10-13 aku: # now. ProcesBranchDependencies will extend that ito a cb70cf4ad6 2007-10-13 aku: # proper object reference. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: $branch setchildrevnr $branchrevnr bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method Rev2Branch {revnr} { 47d52d1efd 2007-11-28 aku: integrity assert {![rev istrunkrevnr $revnr]} {Expected a branch revision number} bd131addb9 2007-10-12 aku: return $mybranches([rev 2branchnr $revnr]) bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method AddUnlabeledBranch {branchnr} { bd131addb9 2007-10-12 aku: return [$self AddBranch unlabeled-$branchnr $branchnr] bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method AddBranch {name branchnr} { bd131addb9 2007-10-12 aku: if {[info exists mybranches($branchnr)]} { bd131addb9 2007-10-12 aku: log write 1 file "In '$mypath': Branch '$branchnr' named '[$mybranches($branchnr) name]'" bd131addb9 2007-10-12 aku: log write 1 file "Cannot have second name '$name', ignoring it" bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } adf168e23e 2007-10-24 aku: set branch [sym %AUTO% branch $branchnr [$myproject getsymbol $name] $self] cb70cf4ad6 2007-10-13 aku: $branch setposition [incr mybranchcnt] bd131addb9 2007-10-12 aku: set mybranches($branchnr) $branch bd131addb9 2007-10-12 aku: return $branch bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method AddTag {name revnr} { adf168e23e 2007-10-24 aku: set tag [sym %AUTO% tag $revnr [$myproject getsymbol $name] $self] bd131addb9 2007-10-12 aku: lappend mytags($revnr) $tag bd131addb9 2007-10-12 aku: return $tag bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: b5b2d61527 2007-10-17 aku: method RecordBasicDependencies {revnr next} { bd131addb9 2007-10-12 aku: # Handle the revision dependencies. Record them for now, do bd131addb9 2007-10-12 aku: # nothing with them yet. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # On the trunk the 'next' field points to the previous bd131addb9 2007-10-12 aku: # revision, i.e. the _parent_ of the current one. Example: bd131addb9 2007-10-12 aku: # 1.6's next is 1.5 (modulo cvs admin -o). bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # Contrarily on a branch the 'next' field points to the bd131addb9 2007-10-12 aku: # primary _child_ of the current revision. As example, bd131addb9 2007-10-12 aku: # 1.1.3.2's 'next' will be 1.1.3.3. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # The 'next' field actually always refers to the revision bd131addb9 2007-10-12 aku: # containing the delta needed to retrieve that revision. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # The dependencies needed here are the logical structure, bd131addb9 2007-10-12 aku: # parent/child, and not the implementation dependent delta bd131addb9 2007-10-12 aku: # pointers. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {$next eq ""} return bd131addb9 2007-10-12 aku: # parent -> child bd131addb9 2007-10-12 aku: if {[rev istrunkrevnr $revnr]} { bd131addb9 2007-10-12 aku: lappend mydependencies $next $revnr bd131addb9 2007-10-12 aku: } else { bd131addb9 2007-10-12 aku: lappend mydependencies $revnr $next bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: b5b2d61527 2007-10-17 aku: method ProcessPrimaryDependencies {} { cb70cf4ad6 2007-10-13 aku: foreach {parentrevnr childrevnr} $mydependencies { cb70cf4ad6 2007-10-13 aku: set parent $myrev($parentrevnr) cb70cf4ad6 2007-10-13 aku: set child $myrev($childrevnr) cb70cf4ad6 2007-10-13 aku: $parent setchild $child cb70cf4ad6 2007-10-13 aku: $child setparent $parent cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: b5b2d61527 2007-10-17 aku: method ProcessBranchDependencies {} { cb70cf4ad6 2007-10-13 aku: foreach {branchnr branch} [array get mybranches] { cb70cf4ad6 2007-10-13 aku: set revnr [$branch parentrevnr] cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: if {![info exists myrev($revnr)]} { cb70cf4ad6 2007-10-13 aku: log write 1 file "In '$mypath': The branch '[$branch name]' references" cb70cf4ad6 2007-10-13 aku: log write 1 file "the bogus revision '$revnr' and will be ignored." cb70cf4ad6 2007-10-13 aku: $branch destroy cb70cf4ad6 2007-10-13 aku: unset mybranches($branchnr) cb70cf4ad6 2007-10-13 aku: } else { cb70cf4ad6 2007-10-13 aku: set rev $myrev($revnr) cb70cf4ad6 2007-10-13 aku: $rev addbranch $branch e5441b908d 2007-10-15 aku: $branch setparent $rev cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # If revisions were committed on the branch we store a cb70cf4ad6 2007-10-13 aku: # reference to the branch there, and further declare cb70cf4ad6 2007-10-13 aku: # the first child's parent to be branch's parent, and cb70cf4ad6 2007-10-13 aku: # list this child in the parent revision. cb70cf4ad6 2007-10-13 aku: adf168e23e 2007-10-24 aku: if {[$branch haschildrev]} { cb70cf4ad6 2007-10-13 aku: set childrevnr [$branch childrevnr] cb70cf4ad6 2007-10-13 aku: set child $myrev($childrevnr) 177a0cc55c 2007-10-17 aku: $branch setchild $child cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: $child setparentbranch $branch cb70cf4ad6 2007-10-13 aku: $child setparent $rev cb70cf4ad6 2007-10-13 aku: $rev addchildonbranch $child cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: b5b2d61527 2007-10-17 aku: method SortBranches {} { b5b2d61527 2007-10-17 aku: foreach {revnr rev} [array get myrev] { $rev sortbranches } b5b2d61527 2007-10-17 aku: return b5b2d61527 2007-10-17 aku: } b5b2d61527 2007-10-17 aku: b5b2d61527 2007-10-17 aku: method ProcessTagDependencies {} { cb70cf4ad6 2007-10-13 aku: foreach {revnr taglist} [array get mytags] { cb70cf4ad6 2007-10-13 aku: if {![info exists myrev($revnr)]} { cb70cf4ad6 2007-10-13 aku: set n [llength $taglist] cb70cf4ad6 2007-10-13 aku: log write 1 file "In '$mypath': The following [nsp $n tag] reference" cb70cf4ad6 2007-10-13 aku: log write 1 file "the bogus revision '$revnr' and will be ignored." cb70cf4ad6 2007-10-13 aku: foreach tag $taglist { cb70cf4ad6 2007-10-13 aku: log write 1 file " [$tag name]" cb70cf4ad6 2007-10-13 aku: $tag destroy cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: unset mytags($revnr) cb70cf4ad6 2007-10-13 aku: } else { cb70cf4ad6 2007-10-13 aku: set rev $myrev($revnr) e5441b908d 2007-10-15 aku: foreach tag $taglist { 3a00ac5aa2 2007-10-23 aku: $rev addtag $tag e5441b908d 2007-10-15 aku: $tag settagrev $rev e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: b5b2d61527 2007-10-17 aku: method DetermineTheRootRevision {} { cb70cf4ad6 2007-10-13 aku: # The root is the one revision which has no parent. By cb70cf4ad6 2007-10-13 aku: # checking all revisions we ensure that we can detect and cb70cf4ad6 2007-10-13 aku: # report the case of multiple roots. Without that we could cb70cf4ad6 2007-10-13 aku: # simply take one revision and follow the parent links to cb70cf4ad6 2007-10-13 aku: # their root (sic!). cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: foreach {revnr rev} [array get myrev] { cb70cf4ad6 2007-10-13 aku: if {[$rev hasparent]} continue 47d52d1efd 2007-11-28 aku: integrity assert {$myroot eq ""} {Multiple root revisions found} cb70cf4ad6 2007-10-13 aku: set myroot $rev cb70cf4ad6 2007-10-13 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # In the future we also need a list, as branches can become 177a0cc55c 2007-10-17 aku: # severed from their parent, making them their own root. 177a0cc55c 2007-10-17 aku: set myroots [list $myroot] e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: b5b2d61527 2007-10-17 aku: method DetermineRevisionOperations {} { e5441b908d 2007-10-15 aku: foreach rev $myrevisions { $rev determineoperation } e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: b5b2d61527 2007-10-17 aku: method DetermineLinesOfDevelopment {} { e5441b908d 2007-10-15 aku: # For revisions this has been done already, in 'extend'. Now e5441b908d 2007-10-15 aku: # we do this for the branches and tags. e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: foreach {_ branch} [array get mybranches] { b5b2d61527 2007-10-17 aku: $branch setlod [$self GetLOD [$branch parentrevnr]] e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: foreach {_ taglist} [array get mytags] { e5441b908d 2007-10-15 aku: foreach tag $taglist { b5b2d61527 2007-10-17 aku: $tag setlod [$self GetLOD [$tag tagrevnr]] e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: b5b2d61527 2007-10-17 aku: method GetLOD {revnr} { b5b2d61527 2007-10-17 aku: if {[rev istrunkrevnr $revnr]} { e5441b908d 2007-10-15 aku: return $mytrunk e5441b908d 2007-10-15 aku: } else { e5441b908d 2007-10-15 aku: return [$self Rev2Branch $revnr] e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: b5b2d61527 2007-10-17 aku: method HandleNonTrunkDefaultBranch {} { b5b2d61527 2007-10-17 aku: set revlist [$self NonTrunkDefaultRevisions] 177a0cc55c 2007-10-17 aku: if {![llength $revlist]} return 177a0cc55c 2007-10-17 aku: b5b2d61527 2007-10-17 aku: $self AdjustNonTrunkDefaultBranch $revlist b5b2d61527 2007-10-17 aku: $self CheckLODs 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: b5b2d61527 2007-10-17 aku: method NonTrunkDefaultRevisions {} { 177a0cc55c 2007-10-17 aku: # From cvs2svn the following explanation (with modifications 177a0cc55c 2007-10-17 aku: # for our algorithm): 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Determine whether there are any non-trunk default branch 177a0cc55c 2007-10-17 aku: # revisions. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # If a non-trunk default branch is determined to have existed, 177a0cc55c 2007-10-17 aku: # return a list of objects for all revisions that were once 177a0cc55c 2007-10-17 aku: # non-trunk default revisions, in dependency order (i.e. root 177a0cc55c 2007-10-17 aku: # first). 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # There are two cases to handle: 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # One case is simple. The RCS file lists a default branch 177a0cc55c 2007-10-17 aku: # explicitly in its header, such as '1.1.1'. In this case, we 177a0cc55c 2007-10-17 aku: # know that every revision on the vendor branch is to be 177a0cc55c 2007-10-17 aku: # treated as head of trunk at that point in time. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # But there's also a degenerate case. The RCS file does not 177a0cc55c 2007-10-17 aku: # currently have a default branch, yet we can deduce that for 177a0cc55c 2007-10-17 aku: # some period in the past it probably *did* have one. For 177a0cc55c 2007-10-17 aku: # example, the file has vendor revisions 1.1.1.1 -> 1.1.1.96, 177a0cc55c 2007-10-17 aku: # all of which are dated before 1.2, and then it has 1.1.1.97 177a0cc55c 2007-10-17 aku: # -> 1.1.1.100 dated after 1.2. In this case, we should 177a0cc55c 2007-10-17 aku: # record 1.1.1.96 as the last vendor revision to have been the 177a0cc55c 2007-10-17 aku: # head of the default branch. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: if {$myprincipal ne ""} { 177a0cc55c 2007-10-17 aku: # There is still a default branch; that means that all 177a0cc55c 2007-10-17 aku: # revisions on that branch get marked. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: log write 5 file "Found explicitly marked NTDB" 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set rnext [$myroot child] 177a0cc55c 2007-10-17 aku: if {$rnext ne ""} { 177a0cc55c 2007-10-17 aku: trouble fatal "File with default branch $myprincipal also has revision [$rnext revnr]" 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set rev [$mybranches($myprincipal) child] 177a0cc55c 2007-10-17 aku: set res {} 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: while {$rev ne ""} { 177a0cc55c 2007-10-17 aku: lappend res $rev 177a0cc55c 2007-10-17 aku: set rev [$rev child] 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: return $res 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: } elseif {$myimported} { 177a0cc55c 2007-10-17 aku: # No default branch, but the file appears to have been 177a0cc55c 2007-10-17 aku: # imported. So our educated guess is that all revisions 177a0cc55c 2007-10-17 aku: # on the '1.1.1' branch with timestamps prior to the 177a0cc55c 2007-10-17 aku: # timestamp of '1.2' were non-trunk default branch 177a0cc55c 2007-10-17 aku: # revisions. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # This really only processes standard '1.1.1.*'-style 177a0cc55c 2007-10-17 aku: # vendor revisions. One could conceivably have a file 177a0cc55c 2007-10-17 aku: # whose default branch is 1.1.3 or whatever, or was that 177a0cc55c 2007-10-17 aku: # at some point in time, with vendor revisions 1.1.3.1, 177a0cc55c 2007-10-17 aku: # 1.1.3.2, etc. But with the default branch gone now, 177a0cc55c 2007-10-17 aku: # we'd have no basis for assuming that the non-standard 177a0cc55c 2007-10-17 aku: # vendor branch had ever been the default branch anyway. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Note that we rely on comparisons between the timestamps 177a0cc55c 2007-10-17 aku: # of the revisions on the vendor branch and that of 177a0cc55c 2007-10-17 aku: # revision 1.2, even though the timestamps might be 177a0cc55c 2007-10-17 aku: # incorrect due to clock skew. We could do a slightly 177a0cc55c 2007-10-17 aku: # better job if we used the changeset timestamps, as it is 177a0cc55c 2007-10-17 aku: # possible that the dependencies that went into 177a0cc55c 2007-10-17 aku: # determining those timestamps are more accurate. But 177a0cc55c 2007-10-17 aku: # that would require an extra pass or two. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: if {![info exists mybranches(1.1.1)]} { return {} } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: log write 5 file "Deduced existence of NTDB" 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set rev [$mybranches(1.1.1) child] 177a0cc55c 2007-10-17 aku: set res {} 177a0cc55c 2007-10-17 aku: set stop [$myroot child] 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: if {$stop eq ""} { 177a0cc55c 2007-10-17 aku: # Get everything on the branch 177a0cc55c 2007-10-17 aku: while {$rev ne ""} { 177a0cc55c 2007-10-17 aku: lappend res $rev 177a0cc55c 2007-10-17 aku: set rev [$rev child] 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: } else { 177a0cc55c 2007-10-17 aku: # Collect everything on the branch which seems to have 177a0cc55c 2007-10-17 aku: # been committed before the first primary child of the 177a0cc55c 2007-10-17 aku: # root revision. 177a0cc55c 2007-10-17 aku: set stopdate [$stop date] 177a0cc55c 2007-10-17 aku: while {$rev ne ""} { 177a0cc55c 2007-10-17 aku: if {[$rev date] >= $stopdate} break 177a0cc55c 2007-10-17 aku: lappend res $rev 177a0cc55c 2007-10-17 aku: set rev [$rev child] 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: return $res 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: } else { 177a0cc55c 2007-10-17 aku: return {} 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: a766b08198 2007-10-23 aku: # General note: In the following methods we only modify the links a766b08198 2007-10-23 aku: # between revisions and symbols to restructure the revision a766b08198 2007-10-23 aku: # tree. We do __not__ destroy the objects. Given the complex links a766b08198 2007-10-23 aku: # GC is difficult at this level. It is much easier to drop a766b08198 2007-10-23 aku: # everything when we we are done. This happens in 'drop', using a766b08198 2007-10-23 aku: # the state variable 'myrev', 'mybranches', and 'mytags'. What we a766b08198 2007-10-23 aku: # have to persist, performed by 'persist', we know will be a766b08198 2007-10-23 aku: # reachable through the revisions listed in 'myroots' and their a766b08198 2007-10-23 aku: # children and symbols. a766b08198 2007-10-23 aku: b5b2d61527 2007-10-17 aku: method AdjustNonTrunkDefaultBranch {revlist} { 177a0cc55c 2007-10-17 aku: set stop [$myroot child] ;# rev '1.2' 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: log write 5 file "Adjusting NTDB containing [nsp [llength $revlist] revision]" 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # From cvs2svn the following explanation (with modifications 177a0cc55c 2007-10-17 aku: # for our algorithm): 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Adjust the non-trunk default branch revisions found in the 177a0cc55c 2007-10-17 aku: # 'revlist'. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # 'myimported' is a boolean flag indicating whether this file 177a0cc55c 2007-10-17 aku: # appears to have been imported, which also means that 177a0cc55c 2007-10-17 aku: # revision 1.1 has a generated log message that need not be 177a0cc55c 2007-10-17 aku: # preserved. 'revlist' is a list of object references for the 177a0cc55c 2007-10-17 aku: # revisions that have been determined to be non-trunk default 177a0cc55c 2007-10-17 aku: # branch revisions. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Note that the first revision on the default branch is 177a0cc55c 2007-10-17 aku: # handled strangely by CVS. If a file is imported (as opposed 177a0cc55c 2007-10-17 aku: # to being added), CVS creates a 1.1 revision, then creates a 177a0cc55c 2007-10-17 aku: # vendor branch 1.1.1 based on 1.1, then creates a 1.1.1.1 177a0cc55c 2007-10-17 aku: # revision that is identical to the 1.1 revision (i.e., its 177a0cc55c 2007-10-17 aku: # deltatext is empty). The log message that the user typed 177a0cc55c 2007-10-17 aku: # when importing is stored with the 1.1.1.1 revision. The 1.1 177a0cc55c 2007-10-17 aku: # revision always contains a standard, generated log message, 177a0cc55c 2007-10-17 aku: # 'Initial revision\n'. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # When we detect a straightforward import like this, we want 177a0cc55c 2007-10-17 aku: # to handle it by deleting the 1.1 revision (which doesn't 177a0cc55c 2007-10-17 aku: # contain any useful information) and making 1.1.1.1 into an 177a0cc55c 2007-10-17 aku: # independent root in the file's dependency tree. In SVN, 177a0cc55c 2007-10-17 aku: # 1.1.1.1 will be added directly to the vendor branch with its 177a0cc55c 2007-10-17 aku: # initial content. Then in a special 'post-commit', the 177a0cc55c 2007-10-17 aku: # 1.1.1.1 revision is copied back to trunk. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # If the user imports again to the same vendor branch, then CVS 177a0cc55c 2007-10-17 aku: # creates revisions 1.1.1.2, 1.1.1.3, etc. on the vendor branch, 177a0cc55c 2007-10-17 aku: # *without* counterparts in trunk (even though these revisions 177a0cc55c 2007-10-17 aku: # effectively play the role of trunk revisions). So after we add 177a0cc55c 2007-10-17 aku: # such revisions to the vendor branch, we also copy them back to 177a0cc55c 2007-10-17 aku: # trunk in post-commits. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # We mark the revisions found in 'revlist' as default branch 177a0cc55c 2007-10-17 aku: # revisions. Also, if the root revision has a primary child 177a0cc55c 2007-10-17 aku: # we set that revision to depend on the last non-trunk default 177a0cc55c 2007-10-17 aku: # branch revision and possibly adjust its type accordingly. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set first [lindex $revlist 0] 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: log write 6 file "<[$first revnr]> [expr {$myimported ? "imported" : "not imported"}], [$first operation], [expr {[$first hastext] ? "has text" : "no text"}]" 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: if {$myimported && 177a0cc55c 2007-10-17 aku: [$first revnr] eq "1.1.1.1" && 177a0cc55c 2007-10-17 aku: [$first operation] eq "change" && 177a0cc55c 2007-10-17 aku: ![$first hastext]} { 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set rev11 [$first parent] ; # Assert: Should be myroot. 177a0cc55c 2007-10-17 aku: log write 3 file "Removing irrelevant revision [$rev11 revnr]" 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Cut out the old myroot revision. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: ldelete myroots $rev11 ; # Not a root any longer. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: $first cutfromparent ; # Sever revision from parent revision. 177a0cc55c 2007-10-17 aku: if {$stop ne ""} { 177a0cc55c 2007-10-17 aku: $stop cutfromparent 177a0cc55c 2007-10-17 aku: lappend myroots $stop ; # New root, after vendor branch 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Cut out the vendor branch symbol 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set vendor [$first parentbranch] 47d52d1efd 2007-11-28 aku: integrity assert {$vendor ne ""} {First NTDB revision has no branch} a766b08198 2007-10-23 aku: if {[$vendor parent] eq $rev11} { 177a0cc55c 2007-10-17 aku: $rev11 removebranch $vendor 177a0cc55c 2007-10-17 aku: $rev11 removechildonbranch $first adf168e23e 2007-10-24 aku: $vendor cutchild 177a0cc55c 2007-10-17 aku: $first cutfromparentbranch 177a0cc55c 2007-10-17 aku: lappend myroots $first 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Change the type of first (typically from Change to Add): 177a0cc55c 2007-10-17 aku: $first retype add 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Move any tags and branches from the old to the new root. 177a0cc55c 2007-10-17 aku: $rev11 movesymbolsto $first 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Mark all the special revisions as such 177a0cc55c 2007-10-17 aku: foreach rev $revlist { 177a0cc55c 2007-10-17 aku: log write 3 file "Revision on default branch: [$rev revnr]" 886b6f257b 2007-10-21 aku: $rev setondefaultbranch 1 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: if {$stop ne ""} { 177a0cc55c 2007-10-17 aku: # Revision 1.2 logically follows the imported revisions, 177a0cc55c 2007-10-17 aku: # not 1.1. Accordingly, connect it to the last NTDBR and 177a0cc55c 2007-10-17 aku: # possibly change its type. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set last [lindex $revlist end] 177a0cc55c 2007-10-17 aku: $stop setdefaultbranchparent $last ; # Retypes the revision too. 177a0cc55c 2007-10-17 aku: $last setdefaultbranchchild $stop 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: b5b2d61527 2007-10-17 aku: method CheckLODs {} { b5b2d61527 2007-10-17 aku: foreach {_ branch} [array get mybranches] { $branch checklod } 177a0cc55c 2007-10-17 aku: foreach {_ taglist} [array get mytags] { 177a0cc55c 2007-10-17 aku: foreach tag $taglist { $tag checklod } 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: b5b2d61527 2007-10-17 aku: method RemoveIrrelevantDeletions {} { 510cd02303 2007-10-19 aku: # From cvs2svn: If a file is added on a branch, then a trunk 510cd02303 2007-10-19 aku: # revision is added at the same time in the 'Dead' state. 510cd02303 2007-10-19 aku: # This revision doesn't do anything useful, so delete it. cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: foreach root $myroots { cfe4b269ac 2007-10-17 aku: if {[$root isneeded]} continue cfe4b269ac 2007-10-17 aku: log write 2 file "Removing unnecessary dead revision [$root revnr]" cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: # Remove as root, make its child new root after cfe4b269ac 2007-10-17 aku: # disconnecting it from the revision just going away. cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: ldelete myroots $root cfe4b269ac 2007-10-17 aku: if {[$root haschild]} { cfe4b269ac 2007-10-17 aku: set child [$root child] cfe4b269ac 2007-10-17 aku: $child cutfromparent cfe4b269ac 2007-10-17 aku: lappend myroots $child cfe4b269ac 2007-10-17 aku: } cfe4b269ac 2007-10-17 aku: adf168e23e 2007-10-24 aku: # Cut out the branches spawned by the revision to be cfe4b269ac 2007-10-17 aku: # deleted. If the branch has revisions they should already cfe4b269ac 2007-10-17 aku: # use operation 'add', no need to change that. The first cfe4b269ac 2007-10-17 aku: # revision on each branch becomes a new and disconnected cfe4b269ac 2007-10-17 aku: # root. cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: foreach branch [$root branches] { 79c227a9c0 2007-12-01 aku: $branch cutbranchparent cfe4b269ac 2007-10-17 aku: if {![$branch haschild]} continue cfe4b269ac 2007-10-17 aku: set first [$branch child] cfe4b269ac 2007-10-17 aku: $first cutfromparent cfe4b269ac 2007-10-17 aku: lappend myroots $first cfe4b269ac 2007-10-17 aku: } cfe4b269ac 2007-10-17 aku: $root removeallbranches cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: # Tagging a dead revision doesn't do anything, so remove cfe4b269ac 2007-10-17 aku: # any tags that were set on it. cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: $root removealltags cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: # This can only happen once per file, and we might have 510cd02303 2007-10-19 aku: # just changed myroots, so end the loop cfe4b269ac 2007-10-17 aku: break cfe4b269ac 2007-10-17 aku: } cfe4b269ac 2007-10-17 aku: return b5b2d61527 2007-10-17 aku: } b5b2d61527 2007-10-17 aku: b5b2d61527 2007-10-17 aku: method RemoveInitialBranchDeletions {} { 510cd02303 2007-10-19 aku: # From cvs2svn: If the first revision on a branch is an 510cd02303 2007-10-19 aku: # unnecessary delete, remove it. 510cd02303 2007-10-19 aku: # 510cd02303 2007-10-19 aku: # If a file is added on a branch (whether or not it already 510cd02303 2007-10-19 aku: # existed on trunk), then new versions of CVS add a first 510cd02303 2007-10-19 aku: # branch revision in the 'dead' state (to indicate that the 510cd02303 2007-10-19 aku: # file did not exist on the branch when the branch was 510cd02303 2007-10-19 aku: # created) followed by the second branch revision, which is an 510cd02303 2007-10-19 aku: # add. When we encounter this situation, we sever the branch 510cd02303 2007-10-19 aku: # from trunk and delete the first branch revision. 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: # At this point we may have already multiple roots in myroots, 510cd02303 2007-10-19 aku: # we have to process them all. 510cd02303 2007-10-19 aku: 886b6f257b 2007-10-21 aku: foreach root [$self LinesOfDevelopment] { 510cd02303 2007-10-19 aku: if {[$root isneededbranchdel]} continue 510cd02303 2007-10-19 aku: log write 2 file "Removing unnecessary initial branch delete [$root revnr]" 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: set branch [$root parentbranch] 510cd02303 2007-10-19 aku: set parent [$root parent] 510cd02303 2007-10-19 aku: set child [$root child] 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: ldelete myroots $root 510cd02303 2007-10-19 aku: lappend myroots $child 510cd02303 2007-10-19 aku: c4003e7b93 2007-12-05 aku: $branch cutbranchparent adf168e23e 2007-10-24 aku: $branch cutchild a766b08198 2007-10-23 aku: $child cutfromparent c4003e7b93 2007-12-05 aku: c4003e7b93 2007-12-05 aku: $branch setchild $child c4003e7b93 2007-12-05 aku: $child setparentbranch $branch adf168e23e 2007-10-24 aku: 510cd02303 2007-10-19 aku: $parent removebranch $branch a766b08198 2007-10-23 aku: $parent removechildonbranch $root 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: return 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: method LinesOfDevelopment {} { 510cd02303 2007-10-19 aku: # Determine all lines of development for the file. This are 510cd02303 2007-10-19 aku: # the known roots, and the root of all branches found on the 510cd02303 2007-10-19 aku: # line of primary children. 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: set lodroots {} 510cd02303 2007-10-19 aku: foreach root $myroots { 510cd02303 2007-10-19 aku: $self AddBranchedLinesOfDevelopment lodroots $root 510cd02303 2007-10-19 aku: lappend lodroots $root 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: return $lodroots 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: method AddBranchedLinesOfDevelopment {lv root} { 510cd02303 2007-10-19 aku: upvar 1 $lv lodroots 510cd02303 2007-10-19 aku: while {$root ne ""} { 510cd02303 2007-10-19 aku: foreach branch [$root branches] { 510cd02303 2007-10-19 aku: if {![$branch haschild]} continue 510cd02303 2007-10-19 aku: set child [$branch child] 510cd02303 2007-10-19 aku: # Recurse into the branch for deeper branches. 510cd02303 2007-10-19 aku: $self AddBranchedLinesOfDevelopment lodroots $child 510cd02303 2007-10-19 aku: lappend lodroots $child 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: set root [$root child] 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: return b5b2d61527 2007-10-17 aku: } b5b2d61527 2007-10-17 aku: b5b2d61527 2007-10-17 aku: method ExcludeNonTrunkInformation {} { 886b6f257b 2007-10-21 aku: # Remove all non-trunk branches, revisions, and tags. We do 886b6f257b 2007-10-21 aku: # keep the tags which are on the trunk. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: set ntdbroot "" 886b6f257b 2007-10-21 aku: foreach root [$self LinesOfDevelopment] { 886b6f257b 2007-10-21 aku: # Note: Here the order of the roots is important, 886b6f257b 2007-10-21 aku: # i.e. that we get them in depth first order. This ensures 886b6f257b 2007-10-21 aku: # that the removal of a branch happens only after the 886b6f257b 2007-10-21 aku: # branches spawned from it were removed. Otherwise the 886b6f257b 2007-10-21 aku: # system might try to access deleted objects. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # Do not exclude the trunk. 886b6f257b 2007-10-21 aku: if {[[$root lod] istrunk]} continue 886b6f257b 2007-10-21 aku: $self ExcludeBranch $root ntdbroot 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: if {$ntdbroot ne ""} { 886b6f257b 2007-10-21 aku: $self GraftNTDB2Trunk $ntdbroot 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: return 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: method ExcludeBranch {root nv} { 886b6f257b 2007-10-21 aku: # Exclude the branch/lod starting at root, a revision. 886b6f257b 2007-10-21 aku: # 886b6f257b 2007-10-21 aku: # If the LOD starts with non-trunk default branch revisions, 886b6f257b 2007-10-21 aku: # we leave them in place and do not delete the branch. In that 886b6f257b 2007-10-21 aku: # case the command sets the variable in NV so that we can 886b6f257b 2007-10-21 aku: # later rework these revisons to be purely trunk. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: if {[$root isondefaultbranch]} { 886b6f257b 2007-10-21 aku: # Handling a NTDB. This branch may consists not only of 886b6f257b 2007-10-21 aku: # NTDB revisions, but also some non-NTDB. The latter are 886b6f257b 2007-10-21 aku: # truly on a branch and have to be excluded. The following 886b6f257b 2007-10-21 aku: # loop determines if there are such revisions. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: upvar 1 $nv ntdbroot 886b6f257b 2007-10-21 aku: set ntdbroot $root e94b52b6f2 2007-10-23 aku: $root cutfromparentbranch e94b52b6f2 2007-10-23 aku: e94b52b6f2 2007-10-23 aku: set rev $root 886b6f257b 2007-10-21 aku: while {$rev ne ""} { 886b6f257b 2007-10-21 aku: $rev removeallbranches a766b08198 2007-10-23 aku: # See note [x]. a766b08198 2007-10-23 aku: 886b6f257b 2007-10-21 aku: if {[$rev isondefaultbranch]} { 886b6f257b 2007-10-21 aku: set rev [$rev child] 886b6f257b 2007-10-21 aku: } else { e94b52b6f2 2007-10-23 aku: break 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # rev now contains the first non-NTDB revision after the 886b6f257b 2007-10-21 aku: # NTDB, or is empty if there is no such. If we have some 886b6f257b 2007-10-21 aku: # they have to removed. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: if {$rev ne ""} { 886b6f257b 2007-10-21 aku: set lastntdb [$rev parent] 886b6f257b 2007-10-21 aku: $lastntdb cutfromchild 886b6f257b 2007-10-21 aku: while {$rev ne ""} { 886b6f257b 2007-10-21 aku: $rev removealltags a766b08198 2007-10-23 aku: $rev removeallbranches 886b6f257b 2007-10-21 aku: # Note [x]: We may still have had branches on the 886b6f257b 2007-10-21 aku: # revision. Branches without revisions committed 886b6f257b 2007-10-21 aku: # on them do not show up in the list of roots aka a766b08198 2007-10-23 aku: # lines of development. a766b08198 2007-10-23 aku: set rev [$rev child] 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: return 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # No NTDB stuff to deal with. First delete the branch object 886b6f257b 2007-10-21 aku: # itself, after cutting all the various connections. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: set branch [$root parentbranch] 886b6f257b 2007-10-21 aku: if {$branch ne ""} { a766b08198 2007-10-23 aku: set branchparent [$branch parent] a766b08198 2007-10-23 aku: $branchparent removebranch $branch a766b08198 2007-10-23 aku: $branchparent removechildonbranch $root 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # The root is no such any longer either. 886b6f257b 2007-10-21 aku: ldelete myroots $root 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # Now go through the line and remove all its revisions. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: while {$root ne ""} { 886b6f257b 2007-10-21 aku: $root removealltags 886b6f257b 2007-10-21 aku: $root removeallbranches a766b08198 2007-10-23 aku: # Note: See the note [x]. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # From cvs2svn: If this is the last default revision on a 886b6f257b 2007-10-21 aku: # non-trunk default branch followed by a 1.2 revision, 886b6f257b 2007-10-21 aku: # then the 1.2 revision depends on this one. FIXME: It is 886b6f257b 2007-10-21 aku: # questionable whether this handling is correct, since the 886b6f257b 2007-10-21 aku: # non-trunk default branch revisions affect trunk and 886b6f257b 2007-10-21 aku: # should therefore not just be discarded even if 886b6f257b 2007-10-21 aku: # --trunk-only. 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: if {[$root hasdefaultbranchchild]} { 886b6f257b 2007-10-21 aku: set ntdbchild [$root defaultbranchchild] 47d52d1efd 2007-11-28 aku: integrity assert { 47d52d1efd 2007-11-28 aku: [$ntdbchild defaultbranchparent] eq $ntdbchild 47d52d1efd 2007-11-28 aku: } {ntdb - trunk linkage broken} 886b6f257b 2007-10-21 aku: $ntdbchild cutdefaultbranchparent 886b6f257b 2007-10-21 aku: if {[$ntdbchild hasparent]} { 886b6f257b 2007-10-21 aku: lappend myroots [$ntdbchild parent] 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: a766b08198 2007-10-23 aku: set root [$root child] 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: return 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: method GraftNTDB2Trunk {root} { 886b6f257b 2007-10-21 aku: # We can now graft the non-trunk default branch revisions to 886b6f257b 2007-10-21 aku: # trunk. They should already be alone on a CVSBranch-less 886b6f257b 2007-10-21 aku: # branch. 886b6f257b 2007-10-21 aku: 47d52d1efd 2007-11-28 aku: integrity assert {![$root hasparentbranch]} {NTDB root still has its branch symbol} 47d52d1efd 2007-11-28 aku: integrity assert {![$root hasbranches]} {NTDB root still has spawned branches} 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: set last $root 886b6f257b 2007-10-21 aku: while {[$last haschild]} {set last [$last child]} 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: if {[$last hasdefaultbranchchild]} { 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: set rev12 [$last defaultbranchchild] 886b6f257b 2007-10-21 aku: $rev12 cutdefaultbranchparent 886b6f257b 2007-10-21 aku: $last cutdefaultbranchchild 886b6f257b 2007-10-21 aku: 436f17a5f0 2007-10-21 aku: $rev12 changeparent $last 436f17a5f0 2007-10-21 aku: $last changechild $rev12 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: ldelete myroots $rev12 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: # Note and remember that the type of rev12 was already 886b6f257b 2007-10-21 aku: # adjusted by AdjustNonTrunkDefaultBranch, so we don't 886b6f257b 2007-10-21 aku: # have to change its type here. 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: while {$root ne ""} { 886b6f257b 2007-10-21 aku: $root setondefaultbranch 0 886b6f257b 2007-10-21 aku: $root setlod $mytrunk 886b6f257b 2007-10-21 aku: foreach tag [$root tags] { 886b6f257b 2007-10-21 aku: $tag setlod $mytrunk 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: set root [$root child] 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: adf168e23e 2007-10-24 aku: method Active {} { adf168e23e 2007-10-24 aku: set revisions {} adf168e23e 2007-10-24 aku: set symbols {} adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: foreach root [$self LinesOfDevelopment] { adf168e23e 2007-10-24 aku: if {[$root hasparentbranch]} { lappend symbols [$root parentbranch] } adf168e23e 2007-10-24 aku: while {$root ne ""} { adf168e23e 2007-10-24 aku: lappend revisions $root adf168e23e 2007-10-24 aku: foreach tag [$root tags] { lappend symbols $tag } c4003e7b93 2007-12-05 aku: foreach branch [$root branches] { c4003e7b93 2007-12-05 aku: integrity assert { c4003e7b93 2007-12-05 aku: [$branch parent] eq $root c4003e7b93 2007-12-05 aku: } {Backreference branch to its root is missing or wrong} c4003e7b93 2007-12-05 aku: lappend symbols $branch c4003e7b93 2007-12-05 aku: } adf168e23e 2007-10-24 aku: set lod [$root lod] c4003e7b93 2007-12-05 aku: if {![$lod istrunk]} { c4003e7b93 2007-12-05 aku: integrity assert { c4003e7b93 2007-12-05 aku: [$lod haschild] c4003e7b93 2007-12-05 aku: } {Branch is LOD symbol without revisions} c4003e7b93 2007-12-05 aku: lappend symbols $lod c4003e7b93 2007-12-05 aku: } adf168e23e 2007-10-24 aku: set root [$root child] adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: return [list [lsort -unique -dict $revisions] [lsort -unique -dict $symbols]] 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: method AggregateSymbolData {} { 6f8667b03e 2007-10-31 aku: # Now that the exact set of revisions (and through that 6f8667b03e 2007-10-31 aku: # branches and tags) is known we can update the aggregate 6f8667b03e 2007-10-31 aku: # symbol statistics. 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: foreach root [$self LinesOfDevelopment] { 6f8667b03e 2007-10-31 aku: set lod [$root lod] 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: # Note: If the LOD is the trunk the count*, etc. methods 6f8667b03e 2007-10-31 aku: # will do nothing, as it is always present (cannot be 6f8667b03e 2007-10-31 aku: # excluded), and is always a branch too. 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: # Lines of development count as branches and have a commit 6f8667b03e 2007-10-31 aku: # on them (root). If they are still attached to a tree we 6f8667b03e 2007-10-31 aku: # have to compute and register possible parents. 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: $lod countasbranch 6f8667b03e 2007-10-31 aku: $lod countacommit 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: if {[$root hasparentbranch]} { 6f8667b03e 2007-10-31 aku: # Note lod == [$root parentbranch] 6f8667b03e 2007-10-31 aku: $lod possibleparents 930ec162ce 2007-11-22 aku: } elseif {![$lod istrunk] && [$root isondefaultbranch]} { 930ec162ce 2007-11-22 aku: # This is the root revision of a detached NTDB. We 930ec162ce 2007-11-22 aku: # have to manually set the only possible parent for 930ec162ce 2007-11-22 aku: # this LOD, the trunk itself. 930ec162ce 2007-11-22 aku: 930ec162ce 2007-11-22 aku: [$lod symbol] possibleparent $mytrunk 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: # For the revisions in the line we register their branches 6f8667b03e 2007-10-31 aku: # and tags as blockers for the lod, and update the type 6f8667b03e 2007-10-31 aku: # counters as well. As branch symbols without commits on 6f8667b03e 2007-10-31 aku: # them are not listed as lines of development, we have to 6f8667b03e 2007-10-31 aku: # count them here as well, as plain branches. At last we 6f8667b03e 2007-10-31 aku: # have to compute and register the possible parents of the 6f8667b03e 2007-10-31 aku: # tags, in case they are later converted as branches. 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: while {$root ne ""} { 6f8667b03e 2007-10-31 aku: foreach branch [$root branches] { 6f8667b03e 2007-10-31 aku: $lod blockedby $branch 6f8667b03e 2007-10-31 aku: $branch possibleparents 6f8667b03e 2007-10-31 aku: if {[$branch haschild]} continue 6f8667b03e 2007-10-31 aku: $branch countasbranch 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: foreach tag [$root tags] { 6f8667b03e 2007-10-31 aku: $lod blockedby $tag 6f8667b03e 2007-10-31 aku: $tag possibleparents 6f8667b03e 2007-10-31 aku: $tag countastag 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: set root [$root child] 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # # ## ### ##### ######## ############# bd131addb9 2007-10-12 aku: ## Configuration bd131addb9 2007-10-12 aku: 8a93ffa9c1 2007-10-06 aku: pragma -hastypeinfo no ; # no type introspection 8a93ffa9c1 2007-10-06 aku: pragma -hasinfo no ; # no object introspection 8a93ffa9c1 2007-10-06 aku: pragma -hastypemethods no ; # type is not relevant. 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# 8a93ffa9c1 2007-10-06 aku: } 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: namespace eval ::vc::fossil::import::cvs { 8a93ffa9c1 2007-10-06 aku: namespace export file 3d88cfd05d 2007-10-06 aku: namespace eval file { bd131addb9 2007-10-12 aku: # Import not required, already a child namespace. cb70cf4ad6 2007-10-13 aku: # namespace import ::vc::fossil::import::cvs::file::rev cb70cf4ad6 2007-10-13 aku: # namespace import ::vc::fossil::import::cvs::file::sym cb70cf4ad6 2007-10-13 aku: namespace import ::vc::tools::misc::* cb70cf4ad6 2007-10-13 aku: namespace import ::vc::tools::trouble 177a0cc55c 2007-10-17 aku: namespace import ::vc::tools::log adf168e23e 2007-10-24 aku: namespace import ::vc::fossil::import::cvs::state 47d52d1efd 2007-11-28 aku: namespace import ::vc::fossil::import::cvs::integrity e100314ec2 2007-12-05 aku: namespace import ::vc::fossil::import::cvs::gtcore 3d88cfd05d 2007-10-06 aku: } 8a93ffa9c1 2007-10-06 aku: } 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# ##################### 8a93ffa9c1 2007-10-06 aku: ## Ready 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: package provide vc::fossil::import::cvs::file 1.0 8a93ffa9c1 2007-10-06 aku: return
File Annotation