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. 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. 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: cfe4b269ac 2007-10-17 aku: constructor {path usrpath executable project} { 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] bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: 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 {} { 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: 3a00ac5aa2 2007-10-23 aku: method drop {} { 67c24820c7 2007-10-14 aku: } 67c24820c7 2007-10-14 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 e5441b908d 2007-10-15 aku: # and linking them into the trunk. e5441b908d 2007-10-15 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 177a0cc55c 2007-10-17 aku: } 3d88cfd05d 2007-10-06 aku: return 3d88cfd05d 2007-10-06 aku: } 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# 8a93ffa9c1 2007-10-06 aku: ## State 8a93ffa9c1 2007-10-06 aku: 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} { bd131addb9 2007-10-12 aku: if {[rev istrunkrevnr $revnr]} { bd131addb9 2007-10-12 aku: trouble internal "Expected a branch revision number" bd131addb9 2007-10-12 aku: } 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: } da9295c6f6 2007-10-12 aku: set branch [sym %AUTO% branch $branchnr [$myproject getsymbol $name]] 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} { da9295c6f6 2007-10-12 aku: set tag [sym %AUTO% tag $revnr [$myproject getsymbol $name]] 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: cb70cf4ad6 2007-10-13 aku: if {[$branch haschild]} { 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: } 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 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 cb70cf4ad6 2007-10-13 aku: if {$myroot ne ""} { trouble internal "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: 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: unset myrev([$rev11 revnr]) 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] 177a0cc55c 2007-10-17 aku: if {$vendor eq ""} { trouble internal "First NTDB revision has no branch" } 177a0cc55c 2007-10-17 aku: if {[$vendor parent] eq $rev11} { 177a0cc55c 2007-10-17 aku: unset mybranches([$vendor branchnr]) 177a0cc55c 2007-10-17 aku: $rev11 removebranch $vendor 177a0cc55c 2007-10-17 aku: $rev11 removechildonbranch $first 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 436f17a5f0 2007-10-21 aku: $rev11 destroy 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: cfe4b269ac 2007-10-17 aku: # Remove 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] { cfe4b269ac 2007-10-17 aku: if {![$branch haschild]} continue cfe4b269ac 2007-10-17 aku: set first [$branch child] cfe4b269ac 2007-10-17 aku: $first cutfromparentbranch 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: unset myrev([$root revnr]) 510cd02303 2007-10-19 aku: $child cutfromparent 510cd02303 2007-10-19 aku: lappend myroots $child 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: $parent removechildonbranch $root 510cd02303 2007-10-19 aku: $parent removebranch $branch 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: $branch destroy 510cd02303 2007-10-19 aku: $root destroy 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 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 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 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: set rev [$root child] 886b6f257b 2007-10-21 aku: while {$rev ne ""} { 886b6f257b 2007-10-21 aku: # See note [x]. 886b6f257b 2007-10-21 aku: $rev removeallbranches 886b6f257b 2007-10-21 aku: if {[$rev isondefaultbranch]} { 886b6f257b 2007-10-21 aku: set rev [$rev child] 886b6f257b 2007-10-21 aku: } else { 886b6f257b 2007-10-21 aku: set rev "" 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: set next [$rev child] 886b6f257b 2007-10-21 aku: unset myrev([$rev revnr]) 886b6f257b 2007-10-21 aku: $rev removealltags 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 886b6f257b 2007-10-21 aku: # lines of development). 886b6f257b 2007-10-21 aku: $root removeallbranches 886b6f257b 2007-10-21 aku: $rev destroy 886b6f257b 2007-10-21 aku: set rev $next 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 ""} { 886b6f257b 2007-10-21 aku: set bparentrev [$branch parent] 886b6f257b 2007-10-21 aku: $bparentrev removebranch $branch 886b6f257b 2007-10-21 aku: $bparentrev removechildonbranch $root 886b6f257b 2007-10-21 aku: $branch destroy 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: set next [$root child] 886b6f257b 2007-10-21 aku: unset myrev([$root revnr]) 886b6f257b 2007-10-21 aku: $root removealltags 886b6f257b 2007-10-21 aku: # Note: See the note [x]. 886b6f257b 2007-10-21 aku: $root removeallbranches 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] 886b6f257b 2007-10-21 aku: if {[$ntdbchild defaultbranchparent] ne $ntdbchild} { 886b6f257b 2007-10-21 aku: trouble internal "ntdb - trunk linkage broken" 886b6f257b 2007-10-21 aku: } 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: 886b6f257b 2007-10-21 aku: $root destroy 886b6f257b 2007-10-21 aku: set root $next 886b6f257b 2007-10-21 aku: } 886b6f257b 2007-10-21 aku: cb70cf4ad6 2007-10-13 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 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: 886b6f257b 2007-10-21 aku: if {[$root hasparentbranch]} { trouble internal "NTDB root still has its branch symbol" } 886b6f257b 2007-10-21 aku: if {[$root hasbranches]} { trouble internal "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 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 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