84de38d73f 2007-10-10 aku: ## -*- tcl -*- 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 66235f2430 2008-02-06 aku: ## Copyright (c) 2007-2008 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. 177a0cc55c 2007-10-17 aku: package require vc::tools::misc ; # Text formatting 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. 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: adf168e23e 2007-10-24 aku: method defid {} { adf168e23e 2007-10-24 aku: set myid [incr myidcounter] adf168e23e 2007-10-24 aku: return adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: 970be48fce 2008-01-27 aku: method id {} { return $myid } 970be48fce 2008-01-27 aku: method file {} { return $myfile } adf168e23e 2007-10-24 aku: cb70cf4ad6 2007-10-13 aku: # Basic pieces ________________________ cb70cf4ad6 2007-10-13 aku: 177a0cc55c 2007-10-17 aku: method hasmeta {} { return [expr {$mymetaid ne ""}] } 177a0cc55c 2007-10-17 aku: method hastext {} { f94f7e17d1 2008-02-02 aku: return [expr {$mytextstart <= $mytextend}] 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 67c24820c7 2007-10-14 aku: method setmeta {meta} { set mymetaid $meta ; return } bd131addb9 2007-10-12 aku: method settext {text} { f94f7e17d1 2008-02-02 aku: struct::list assign $text mytextstart mytextend f94f7e17d1 2008-02-02 aku: return f94f7e17d1 2008-02-02 aku: } 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 } 177a0cc55c 2007-10-17 aku: method date {} { return $mydate } 177a0cc55c 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: method isneeded {} { cfe4b269ac 2007-10-17 aku: if {$myoperation ne "nothing"} {return 1} cfe4b269ac 2007-10-17 aku: if {$myrevnr ne "1.1"} {return 1} cfe4b269ac 2007-10-17 aku: if {![$mylod istrunk]} {return 1} cfe4b269ac 2007-10-17 aku: if {![llength $mybranches]} {return 1} cfe4b269ac 2007-10-17 aku: set firstbranch [lindex $mybranches 0] cfe4b269ac 2007-10-17 aku: if {![$firstbranch haschild]} {return 1} cfe4b269ac 2007-10-17 aku: if {$myisondefaultbranch} {return 1} cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: # FIX: This message will not match if the RCS file was renamed cfe4b269ac 2007-10-17 aku: # manually after it was created. cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: set gen "file [file tail [$myfile usrpath]] was initially added on branch [$firstbranch name]." cfe4b269ac 2007-10-17 aku: set log [$myfile commitmessageof $mymetaid] cfe4b269ac 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: return [expr {$log ne $gen}] cfe4b269ac 2007-10-17 aku: } cfe4b269ac 2007-10-17 aku: 510cd02303 2007-10-19 aku: method isneededbranchdel {} { 510cd02303 2007-10-19 aku: if {$myparentbranch eq ""} {return 1} ; # not first on a branch, needed 510cd02303 2007-10-19 aku: set base [$myparentbranch parent] 510cd02303 2007-10-19 aku: if {$base eq ""} {return 1} ; # branch has parent lod, needed 510cd02303 2007-10-19 aku: if {[$self LODLength] < 2} {return 1} ; # our lod contains only ourselves, needed. 510cd02303 2007-10-19 aku: if {$myoperation ne "delete"} {return 1} ; # Not a deletion, needed 510cd02303 2007-10-19 aku: if {[llength $mytags]} {return 1} ; # Have tags, needed 510cd02303 2007-10-19 aku: if {[llength $mybranches]} {return 1} ; # Have other branches, needed 510cd02303 2007-10-19 aku: if {abs($mydate - [$base date]) > 2} {return 1} ; # Next rev > 2 seconds apart, needed 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: # FIXME: This message will not match if the RCS file was 510cd02303 2007-10-19 aku: # renamed manually after it was created. 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: set qfile [string map { 510cd02303 2007-10-19 aku: . \\. ? \\? * \\* \\ \\\\ + \\+ ^ \\^ $ \\$ 510cd02303 2007-10-19 aku: \[ \\\[ \] \\\] ( \\( ) \\) \{ \\\{ \} \\\} 510cd02303 2007-10-19 aku: } [file tail [$myfile usrpath]]] 510cd02303 2007-10-19 aku: set pattern "file $qfile was added on branch .* on \\d{4}-\\d{2}-\\d{2} \\d{2}:\\d{2}:\\d{2}( \[+-\]\\d{4})?" 510cd02303 2007-10-19 aku: set log [$myfile commitmessageof $mymetaid] 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: # Not the special message, needed 510cd02303 2007-10-19 aku: if {![regexp -- $pattern $log]} {return 1} 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: # This is an unneeded initial branch delete. 510cd02303 2007-10-19 aku: return 0 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: 510cd02303 2007-10-19 aku: method LODLength {} { 510cd02303 2007-10-19 aku: set n 1 ; # count self 510cd02303 2007-10-19 aku: set rev $mychild 510cd02303 2007-10-19 aku: while {$rev ne ""} { 510cd02303 2007-10-19 aku: incr n 510cd02303 2007-10-19 aku: set rev [$rev child] 510cd02303 2007-10-19 aku: } 510cd02303 2007-10-19 aku: return $n 510cd02303 2007-10-19 aku: } 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} { 47d52d1efd 2007-11-28 aku: integrity assert {$myparent eq ""} {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: 177a0cc55c 2007-10-17 aku: method cutfromparent {} { set myparent "" ; return } 177a0cc55c 2007-10-17 aku: method cutfromchild {} { set mychild "" ; return } 177a0cc55c 2007-10-17 aku: cb70cf4ad6 2007-10-13 aku: method setchild {child} { 47d52d1efd 2007-11-28 aku: integrity assert {$mychild eq ""} {Child already defined} cb70cf4ad6 2007-10-13 aku: set mychild $child cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } 436f17a5f0 2007-10-21 aku: 436f17a5f0 2007-10-21 aku: method changeparent {parent} { set myparent $parent ; return } 436f17a5f0 2007-10-21 aku: method changechild {child} { set mychild $child ; return } 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} { 47d52d1efd 2007-11-28 aku: integrity assert {$myparentbranch eq ""} {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: 886b6f257b 2007-10-21 aku: method hasparentbranch {} { return [expr {$myparentbranch ne ""}] } 886b6f257b 2007-10-21 aku: method hasbranches {} { return [llength $mybranches] } cfe4b269ac 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method parentbranch {} { return $myparentbranch } cfe4b269ac 2007-10-17 aku: method branches {} { return $mybranches } 177a0cc55c 2007-10-17 aku: cb70cf4ad6 2007-10-13 aku: method addbranch {branch} { cb70cf4ad6 2007-10-13 aku: lappend mybranches $branch 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: 177a0cc55c 2007-10-17 aku: method cutfromparentbranch {} { set myparentbranch "" ; return } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method removebranch {branch} { 177a0cc55c 2007-10-17 aku: ldelete mybranches $branch 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method removechildonbranch {rev} { 177a0cc55c 2007-10-17 aku: ldelete mybranchchildren $rev cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method sortbranches {} { 7ab490df24 2007-11-07 aku: # Pass 2: CollectRev 7ab490df24 2007-11-07 aku: 7ab490df24 2007-11-07 aku: if {[llength $mybranches] < 2} 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] { 177a0cc55c 2007-10-17 aku: struct::list assign $item branch position cb70cf4ad6 2007-10-13 aku: lappend mybranches $branch cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method movebranchesto {rev} { 177a0cc55c 2007-10-17 aku: set revlod [$rev lod] 177a0cc55c 2007-10-17 aku: foreach branch $mybranches { 177a0cc55c 2007-10-17 aku: $rev addbranch $branch 177a0cc55c 2007-10-17 aku: $branch setparent $rev 177a0cc55c 2007-10-17 aku: $branch setlod $revlod 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: foreach branchrev $mybranchchildren { 177a0cc55c 2007-10-17 aku: $rev addchildonbranch $branchrev 177a0cc55c 2007-10-17 aku: $branchrev cutfromparent 177a0cc55c 2007-10-17 aku: $branchrev setparent $rev 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: set mybranches {} 177a0cc55c 2007-10-17 aku: set mybranchchildren {} 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: cfe4b269ac 2007-10-17 aku: method removeallbranches {} { cfe4b269ac 2007-10-17 aku: set mybranches {} cfe4b269ac 2007-10-17 aku: set mybranchchildren {} cfe4b269ac 2007-10-17 aku: return cfe4b269ac 2007-10-17 aku: } cfe4b269ac 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Tag linkage _________________________ 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method addtag {tag} { 177a0cc55c 2007-10-17 aku: lappend mytags $tag cfe4b269ac 2007-10-17 aku: return cfe4b269ac 2007-10-17 aku: } cfe4b269ac 2007-10-17 aku: 886b6f257b 2007-10-21 aku: method tags {} { return $mytags } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: method removealltags {} { cfe4b269ac 2007-10-17 aku: set mytags {} 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method movetagsto {rev} { 177a0cc55c 2007-10-17 aku: set revlod [$rev lod] 177a0cc55c 2007-10-17 aku: foreach tag $mytags { 177a0cc55c 2007-10-17 aku: $rev addtag $tag 177a0cc55c 2007-10-17 aku: $tag settagrev $rev 177a0cc55c 2007-10-17 aku: $tag setlod $revlod 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: set mytags {} 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # general symbol operations ___________ 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method movesymbolsto {rev} { 177a0cc55c 2007-10-17 aku: # Move the tags and branches attached to this revision to the 177a0cc55c 2007-10-17 aku: # destination and fix all pointers. 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: $self movetagsto $rev 177a0cc55c 2007-10-17 aku: $self movebranchesto $rev 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Derived stuff _______________________ e5441b908d 2007-10-15 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]) e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method operation {} { return $myoperation } 177a0cc55c 2007-10-17 aku: method retype {x} { set myoperation $x ; return } 177a0cc55c 2007-10-17 aku: 886b6f257b 2007-10-21 aku: method isondefaultbranch {} { return $myisondefaultbranch } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: method setondefaultbranch {x} { set myisondefaultbranch $x ; return } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method setdefaultbranchchild {rev} { set mydbchild $rev ; return } 177a0cc55c 2007-10-17 aku: method setdefaultbranchparent {rev} { 177a0cc55c 2007-10-17 aku: set mydbparent $rev 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: # Retype the revision (may change from 'add' to 'change'). 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: set sdead [expr {$myoperation ne "change"}] 177a0cc55c 2007-10-17 aku: set pdead [expr {[$rev operation] ne "change"}] 177a0cc55c 2007-10-17 aku: set myoperation $myopstate([list $pdead $sdead]) da9295c6f6 2007-10-12 aku: return bd131addb9 2007-10-12 aku: } da9295c6f6 2007-10-12 aku: 886b6f257b 2007-10-21 aku: method cutdefaultbranchparent {} { set mydbparent "" ; return } 886b6f257b 2007-10-21 aku: method cutdefaultbranchchild {} { set mydbchild "" ; return } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: method defaultbranchchild {} { return $mydbchild } 886b6f257b 2007-10-21 aku: method defaultbranchparent {} { return $mydbparent } 886b6f257b 2007-10-21 aku: 886b6f257b 2007-10-21 aku: method hasdefaultbranchchild {} { return [expr {$mydbchild ne ""}] } 886b6f257b 2007-10-21 aku: method hasdefaultbranchparent {} { return [expr {$mydbparent ne ""}] } bd131addb9 2007-10-12 aku: bd131addb9 2007-10-12 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] .] cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # # ## ### ##### ######## ############# adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: method persist {} { adf168e23e 2007-10-24 aku: set fid [$myfile id] 2c08006d9d 2007-10-25 aku: set lod [$mylod id] adf168e23e 2007-10-24 aku: set op $myopcode($myoperation) adf168e23e 2007-10-24 aku: set idb $myisondefaultbranch adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: lappend map @P@ [expr { ($myparent eq "") ? "NULL" : [$myparent id] }] adf168e23e 2007-10-24 aku: lappend map @C@ [expr { ($mychild eq "") ? "NULL" : [$mychild id] }] adf168e23e 2007-10-24 aku: lappend map @DP [expr { ($mydbparent eq "") ? "NULL" : [$mydbparent id] }] adf168e23e 2007-10-24 aku: lappend map @DC [expr { ($mydbchild eq "") ? "NULL" : [$mydbchild id] }] adf168e23e 2007-10-24 aku: lappend map @BP [expr { ($myparentbranch eq "") ? "NULL" : [$myparentbranch id] }] adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: set cmd { 3e76f2a5f0 2008-02-03 aku: INSERT INTO revision ( rid, fid, rev, lod, parent, child, isdefault, dbparent, dbchild, bparent, op, date, state, mid) 3e76f2a5f0 2008-02-03 aku: VALUES ($myid, $fid, $myrevnr, $lod, @P@, @C@, $idb, @DP, @DC, @BP , $op, $mydate, $mystate, $mymetaid); adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: state transaction { adf168e23e 2007-10-24 aku: state run [string map $map $cmd] 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: # And the branch children as well, for pass 5. 95af789e1f 2007-11-10 aku: foreach bc $mybranchchildren { 95af789e1f 2007-11-10 aku: set bcid [$bc id] 95af789e1f 2007-11-10 aku: state run { 95af789e1f 2007-11-10 aku: INSERT INTO revisionbranchchildren (rid, brid) 95af789e1f 2007-11-10 aku: VALUES ($myid, $bcid); 95af789e1f 2007-11-10 aku: } 95af789e1f 2007-11-10 aku: } bd131addb9 2007-10-12 aku: } 84de38d73f 2007-10-10 aku: return 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## State 84de38d73f 2007-10-10 aku: adf168e23e 2007-10-24 aku: # Persistent: myid - revision.rid adf168e23e 2007-10-24 aku: # myfile - revision.fid adf168e23e 2007-10-24 aku: # mylod - revision.lod adf168e23e 2007-10-24 aku: # myrevnr - revision.rev adf168e23e 2007-10-24 aku: # mydate - revision.date adf168e23e 2007-10-24 aku: # mystate - revision.state adf168e23e 2007-10-24 aku: # mymetaid - revision.mid f94f7e17d1 2008-02-02 aku: # mytext{start,end} - revision.{cs,ce} adf168e23e 2007-10-24 aku: # myparent - revision.parent adf168e23e 2007-10-24 aku: # mychild - revision.child adf168e23e 2007-10-24 aku: # myparentbranch - revision.bparent adf168e23e 2007-10-24 aku: # myoperation - revision.op adf168e23e 2007-10-24 aku: # myisondefaultbranch - revision.isdefault adf168e23e 2007-10-24 aku: # mydbparent - revision.dbparent adf168e23e 2007-10-24 aku: # mydbchild - revision.dbchild adf168e23e 2007-10-24 aku: 970be48fce 2008-01-27 aku: method DUMP {label} { 970be48fce 2008-01-27 aku: puts "$label = $self <$myrevnr> (NTDB=$myisondefaultbranch) \{" 970be48fce 2008-01-27 aku: puts "\tP\t$myparent" 970be48fce 2008-01-27 aku: puts "\tC\t$mychild" 970be48fce 2008-01-27 aku: puts "\tPB\t$myparentbranch" 970be48fce 2008-01-27 aku: puts "\tdbP\t$mydbparent" 970be48fce 2008-01-27 aku: puts "\tdbC\t$mydbchild" 970be48fce 2008-01-27 aku: foreach b $mybranches { 970be48fce 2008-01-27 aku: puts \t\tB\t$b 970be48fce 2008-01-27 aku: } 970be48fce 2008-01-27 aku: foreach b $mybranchchildren { 970be48fce 2008-01-27 aku: puts \t\tBC\t$b 970be48fce 2008-01-27 aku: } 970be48fce 2008-01-27 aku: puts "\}" 970be48fce 2008-01-27 aku: return 970be48fce 2008-01-27 aku: } cb70cf4ad6 2007-10-13 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: adf168e23e 2007-10-24 aku: typevariable myidcounter 0 ; # Counter for revision ids. adf168e23e 2007-10-24 aku: variable myid {} ; # Revision id. cb70cf4ad6 2007-10-13 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. f94f7e17d1 2008-02-02 aku: variable mytextstart {} ; # Start of the range of the (delta) text f94f7e17d1 2008-02-02 aku: # for this revision in the file. f94f7e17d1 2008-02-02 aku: variable mytextend {} ; # End of the range of the (delta) text f94f7e17d1 2008-02-02 aku: # 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 970be48fce 2008-01-27 aku: # reference is to either project-level 970be48fce 2008-01-27 aku: # trunk or file-level symbol. 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. cb70cf4ad6 2007-10-13 aku: e5441b908d 2007-10-15 aku: # More derived data e5441b908d 2007-10-15 aku: 177a0cc55c 2007-10-17 aku: variable myoperation {} ; # One of 'add', 'change', 'delete', or 177a0cc55c 2007-10-17 aku: # 'nothing'. Derived from our and 177a0cc55c 2007-10-17 aku: # its parent's state. 177a0cc55c 2007-10-17 aku: variable myisondefaultbranch 0 ; # Boolean flag, set if the 177a0cc55c 2007-10-17 aku: # revision is on the non-trunk 177a0cc55c 2007-10-17 aku: # default branch, aka vendor 177a0cc55c 2007-10-17 aku: # branch. 177a0cc55c 2007-10-17 aku: variable mydbparent {} ; # Reference to the last revision 177a0cc55c 2007-10-17 aku: # on the vendor branch if this is 177a0cc55c 2007-10-17 aku: # the primary child of the 177a0cc55c 2007-10-17 aku: # regular root. 177a0cc55c 2007-10-17 aku: variable mydbchild {} ; # Reference to the primary child 177a0cc55c 2007-10-17 aku: # of the regular root if this is 177a0cc55c 2007-10-17 aku: # the last revision on the vendor 177a0cc55c 2007-10-17 aku: # branch. e5441b908d 2007-10-15 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: } da9295c6f6 2007-10-12 aku: e45f47ec4a 2007-11-07 aku: typemethod getopcodes {} { f637d42206 2008-02-24 aku: state foreachrow { e45f47ec4a 2007-11-07 aku: SELECT oid, name FROM optype; f637d42206 2008-02-24 aku: } { set myopcode($name) $oid } e45f47ec4a 2007-11-07 aku: return adf168e23e 2007-10-24 aku: } da9295c6f6 2007-10-12 aku: e45f47ec4a 2007-11-07 aku: typevariable myopcode -array {} da9295c6f6 2007-10-12 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 177a0cc55c 2007-10-17 aku: namespace eval rev { 177a0cc55c 2007-10-17 aku: namespace import ::vc::tools::misc::* adf168e23e 2007-10-24 aku: namespace import ::vc::fossil::import::cvs::state 47d52d1efd 2007-11-28 aku: namespace import ::vc::fossil::import::cvs::integrity 177a0cc55c 2007-10-17 aku: } 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