1## -*- tcl -*- 2# # ## ### ##### ######## ############# ##################### 3## Copyright (c) 2007-2008 Andreas Kupries. 4# 5# This software is licensed as described in the file LICENSE, which 6# you should have received as part of this distribution. 7# 8# This software consists of voluntary contributions made by many 9# individuals. For exact contribution history, see the revision 10# history and logs, available at http://fossil-scm.hwaci.com/fossil 11# # ## ### ##### ######## ############# ##################### 12 13## Symbols (Tags, Branches) per file. 14 15# # ## ### ##### ######## ############# ##################### 16## Requirements 17 18package require Tcl 8.4 ; # Required runtime. 19package require snit ; # OO system. 20package require vc::tools::trouble ; # Error reporting. 21package require vc::fossil::import::cvs::file::rev ; # CVS per file revisions. 22package require vc::fossil::import::cvs::state ; # State storage. 23package require vc::fossil::import::cvs::integrity ; # State integrity checks. 24 25# # ## ### ##### ######## ############# ##################### 26## 27 28snit::type ::vc::fossil::import::cvs::file::sym { 29 # # ## ### ##### ######## ############# 30 ## Public API 31 32 constructor {symtype nr symbol file} { 33 set myfile $file 34 set mytype $symtype 35 set mynr $nr 36 set mysymbol $symbol 37 38 switch -exact -- $mytype { 39 branch { SetupBranch ; return } 40 tag { return } 41 } 42 integrity assert 0 {Bad symbol type '$mytype'} 43 return 44 } 45 46 method defid {} { 47 set myid [incr myidcounter] 48 return 49 } 50 51 method fid {} { return $myid } 52 method symbol {} { return $mysymbol } 53 54 # Symbol acessor methods. 55 56 delegate method name to mysymbol 57 delegate method id to mysymbol 58 59 # Symbol aggregation methods 60 61 delegate method countasbranch to mysymbol 62 delegate method countastag to mysymbol 63 delegate method countacommit to mysymbol 64 65 method blockedby {fsymbol} { 66 $mysymbol blockedby [$fsymbol symbol] 67 return 68 } 69 70 method possibleparents {} { 71 switch -exact -- $mytype { 72 branch { $self BranchParents } 73 tag { $self TagParents } 74 } 75 return 76 } 77 78 method BranchParents {} { 79 # The "obvious" parent of a branch is the branch holding the 80 # revision spawning the branch. Any other branches that are 81 # rooted at the same revision and were committed earlier than 82 # the branch are also possible parents. 83 84 # Ignore this if the branch symbol is detached. 85 if {$mybranchparent eq ""} return 86 87 $mysymbol possibleparent [[$mybranchparent lod] symbol] 88 89 foreach branch [$mybranchparent branches] { 90 # A branch cannot be its own parent. Nor can a branch 91 # created after this one be its parent. This means that we 92 # can abort the loop when we have reached ourselves in the 93 # list of branches. Here the order of file::rev.mybranches 94 # comes into play, as created by file::rev::sortbranches. 95 96 if {$branch eq $self} break 97 $mysymbol possibleparent [$branch symbol] 98 } 99 return 100 } 101 102 method TagParents {} { 103 # The "obvious" parent of a tag is the branch holding the 104 # revision spawning the tag. Branches that are spawned by the 105 # same revision are also possible parents. 106 107 $mysymbol possibleparent [[$mytagrev lod] symbol] 108 109 foreach branch [$mytagrev branches] { 110 $mysymbol possibleparent [$branch symbol] 111 } 112 return 113 } 114 115 # 116 117 method istrunk {} { return 0 } 118 119 # Branch acessor methods. 120 121 method setchildrevnr {revnr} { 122 integrity assert {$mybranchchildrevnr eq ""} {Child already defined} 123 set mybranchchildrevnr $revnr 124 return 125 } 126 127 method setposition {n} { set mybranchposition $n ; return } 128 method setparent {rev} { set mybranchparent $rev ; return } 129 method setchild {rev} { set mybranchchild $rev ; return } 130 method cutchild {} { set mybranchchild "" ; return } 131 method cutbranchparent {} { set mybranchparent "" ; return } 132 133 method branchnr {} { return $mynr } 134 method parentrevnr {} { return $mybranchparentrevnr } 135 method childrevnr {} { return $mybranchchildrevnr } 136 method haschildrev {} { return [expr {$mybranchchildrevnr ne ""}] } 137 method haschild {} { return [expr {$mybranchchild ne ""}] } 138 method parent {} { return $mybranchparent } 139 method child {} { return $mybranchchild } 140 method position {} { return $mybranchposition } 141 142 # Tag acessor methods. 143 144 method tagrevnr {} { return $mynr } 145 method settagrev {rev} { set mytagrev $rev ; return } 146 147 # Derived information 148 149 method lod {} { return $mylod } 150 151 method setlod {lod} { 152 set mylod $lod 153 $self checklod 154 return 155 } 156 157 method checklod {} { 158 # Consistency check. The symbol's line-of-development has to 159 # be same as the line-of-development of its source (parent 160 # revision of a branch, revision of a tag itself). 161 162 switch -exact -- $mytype { 163 branch { 164 # However, ignore this if the branch symbol is 165 # detached. 166 if {$mybranchparent eq ""} return 167 168 set slod [$mybranchparent lod] 169 } 170 tag { set slod [$mytagrev lod] } 171 } 172 173 if {$mylod ne $slod} { 174 trouble fatal "For $mytype [$mysymbol name]: LOD conflict with source, '[$mylod name]' vs. '[$slod name]'" 175 return 176 } 177 return 178 } 179 180 # # ## ### ##### ######## ############# 181 182 method persist {} { 183 # Save the information we need after the collection pass. 184 185 set fid [$myfile id] 186 set sid [$mysymbol id] 187 set lod [$mylod id] 188 189 switch -exact -- $mytype { 190 tag { 191 set rid [$mytagrev id] 192 state transaction { 193 state run { 194 INSERT INTO tag ( tid, fid, lod, sid, rev) 195 VALUES ($myid, $fid, $lod, $sid, $rid); 196 } 197 } 198 } 199 branch { 200 lappend map @F@ [expr { ($mybranchchild eq "") ? "NULL" : [$mybranchchild id] }] 201 lappend map @P@ [expr { ($mybranchparent eq "") ? "NULL" : [$mybranchparent id] }] 202 203 set cmd { 204 INSERT INTO branch ( bid, fid, lod, sid, root, first, bra, pos ) 205 VALUES ($myid, $fid, $lod, $sid, @P@, @F@, $mynr, $mybranchposition); 206 } 207 state transaction { 208 state run [string map $map $cmd] 209 } 210 } 211 } 212 213 return 214 } 215 216 method DUMP {label} { 217 puts "$label = $self $mytype [$self name] \{" 218 switch -exact -- $mytype { 219 tag { 220 puts "\tR\t$mytagrev" 221 } 222 branch { 223 puts "\tP\t$mybranchparent" 224 puts "\tC\t$mybranchchild" 225 puts "\t\t<$mynr>" 226 } 227 } 228 puts "\}" 229 return 230 } 231 232 # # ## ### ##### ######## ############# 233 ## State 234 235 # Persistent: 236 # Tag: myid - tag.tid 237 # myfile - tag.fid 238 # mylod - tag.lod 239 # mysymbol - tag.sid 240 # mytagrev - tag.rev 241 # 242 # Branch: myid - branch.bid 243 # myfile - branch.fid 244 # mylod - branch.lod 245 # mysymbol - branch.sid 246 # mybranchparent - branch.root 247 # mybranchchild - branch.first 248 # mynr - branch.bra 249 250 typevariable myidcounter 0 ; # Counter for symbol ids. 251 variable myid {} ; # Symbol id. 252 253 ## Basic, all symbols _________________ 254 255 variable myfile {} ; # Reference to the file the symbol is in. 256 variable mytype {} ; # Symbol type, 'tag', or 'branch'. 257 variable mynr {} ; # Revision number of a 'tag', branch number 258 # of a 'branch'. 259 variable mysymbol {} ; # Reference to the symbol object of this 260 # symbol at the project level. 261 variable mylod {} ; # Reference to the line-of-development 262 # object the symbol belongs to. An 263 # alternative idiom would be to call it the 264 # branch the symbol is on. This reference 265 # is to a project-level object (symbol or 266 # trunk). 267 268 ## Branch symbols _____________________ 269 270 variable mybranchparentrevnr {} ; # The number of the parent 271 # revision, derived from our 272 # branch number (mynr). 273 variable mybranchparent {} ; # Reference to the revision 274 # (object) which spawns the 275 # branch. 276 variable mybranchchildrevnr {} ; # Number of the first revision 277 # committed on this branch. 278 variable mybranchchild {} ; # Reference to the revision 279 # (object) first committed on 280 # this branch. 281 variable mybranchposition {} ; # Relative id of the branch in 282 # the file, to sort into 283 # creation order. 284 285 ## Tag symbols ________________________ 286 287 variable mytagrev {} ; # Reference to the revision object the tag 288 # is on, identified by 'mynr'. 289 290 # ... nothing special ... (only mynr, see basic) 291 292 # # ## ### ##### ######## ############# 293 ## Internal methods 294 295 proc SetupBranch {} { 296 upvar 1 mybranchparentrevnr mybranchparentrevnr mynr mynr 297 set mybranchparentrevnr [rev 2branchparentrevnr $mynr] 298 return 299 } 300 301 # # ## ### ##### ######## ############# 302 ## Configuration 303 304 pragma -hastypeinfo no ; # no type introspection 305 pragma -hasinfo no ; # no object introspection 306 pragma -hastypemethods no ; # type is not relevant. 307 308 # # ## ### ##### ######## ############# 309} 310 311namespace eval ::vc::fossil::import::cvs::file { 312 namespace export sym 313 namespace eval sym { 314 namespace import ::vc::fossil::import::cvs::file::rev 315 namespace import ::vc::fossil::import::cvs::state 316 namespace import ::vc::fossil::import::cvs::integrity 317 namespace import ::vc::tools::trouble 318 } 319} 320 321# # ## ### ##### ######## ############# ##################### 322## Ready 323 324package provide vc::fossil::import::cvs::file::sym 1.0 325return 326