84de38d73f 2007-10-10 aku: ## -*- tcl -*- 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Copyright (c) 2007 Andreas Kupries. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software is licensed as described in the file LICENSE, which 84de38d73f 2007-10-10 aku: # you should have received as part of this distribution. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software consists of voluntary contributions made by many 84de38d73f 2007-10-10 aku: # individuals. For exact contribution history, see the revision 84de38d73f 2007-10-10 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: ## Revisions per file. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Requirements 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package require Tcl 8.4 ; # Required runtime. 84de38d73f 2007-10-10 aku: package require snit ; # OO system. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: snit::type ::vc::fossil::import::cvs::file::rev { 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Public API 84de38d73f 2007-10-10 aku: 67c24820c7 2007-10-14 aku: constructor {revnr date state thefile} { cb70cf4ad6 2007-10-13 aku: set myrevnr $revnr cb70cf4ad6 2007-10-13 aku: set mydate $date cb70cf4ad6 2007-10-13 aku: set myorigdate $date cb70cf4ad6 2007-10-13 aku: set mystate $state cb70cf4ad6 2007-10-13 aku: set myfile $thefile cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Basic pieces ________________________ cb70cf4ad6 2007-10-13 aku: 67c24820c7 2007-10-14 aku: method hasmeta {} { return [expr {$mymetaid ne ""}] } 67c24820c7 2007-10-14 aku: method setmeta {meta} { set mymetaid $meta ; return } 67c24820c7 2007-10-14 aku: method settext {text} { set mytext $text ; return } e5441b908d 2007-10-15 aku: method setlod {lod} { set mylod $lod ; return } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method revnr {} { return $myrevnr } e5441b908d 2007-10-15 aku: method state {} { return $mystate } e5441b908d 2007-10-15 aku: method lod {} { return $mylod } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Basic parent/child linkage __________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method hasparent {} { return [expr {$myparent ne ""}] } cb70cf4ad6 2007-10-13 aku: method haschild {} { return [expr {$mychild ne ""}] } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setparent {parent} { cb70cf4ad6 2007-10-13 aku: if {$myparent ne ""} { trouble internal "Parent already defined" } cb70cf4ad6 2007-10-13 aku: set myparent $parent cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setchild {child} { cb70cf4ad6 2007-10-13 aku: if {$mychild ne ""} { trouble internal "Child already defined" } cb70cf4ad6 2007-10-13 aku: set mychild $child cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method parent {} { return $myparent } cb70cf4ad6 2007-10-13 aku: method child {} { return $mychild } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Branch linkage ______________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setparentbranch {branch} { cb70cf4ad6 2007-10-13 aku: if {$myparentbranch ne ""} { trouble internal "Branch parent already defined" } cb70cf4ad6 2007-10-13 aku: set myparentbranch $branch cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method addbranch {branch} { cb70cf4ad6 2007-10-13 aku: lappend mybranches $branch cb70cf4ad6 2007-10-13 aku: #sorted in ascending order by branch number? cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method addchildonbranch {child} { cb70cf4ad6 2007-10-13 aku: lappend mybranchchildren $child cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Tag linkage _________________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method addtag {tag} { cb70cf4ad6 2007-10-13 aku: lappend mytags $tag da9295c6f6 2007-10-12 aku: return da9295c6f6 2007-10-12 aku: } da9295c6f6 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: method sortbranches {} { cb70cf4ad6 2007-10-13 aku: if {![llength $mybranches]} return cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Sort the branches spawned by this revision in creation cb70cf4ad6 2007-10-13 aku: # order. To help in this our file gave all branches a position cb70cf4ad6 2007-10-13 aku: # id, in order of their definition by the RCS archive. cb70cf4ad6 2007-10-13 aku: # cb70cf4ad6 2007-10-13 aku: # The creation order is (apparently) the reverse of the cb70cf4ad6 2007-10-13 aku: # definition order. (If a branch is created then deleted, a cb70cf4ad6 2007-10-13 aku: # later branch can be assigned the recycled branch number; cb70cf4ad6 2007-10-13 aku: # therefore branch numbers are not an indication of creation cb70cf4ad6 2007-10-13 aku: # order.) cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: set tmp {} cb70cf4ad6 2007-10-13 aku: foreach branch $mybranches { cb70cf4ad6 2007-10-13 aku: lappend tmp [list $branch [$branch position]] cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: set mybranches {} cb70cf4ad6 2007-10-13 aku: foreach item [lsort -index 1 -decreasing $tmp] { cb70cf4ad6 2007-10-13 aku: struct::list assign $item -> branch position cb70cf4ad6 2007-10-13 aku: lappend mybranches $branch cb70cf4ad6 2007-10-13 aku: } bd131addb9 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: e5441b908d 2007-10-15 aku: method determineoperation {} { e5441b908d 2007-10-15 aku: # Look at the state of both this revision and its parent to e5441b908d 2007-10-15 aku: # determine the type opf operation which was performed (add, e5441b908d 2007-10-15 aku: # modify, delete, none). e5441b908d 2007-10-15 aku: # e5441b908d 2007-10-15 aku: # The important information is dead vs not-dead for both, e5441b908d 2007-10-15 aku: # giving rise to four possible types. e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: set sdead [expr {$mystate eq "dead"}] e5441b908d 2007-10-15 aku: set pdead [expr {$myparent eq "" || [$myparent state] eq "dead"}] e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: set myoperation $myopstate([list $pdead $sdead]) 84de38d73f 2007-10-10 aku: return 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# bd131addb9 2007-10-12 aku: ## Type API bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: typemethod istrunkrevnr {revnr} { da9295c6f6 2007-10-12 aku: return [expr {[llength [split $revnr .]] == 2}] cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: typemethod isbranchrevnr {revnr _ bv} { cb70cf4ad6 2007-10-13 aku: if {[regexp $mybranchpattern $revnr -> head tail]} { cb70cf4ad6 2007-10-13 aku: upvar 1 $bv branchnr cb70cf4ad6 2007-10-13 aku: set branchnr ${head}$tail cb70cf4ad6 2007-10-13 aku: return 1 cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: return 0 bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: typemethod 2branchnr {revnr} { bd131addb9 2007-10-12 aku: # Input is a branch revision number, i.e. a revision number bd131addb9 2007-10-12 aku: # with an even number of components; for example '2.9.2.1' bd131addb9 2007-10-12 aku: # (never '2.9.2' nor '2.9.0.2'). The return value is the bd131addb9 2007-10-12 aku: # branch number (for example, '2.9.2'). For trunk revisions, bd131addb9 2007-10-12 aku: # like '3.4', we return the empty string. bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: if {[$type istrunkrevnr $revnr]} { bd131addb9 2007-10-12 aku: return "" bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: return [join [lrange [split $revnr .] 0 end-1] .] bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: cb70cf4ad6 2007-10-13 aku: typemethod 2branchparentrevnr {branchnr} { cb70cf4ad6 2007-10-13 aku: # Chop the last segment off cb70cf4ad6 2007-10-13 aku: return [join [lrange [split $branchnr .] 0 end-1] .] bd131addb9 2007-10-12 aku: } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## State bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 aku: typevariable mybranchpattern {^((?:\d+\.\d+\.)+)(?:0\.)?(\d+)$} bd131addb9 2007-10-12 aku: # First a nonzero even number of digit groups with trailing dot bd131addb9 2007-10-12 aku: # CVS then sticks an extra 0 in here; RCS does not. bd131addb9 2007-10-12 aku: # And the last digit group. bd131addb9 2007-10-12 aku: da9295c6f6 2007-10-12 aku: variable myrevnr {} ; # Revision number of the revision. da9295c6f6 2007-10-12 aku: variable mydate {} ; # Timestamp of the revision, seconds since epoch cb70cf4ad6 2007-10-13 aku: variable myorigdate {} ; # Original unmodified timestamp. da9295c6f6 2007-10-12 aku: variable mystate {} ; # State of the revision. da9295c6f6 2007-10-12 aku: variable myfile {} ; # Ref to the file object the revision belongs to. da9295c6f6 2007-10-12 aku: variable mytext {} ; # Range of the (delta) text for this revision in the file. 67c24820c7 2007-10-14 aku: variable mymetaid {} ; # Id of the meta data group the revision 67c24820c7 2007-10-14 aku: # belongs to. This is later used to put 67c24820c7 2007-10-14 aku: # the file revisions into preliminary 67c24820c7 2007-10-14 aku: # changesets (aka project revisions). 67c24820c7 2007-10-14 aku: # This id encodes 4 pieces of data, 67c24820c7 2007-10-14 aku: # namely: the project and branch the 67c24820c7 2007-10-14 aku: # revision was committed to, the author 67c24820c7 2007-10-14 aku: # who did the commit, and the message 67c24820c7 2007-10-14 aku: # used. e5441b908d 2007-10-15 aku: variable mylod {} ; # Reference to the line-of-development e5441b908d 2007-10-15 aku: # object the revision belongs to. An e5441b908d 2007-10-15 aku: # alternative idiom would be to call it e5441b908d 2007-10-15 aku: # the branch the revision is on. This e5441b908d 2007-10-15 aku: # reference is to a project-level object e5441b908d 2007-10-15 aku: # (symbol or trunk). cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Basic parent/child linkage (lines of development) cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable myparent {} ; # Ref to parent revision object. Link required because of cb70cf4ad6 2007-10-13 aku: # ; # 'cvsadmin -o', which can create arbitrary gaps in the cb70cf4ad6 2007-10-13 aku: # ; # numbering sequence. This is in the same line of development cb70cf4ad6 2007-10-13 aku: # ; # Note: For the first revision on a branch the revision cb70cf4ad6 2007-10-13 aku: # ; # it was spawned from is the parent. Only the root revision cb70cf4ad6 2007-10-13 aku: # ; # of myfile's revision tree has nothing set here. cb70cf4ad6 2007-10-13 aku: # ; # cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mychild {} ; # Ref to the primary child revision object, i.e. the next cb70cf4ad6 2007-10-13 aku: # ; # revision in the same line of development. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Branch linkage ____________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mybranches {} ; # List of the branches (objs) spawned by this revision. cb70cf4ad6 2007-10-13 aku: variable myparentbranch {} ; # For the first revision on a branch the relevant cb70cf4ad6 2007-10-13 aku: # ; # branch object. This also allows us to determine if cb70cf4ad6 2007-10-13 aku: # ; # myparent is in the same LOD, or the revision the cb70cf4ad6 2007-10-13 aku: # ; # branch spawned from. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # List of the revision objects of the first commits on any cb70cf4ad6 2007-10-13 aku: # branches spawned by this revision on which commits occurred. cb70cf4ad6 2007-10-13 aku: # This dependency is kept explicitly because otherwise a cb70cf4ad6 2007-10-13 aku: # revision-only topological sort would miss the dependency that cb70cf4ad6 2007-10-13 aku: # exists via -> mybranches. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mybranchchildren {} ; # List of the revisions (objs) which are the first cb70cf4ad6 2007-10-13 aku: # ; # commits on any of the branches spawned from this cb70cf4ad6 2007-10-13 aku: # ; # revision. The dependency is kept explicitly to cb70cf4ad6 2007-10-13 aku: # ; # ensure that a revision-only topological sort will cb70cf4ad6 2007-10-13 aku: # ; # not miss it, as it otherwise exists only via cb70cf4ad6 2007-10-13 aku: # ; # mybranches. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Tag linkage ________________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mytags {} ; # List of tags (objs) associated with this revision. e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: # More derived data da9295c6f6 2007-10-12 aku: e5441b908d 2007-10-15 aku: variable myoperation {} ; # One of 'add', 'change', 'delete', or e5441b908d 2007-10-15 aku: # 'nothing'. Derived from our and its e5441b908d 2007-10-15 aku: # parent's state. da9295c6f6 2007-10-12 aku: e5441b908d 2007-10-15 aku: # dead(self) x dead(parent) -> operation e5441b908d 2007-10-15 aku: typevariable myopstate -array { e5441b908d 2007-10-15 aku: {0 0} change e5441b908d 2007-10-15 aku: {0 1} delete e5441b908d 2007-10-15 aku: {1 0} add e5441b908d 2007-10-15 aku: {1 1} nothing e5441b908d 2007-10-15 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Configuration 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: pragma -hastypeinfo no ; # no type introspection 84de38d73f 2007-10-10 aku: pragma -hasinfo no ; # no object introspection 84de38d73f 2007-10-10 aku: pragma -simpledispatch yes ; # simple fast dispatch 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: namespace eval ::vc::fossil::import::cvs::file { 84de38d73f 2007-10-10 aku: namespace export rev 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Ready 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package provide vc::fossil::import::cvs::file::rev 1.0 84de38d73f 2007-10-10 aku: return
File Annotation