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