diff options
Diffstat (limited to 'tools/cvs2fossil/lib/c2f_fsym.tcl')
| -rw-r--r-- | tools/cvs2fossil/lib/c2f_fsym.tcl | 325 |
1 files changed, 325 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/c2f_fsym.tcl b/tools/cvs2fossil/lib/c2f_fsym.tcl new file mode 100644 index 0000000..d61b46e --- /dev/null +++ b/tools/cvs2fossil/lib/c2f_fsym.tcl @@ -0,0 +1,325 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ##################### +## Copyright (c) 2007-2008 Andreas Kupries. +# +# This software is licensed as described in the file LICENSE, which +# you should have received as part of this distribution. +# +# This software consists of voluntary contributions made by many +# individuals. For exact contribution history, see the revision +# history and logs, available at http://fossil-scm.hwaci.com/fossil +# # ## ### ##### ######## ############# ##################### + +## Symbols (Tags, Branches) per file. + +# # ## ### ##### ######## ############# ##################### +## Requirements + +package require Tcl 8.4 ; # Required runtime. +package require snit ; # OO system. +package require vc::tools::trouble ; # Error reporting. +package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. +package require vc::fossil::import::cvs::state ; # State storage. +package require vc::fossil::import::cvs::integrity ; # State integrity checks. + +# # ## ### ##### ######## ############# ##################### +## + +snit::type ::vc::fossil::import::cvs::file::sym { + # # ## ### ##### ######## ############# + ## Public API + + constructor {symtype nr symbol file} { + set myfile $file + set mytype $symtype + set mynr $nr + set mysymbol $symbol + + switch -exact -- $mytype { + branch { SetupBranch ; return } + tag { return } + } + integrity assert 0 {Bad symbol type '$mytype'} + return + } + + method defid {} { + set myid [incr myidcounter] + return + } + + method fid {} { return $myid } + method symbol {} { return $mysymbol } + + # Symbol acessor methods. + + delegate method name to mysymbol + delegate method id to mysymbol + + # Symbol aggregation methods + + delegate method countasbranch to mysymbol + delegate method countastag to mysymbol + delegate method countacommit to mysymbol + + method blockedby {fsymbol} { + $mysymbol blockedby [$fsymbol symbol] + return + } + + method possibleparents {} { + switch -exact -- $mytype { + branch { $self BranchParents } + tag { $self TagParents } + } + return + } + + method BranchParents {} { + # The "obvious" parent of a branch is the branch holding the + # revision spawning the branch. Any other branches that are + # rooted at the same revision and were committed earlier than + # the branch are also possible parents. + + # Ignore this if the branch symbol is detached. + if {$mybranchparent eq ""} return + + $mysymbol possibleparent [[$mybranchparent lod] symbol] + + foreach branch [$mybranchparent branches] { + # A branch cannot be its own parent. Nor can a branch + # created after this one be its parent. This means that we + # can abort the loop when we have reached ourselves in the + # list of branches. Here the order of file::rev.mybranches + # comes into play, as created by file::rev::sortbranches. + + if {$branch eq $self} break + $mysymbol possibleparent [$branch symbol] + } + return + } + + method TagParents {} { + # The "obvious" parent of a tag is the branch holding the + # revision spawning the tag. Branches that are spawned by the + # same revision are also possible parents. + + $mysymbol possibleparent [[$mytagrev lod] symbol] + + foreach branch [$mytagrev branches] { + $mysymbol possibleparent [$branch symbol] + } + return + } + + # + + method istrunk {} { return 0 } + + # Branch acessor methods. + + method setchildrevnr {revnr} { + integrity assert {$mybranchchildrevnr eq ""} {Child already defined} + set mybranchchildrevnr $revnr + return + } + + method setposition {n} { set mybranchposition $n ; return } + method setparent {rev} { set mybranchparent $rev ; return } + method setchild {rev} { set mybranchchild $rev ; return } + method cutchild {} { set mybranchchild "" ; return } + method cutbranchparent {} { set mybranchparent "" ; return } + + method branchnr {} { return $mynr } + method parentrevnr {} { return $mybranchparentrevnr } + method childrevnr {} { return $mybranchchildrevnr } + method haschildrev {} { return [expr {$mybranchchildrevnr ne ""}] } + method haschild {} { return [expr {$mybranchchild ne ""}] } + method parent {} { return $mybranchparent } + method child {} { return $mybranchchild } + method position {} { return $mybranchposition } + + # Tag acessor methods. + + method tagrevnr {} { return $mynr } + method settagrev {rev} { set mytagrev $rev ; return } + + # Derived information + + method lod {} { return $mylod } + + method setlod {lod} { + set mylod $lod + $self checklod + return + } + + method checklod {} { + # Consistency check. The symbol's line-of-development has to + # be same as the line-of-development of its source (parent + # revision of a branch, revision of a tag itself). + + switch -exact -- $mytype { + branch { + # However, ignore this if the branch symbol is + # detached. + if {$mybranchparent eq ""} return + + set slod [$mybranchparent lod] + } + tag { set slod [$mytagrev lod] } + } + + if {$mylod ne $slod} { + trouble fatal "For $mytype [$mysymbol name]: LOD conflict with source, '[$mylod name]' vs. '[$slod name]'" + return + } + return + } + + # # ## ### ##### ######## ############# + + method persist {} { + # Save the information we need after the collection pass. + + set fid [$myfile id] + set sid [$mysymbol id] + set lod [$mylod id] + + switch -exact -- $mytype { + tag { + set rid [$mytagrev id] + state transaction { + state run { + INSERT INTO tag ( tid, fid, lod, sid, rev) + VALUES ($myid, $fid, $lod, $sid, $rid); + } + } + } + branch { + lappend map @F@ [expr { ($mybranchchild eq "") ? "NULL" : [$mybranchchild id] }] + lappend map @P@ [expr { ($mybranchparent eq "") ? "NULL" : [$mybranchparent id] }] + + set cmd { + INSERT INTO branch ( bid, fid, lod, sid, root, first, bra, pos ) + VALUES ($myid, $fid, $lod, $sid, @P@, @F@, $mynr, $mybranchposition); + } + state transaction { + state run [string map $map $cmd] + } + } + } + + return + } + + method DUMP {label} { + puts "$label = $self $mytype [$self name] \{" + switch -exact -- $mytype { + tag { + puts "\tR\t$mytagrev" + } + branch { + puts "\tP\t$mybranchparent" + puts "\tC\t$mybranchchild" + puts "\t\t<$mynr>" + } + } + puts "\}" + return + } + + # # ## ### ##### ######## ############# + ## State + + # Persistent: + # Tag: myid - tag.tid + # myfile - tag.fid + # mylod - tag.lod + # mysymbol - tag.sid + # mytagrev - tag.rev + # + # Branch: myid - branch.bid + # myfile - branch.fid + # mylod - branch.lod + # mysymbol - branch.sid + # mybranchparent - branch.root + # mybranchchild - branch.first + # mynr - branch.bra + + typevariable myidcounter 0 ; # Counter for symbol ids. + variable myid {} ; # Symbol id. + + ## Basic, all symbols _________________ + + variable myfile {} ; # Reference to the file the symbol is in. + variable mytype {} ; # Symbol type, 'tag', or 'branch'. + variable mynr {} ; # Revision number of a 'tag', branch number + # of a 'branch'. + variable mysymbol {} ; # Reference to the symbol object of this + # symbol at the project level. + variable mylod {} ; # Reference to the line-of-development + # object the symbol belongs to. An + # alternative idiom would be to call it the + # branch the symbol is on. This reference + # is to a project-level object (symbol or + # trunk). + + ## Branch symbols _____________________ + + variable mybranchparentrevnr {} ; # The number of the parent + # revision, derived from our + # branch number (mynr). + variable mybranchparent {} ; # Reference to the revision + # (object) which spawns the + # branch. + variable mybranchchildrevnr {} ; # Number of the first revision + # committed on this branch. + variable mybranchchild {} ; # Reference to the revision + # (object) first committed on + # this branch. + variable mybranchposition {} ; # Relative id of the branch in + # the file, to sort into + # creation order. + + ## Tag symbols ________________________ + + variable mytagrev {} ; # Reference to the revision object the tag + # is on, identified by 'mynr'. + + # ... nothing special ... (only mynr, see basic) + + # # ## ### ##### ######## ############# + ## Internal methods + + proc SetupBranch {} { + upvar 1 mybranchparentrevnr mybranchparentrevnr mynr mynr + set mybranchparentrevnr [rev 2branchparentrevnr $mynr] + return + } + + # # ## ### ##### ######## ############# + ## Configuration + + pragma -hastypeinfo no ; # no type introspection + pragma -hasinfo no ; # no object introspection + pragma -hastypemethods no ; # type is not relevant. + + # # ## ### ##### ######## ############# +} + +namespace eval ::vc::fossil::import::cvs::file { + namespace export sym + namespace eval sym { + namespace import ::vc::fossil::import::cvs::file::rev + namespace import ::vc::fossil::import::cvs::state + namespace import ::vc::fossil::import::cvs::integrity + namespace import ::vc::tools::trouble + } +} + +# # ## ### ##### ######## ############# ##################### +## Ready + +package provide vc::fossil::import::cvs::file::sym 1.0 +return |