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: ## Symbols (Tags, Branches) 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. cb70cf4ad6 2007-10-13 aku: package require vc::tools::trouble ; # Error reporting. cb70cf4ad6 2007-10-13 aku: package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. 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::sym { 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Public API 84de38d73f 2007-10-10 aku: adf168e23e 2007-10-24 aku: constructor {symtype nr symbol file} { adf168e23e 2007-10-24 aku: set myfile $file da9295c6f6 2007-10-12 aku: set mytype $symtype da9295c6f6 2007-10-12 aku: set mynr $nr da9295c6f6 2007-10-12 aku: set mysymbol $symbol cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: switch -exact -- $mytype { 47d52d1efd 2007-11-28 aku: branch { SetupBranch ; return } 47d52d1efd 2007-11-28 aku: tag { return } cb70cf4ad6 2007-10-13 aku: } 47d52d1efd 2007-11-28 aku: integrity assert 0 {Bad symbol type '$mytype'} adf168e23e 2007-10-24 aku: return adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: method defid {} { adf168e23e 2007-10-24 aku: set myid [incr myidcounter] da9295c6f6 2007-10-12 aku: return da9295c6f6 2007-10-12 aku: } adf168e23e 2007-10-24 aku: 6f8667b03e 2007-10-31 aku: method fid {} { return $myid } 6f8667b03e 2007-10-31 aku: method symbol {} { return $mysymbol } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Symbol acessor methods. da9295c6f6 2007-10-12 aku: da9295c6f6 2007-10-12 aku: delegate method name to mysymbol 67c24820c7 2007-10-14 aku: delegate method id to mysymbol 67c24820c7 2007-10-14 aku: 6f8667b03e 2007-10-31 aku: # Symbol aggregation methods 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: delegate method countasbranch to mysymbol 6f8667b03e 2007-10-31 aku: delegate method countastag to mysymbol 6f8667b03e 2007-10-31 aku: delegate method countacommit to mysymbol 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: method blockedby {fsymbol} { 6f8667b03e 2007-10-31 aku: $mysymbol blockedby [$fsymbol symbol] 6f8667b03e 2007-10-31 aku: return 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: method possibleparents {} { 6f8667b03e 2007-10-31 aku: switch -exact -- $mytype { 6f8667b03e 2007-10-31 aku: branch { $self BranchParents } 6f8667b03e 2007-10-31 aku: tag { $self TagParents } 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: return 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: method BranchParents {} { 6f8667b03e 2007-10-31 aku: # The "obvious" parent of a branch is the branch holding the 6f8667b03e 2007-10-31 aku: # revision spawning the branch. Any other branches that are 6f8667b03e 2007-10-31 aku: # rooted at the same revision and were committed earlier than 6f8667b03e 2007-10-31 aku: # the branch are also possible parents. 6f8667b03e 2007-10-31 aku: c4003e7b93 2007-12-05 aku: # Ignore this if the branch symbol is detached. c4003e7b93 2007-12-05 aku: if {$mybranchparent eq ""} return c4003e7b93 2007-12-05 aku: 6f8667b03e 2007-10-31 aku: $mysymbol possibleparent [[$mybranchparent lod] symbol] 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: foreach branch [$mybranchparent branches] { 6f8667b03e 2007-10-31 aku: # A branch cannot be its own parent. Nor can a branch 6f8667b03e 2007-10-31 aku: # created after this one be its parent. This means that we 6f8667b03e 2007-10-31 aku: # can abort the loop when we have reached ourselves in the 6f8667b03e 2007-10-31 aku: # list of branches. Here the order of file::rev.mybranches 6f8667b03e 2007-10-31 aku: # comes into play, as created by file::rev::sortbranches. 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: if {$branch eq $self} break 6f8667b03e 2007-10-31 aku: $mysymbol possibleparent [$branch symbol] 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: return 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: method TagParents {} { 6f8667b03e 2007-10-31 aku: # The "obvious" parent of a tag is the branch holding the 6f8667b03e 2007-10-31 aku: # revision spawning the tag. Branches that are spawned by the 6f8667b03e 2007-10-31 aku: # same revision are also possible parents. 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: $mysymbol possibleparent [[$mytagrev lod] symbol] 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: foreach branch [$mytagrev branches] { 6f8667b03e 2007-10-31 aku: $mysymbol possibleparent [$branch symbol] 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: return 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: 6f8667b03e 2007-10-31 aku: # 6f8667b03e 2007-10-31 aku: 09af24fc7c 2007-10-17 aku: method istrunk {} { return 0 } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Branch acessor methods. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method setchildrevnr {revnr} { 47d52d1efd 2007-11-28 aku: integrity assert {$mybranchchildrevnr eq ""} {Child already defined} cb70cf4ad6 2007-10-13 aku: set mybranchchildrevnr $revnr cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } cb70cf4ad6 2007-10-13 aku: 79c227a9c0 2007-12-01 aku: method setposition {n} { set mybranchposition $n ; return } 79c227a9c0 2007-12-01 aku: method setparent {rev} { set mybranchparent $rev ; return } 79c227a9c0 2007-12-01 aku: method setchild {rev} { set mybranchchild $rev ; return } 79c227a9c0 2007-12-01 aku: method cutchild {} { set mybranchchild "" ; return } 79c227a9c0 2007-12-01 aku: method cutbranchparent {} { set mybranchparent "" ; return } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: method branchnr {} { return $mynr } cb70cf4ad6 2007-10-13 aku: method parentrevnr {} { return $mybranchparentrevnr } cb70cf4ad6 2007-10-13 aku: method childrevnr {} { return $mybranchchildrevnr } adf168e23e 2007-10-24 aku: method haschildrev {} { return [expr {$mybranchchildrevnr ne ""}] } adf168e23e 2007-10-24 aku: method haschild {} { return [expr {$mybranchchild ne ""}] } 177a0cc55c 2007-10-17 aku: method parent {} { return $mybranchparent } cb70cf4ad6 2007-10-13 aku: method child {} { return $mybranchchild } e5441b908d 2007-10-15 aku: method position {} { return $mybranchposition } cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # Tag acessor methods. cb70cf4ad6 2007-10-13 aku: e5441b908d 2007-10-15 aku: method tagrevnr {} { return $mynr } d3aa33884b 2008-01-27 aku: method settagrev {rev} { set mytagrev $rev ; return } e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: # Derived information e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: method lod {} { return $mylod } e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: method setlod {lod} { e5441b908d 2007-10-15 aku: set mylod $lod 177a0cc55c 2007-10-17 aku: $self checklod 177a0cc55c 2007-10-17 aku: return 177a0cc55c 2007-10-17 aku: } 177a0cc55c 2007-10-17 aku: 177a0cc55c 2007-10-17 aku: method checklod {} { 177a0cc55c 2007-10-17 aku: # Consistency check. The symbol's line-of-development has to 177a0cc55c 2007-10-17 aku: # be same as the line-of-development of its source (parent 177a0cc55c 2007-10-17 aku: # revision of a branch, revision of a tag itself). e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: switch -exact -- $mytype { d3aa33884b 2008-01-27 aku: branch { d3aa33884b 2008-01-27 aku: # However, ignore this if the branch symbol is d3aa33884b 2008-01-27 aku: # detached. d3aa33884b 2008-01-27 aku: if {$mybranchparent eq ""} return d3aa33884b 2008-01-27 aku: d3aa33884b 2008-01-27 aku: set slod [$mybranchparent lod] d3aa33884b 2008-01-27 aku: } e5441b908d 2007-10-15 aku: tag { set slod [$mytagrev lod] } e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: if {$mylod ne $slod} { 177a0cc55c 2007-10-17 aku: trouble fatal "For $mytype [$mysymbol name]: LOD conflict with source, '[$mylod name]' vs. '[$slod name]'" e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: return e5441b908d 2007-10-15 aku: } e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: # # ## ### ##### ######## ############# adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: method persist {} { adf168e23e 2007-10-24 aku: # Save the information we need after the collection pass. adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: set fid [$myfile id] adf168e23e 2007-10-24 aku: set sid [$mysymbol id] 2c08006d9d 2007-10-25 aku: set lod [$mylod id] adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: switch -exact -- $mytype { adf168e23e 2007-10-24 aku: tag { adf168e23e 2007-10-24 aku: set rid [$mytagrev id] 2c08006d9d 2007-10-25 aku: state transaction { 2c08006d9d 2007-10-25 aku: state run { 2c08006d9d 2007-10-25 aku: INSERT INTO tag ( tid, fid, lod, sid, rev) 2c08006d9d 2007-10-25 aku: VALUES ($myid, $fid, $lod, $sid, $rid); 2c08006d9d 2007-10-25 aku: } adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: branch { 79c227a9c0 2007-12-01 aku: lappend map @F@ [expr { ($mybranchchild eq "") ? "NULL" : [$mybranchchild id] }] 79c227a9c0 2007-12-01 aku: lappend map @P@ [expr { ($mybranchparent eq "") ? "NULL" : [$mybranchparent id] }] 79c227a9c0 2007-12-01 aku: adf168e23e 2007-10-24 aku: set cmd { 7ab490df24 2007-11-07 aku: INSERT INTO branch ( bid, fid, lod, sid, root, first, bra, pos ) 79c227a9c0 2007-12-01 aku: VALUES ($myid, $fid, $lod, $sid, @P@, @F@, $mynr, $mybranchposition); 2c08006d9d 2007-10-25 aku: } 2c08006d9d 2007-10-25 aku: state transaction { 2c08006d9d 2007-10-25 aku: state run [string map $map $cmd] adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: } adf168e23e 2007-10-24 aku: d3aa33884b 2008-01-27 aku: return d3aa33884b 2008-01-27 aku: } d3aa33884b 2008-01-27 aku: d3aa33884b 2008-01-27 aku: method DUMP {label} { d3aa33884b 2008-01-27 aku: puts "$label = $self $mytype [$self name] \{" d3aa33884b 2008-01-27 aku: switch -exact -- $mytype { d3aa33884b 2008-01-27 aku: tag { d3aa33884b 2008-01-27 aku: puts "\tR\t$mytagrev" d3aa33884b 2008-01-27 aku: } d3aa33884b 2008-01-27 aku: branch { d3aa33884b 2008-01-27 aku: puts "\tP\t$mybranchparent" d3aa33884b 2008-01-27 aku: puts "\tC\t$mybranchchild" d3aa33884b 2008-01-27 aku: puts "\t\t<$mynr>" d3aa33884b 2008-01-27 aku: } adf168e23e 2007-10-24 aku: } d3aa33884b 2008-01-27 aku: puts "\}" 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: adf168e23e 2007-10-24 aku: # Tag: myid - tag.tid adf168e23e 2007-10-24 aku: # myfile - tag.fid adf168e23e 2007-10-24 aku: # mylod - tag.lod adf168e23e 2007-10-24 aku: # mysymbol - tag.sid adf168e23e 2007-10-24 aku: # mytagrev - tag.rev adf168e23e 2007-10-24 aku: # adf168e23e 2007-10-24 aku: # Branch: myid - branch.bid adf168e23e 2007-10-24 aku: # myfile - branch.fid adf168e23e 2007-10-24 aku: # mylod - branch.lod adf168e23e 2007-10-24 aku: # mysymbol - branch.sid adf168e23e 2007-10-24 aku: # mybranchparent - branch.root adf168e23e 2007-10-24 aku: # mybranchchild - branch.first adf168e23e 2007-10-24 aku: # mynr - branch.bra adf168e23e 2007-10-24 aku: adf168e23e 2007-10-24 aku: typevariable myidcounter 0 ; # Counter for symbol ids. adf168e23e 2007-10-24 aku: variable myid {} ; # Symbol id. e5441b908d 2007-10-15 aku: cb70cf4ad6 2007-10-13 aku: ## Basic, all symbols _________________ cb70cf4ad6 2007-10-13 aku: adf168e23e 2007-10-24 aku: variable myfile {} ; # Reference to the file the symbol is in. da9295c6f6 2007-10-12 aku: variable mytype {} ; # Symbol type, 'tag', or 'branch'. cb70cf4ad6 2007-10-13 aku: variable mynr {} ; # Revision number of a 'tag', branch number cb70cf4ad6 2007-10-13 aku: # of a 'branch'. cb70cf4ad6 2007-10-13 aku: variable mysymbol {} ; # Reference to the symbol object of this cb70cf4ad6 2007-10-13 aku: # symbol at the project level. e5441b908d 2007-10-15 aku: variable mylod {} ; # Reference to the line-of-development e5441b908d 2007-10-15 aku: # object the symbol belongs to. An e5441b908d 2007-10-15 aku: # alternative idiom would be to call it the e5441b908d 2007-10-15 aku: # branch the symbol is on. This reference 177a0cc55c 2007-10-17 aku: # is to a project-level object (symbol or 177a0cc55c 2007-10-17 aku: # trunk). cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: ## Branch symbols _____________________ cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: variable mybranchparentrevnr {} ; # The number of the parent cb70cf4ad6 2007-10-13 aku: # revision, derived from our cb70cf4ad6 2007-10-13 aku: # branch number (mynr). cb70cf4ad6 2007-10-13 aku: variable mybranchparent {} ; # Reference to the revision cb70cf4ad6 2007-10-13 aku: # (object) which spawns the cb70cf4ad6 2007-10-13 aku: # branch. cb70cf4ad6 2007-10-13 aku: variable mybranchchildrevnr {} ; # Number of the first revision cb70cf4ad6 2007-10-13 aku: # committed on this branch. cb70cf4ad6 2007-10-13 aku: variable mybranchchild {} ; # Reference to the revision cb70cf4ad6 2007-10-13 aku: # (object) first committed on cb70cf4ad6 2007-10-13 aku: # this branch. cb70cf4ad6 2007-10-13 aku: variable mybranchposition {} ; # Relative id of the branch in cb70cf4ad6 2007-10-13 aku: # the file, to sort into cb70cf4ad6 2007-10-13 aku: # creation order. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: ## Tag symbols ________________________ e5441b908d 2007-10-15 aku: e5441b908d 2007-10-15 aku: variable mytagrev {} ; # Reference to the revision object the tag e5441b908d 2007-10-15 aku: # is on, identified by 'mynr'. cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: # ... nothing special ... (only mynr, see basic) da9295c6f6 2007-10-12 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods cb70cf4ad6 2007-10-13 aku: cb70cf4ad6 2007-10-13 aku: proc SetupBranch {} { cb70cf4ad6 2007-10-13 aku: upvar 1 mybranchparentrevnr mybranchparentrevnr mynr mynr cb70cf4ad6 2007-10-13 aku: set mybranchparentrevnr [rev 2branchparentrevnr $mynr] cb70cf4ad6 2007-10-13 aku: return cb70cf4ad6 2007-10-13 aku: } 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 -hastypemethods no ; # type is not relevant. 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 sym cb70cf4ad6 2007-10-13 aku: namespace eval sym { cb70cf4ad6 2007-10-13 aku: namespace import ::vc::fossil::import::cvs::file::rev adf168e23e 2007-10-24 aku: namespace import ::vc::fossil::import::cvs::state 47d52d1efd 2007-11-28 aku: namespace import ::vc::fossil::import::cvs::integrity cb70cf4ad6 2007-10-13 aku: namespace import ::vc::tools::trouble cb70cf4ad6 2007-10-13 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::sym 1.0 84de38d73f 2007-10-10 aku: return
File Annotation