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. 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: 8a93ffa9c1 2007-10-06 aku: constructor {path project} { 8a93ffa9c1 2007-10-06 aku: set mypath $path 8a93ffa9c1 2007-10-06 aku: set myproject $project 8a93ffa9c1 2007-10-06 aku: return 8a93ffa9c1 2007-10-06 aku: } 8a93ffa9c1 2007-10-06 aku: bd131addb9 2007-10-12 aku: method path {} { return $mypath } bd131addb9 2007-10-12 aku: method project {} { return $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"} 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: 6d1811d61e 2007-10-06 aku: # # ## ### ##### ######## ############# 3d88cfd05d 2007-10-06 aku: ## Implement the sink 3d88cfd05d 2007-10-06 aku: bd131addb9 2007-10-12 aku: method begin {} {} bd131addb9 2007-10-12 aku: method done {} {} bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method admindone {} { bd131addb9 2007-10-12 aku: # We do nothing at the boundary of admin and revision data bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method sethead {revnr} { bd131addb9 2007-10-12 aku: set myhead $revnr 3d88cfd05d 2007-10-06 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: bd131addb9 2007-10-12 aku: method setprincipalbranch {branchnr} { bd131addb9 2007-10-12 aku: set myprincipal $branchnr 3d88cfd05d 2007-10-06 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 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} 3d88cfd05d 2007-10-06 aku: method setdesc {d} {# ignore} 3d88cfd05d 2007-10-06 aku: bd131addb9 2007-10-12 aku: method def {revnr date author state next branches} { bd131addb9 2007-10-12 aku: $self LookForUnlabeledBranches $branches 8487172254 2007-10-06 aku: $myproject author $author 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: da9295c6f6 2007-10-12 aku: set myrev($revnr) [rev %AUTO% $revnr $date $author $state $self] bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: RecordBasicDependencies $revnr $next 3d88cfd05d 2007-10-06 aku: return 3d88cfd05d 2007-10-06 aku: } 3d88cfd05d 2007-10-06 aku: bd131addb9 2007-10-12 aku: method extend {revnr commitmsg deltarange} { 3d88cfd05d 2007-10-06 aku: set cm [string trim $commitmsg] 8487172254 2007-10-06 aku: $myproject cmessage $cm bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: set rev $myrev($revnr) bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {[$rev hascommitmsg]} { 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: bd131addb9 2007-10-12 aku: # Extend the revision with the new information. The revision bd131addb9 2007-10-12 aku: # object uses this to complete its meta data set. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: $rev setcommitmsg $cm bd131addb9 2007-10-12 aku: $rev settext $deltarange da9295c6f6 2007-10-12 aku: da9295c6f6 2007-10-12 aku: if {![rev istrunkrevnr $revnr]} { da9295c6f6 2007-10-12 aku: $rev setbranch [[$self Rev2Branch $revnr] name] da9295c6f6 2007-10-12 aku: } 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: bd131addb9 2007-10-12 aku: if {$revnr eq ""} { 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 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: bd131addb9 2007-10-12 aku: variable mypath {} ; # Path of rcs archive bd131addb9 2007-10-12 aku: variable myproject {} ; # Project object the file belongs to. bd131addb9 2007-10-12 aku: variable myrev -array {} ; # All revisions and their connections. bd131addb9 2007-10-12 aku: variable myrevisions {} ; # Same as myrev, but a list, giving us the order bd131addb9 2007-10-12 aku: # ; # of revisions. bd131addb9 2007-10-12 aku: variable myhead {} ; # Head revision (revision number) bd131addb9 2007-10-12 aku: variable myprincipal {} ; # Principal branch (branch number) bd131addb9 2007-10-12 aku: # ; # Contrary to the name this is the default branch. bd131addb9 2007-10-12 aku: variable mydependencies {} ; # Dictionary parent -> child, dependency recorder. bd131addb9 2007-10-12 aku: variable myimported 0 ; # Boolean flag. Set iff rev 1.1 of the file seemingly bd131addb9 2007-10-12 aku: # ; # was imported instead of added normally. bd131addb9 2007-10-12 aku: variable myroot {} ; # Revision number of the root revision. Usually '1.1'. bd131addb9 2007-10-12 aku: # ; # Can be a different number, because of 'cvsadmin -o'. bd131addb9 2007-10-12 aku: variable mybranches -array {} ; # branch number -> symbol object handling the branch bd131addb9 2007-10-12 aku: variable mytags -array {} ; # revision number -> list of symbol object for the tags bd131addb9 2007-10-12 aku: # ; # associated with the revision. bd131addb9 2007-10-12 aku: variable mysymbols {} ; # Set of symbol names found in this file. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: ### TODO ### bd131addb9 2007-10-12 aku: ### File flag - executable, bd131addb9 2007-10-12 aku: ### RCS mode info (kb, kkb, ...) 8a93ffa9c1 2007-10-06 aku: 8a93ffa9c1 2007-10-06 aku: # # ## ### ##### ######## ############# 8a93ffa9c1 2007-10-06 aku: ## Internal methods bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: method LookForUnlabeledBranches {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: } bd131addb9 2007-10-12 aku: # TODO $branch child $branchrevnr - when add-unlabeled has sensible return value 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]] 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: bd131addb9 2007-10-12 aku: proc 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: bd131addb9 2007-10-12 aku: upvar 1 mydependencies mydependencies bd131addb9 2007-10-12 aku: 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: bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # # ## ### ##### ######## ############# bd131addb9 2007-10-12 aku: ## Configuration 8a93ffa9c1 2007-10-06 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: pragma -simpledispatch yes ; # simple fast dispatch 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. bd131addb9 2007-10-12 aku: # namespace import vc::fossil::import::cvs::file::rev da9295c6f6 2007-10-12 aku: # namespace import vc::fossil::import::cvs::file::sym 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