|
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
|
## Project, part of a CVS repository. Multiple instances are possible. |
|
14
|
|
|
15
|
# # ## ### ##### ######## ############# ##################### |
|
16
|
## Requirements |
|
17
|
|
|
18
|
package require Tcl 8.4 ; # Required runtime. |
|
19
|
package require snit ; # OO system. |
|
20
|
package require vc::fossil::import::cvs::file ; # CVS archive file. |
|
21
|
package require vc::fossil::import::cvs::state ; # State storage. |
|
22
|
package require vc::fossil::import::cvs::project::rev ; # Changesets. |
|
23
|
package require vc::fossil::import::cvs::project::sym ; # Per project symbols. |
|
24
|
package require vc::fossil::import::cvs::project::trunk ; # Per project trunk, main lod |
|
25
|
package require vc::tools::log ; # User feedback |
|
26
|
package require struct::list ; # Advanced list operations.. |
|
27
|
|
|
28
|
# # ## ### ##### ######## ############# ##################### |
|
29
|
## |
|
30
|
|
|
31
|
snit::type ::vc::fossil::import::cvs::project { |
|
32
|
# # ## ### ##### ######## ############# |
|
33
|
## Public API |
|
34
|
|
|
35
|
constructor {path r} { |
|
36
|
set mybase $path |
|
37
|
set myrepository $r |
|
38
|
set mytrunk [trunk %AUTO% $self] |
|
39
|
set mysymbol([$mytrunk name]) $mytrunk |
|
40
|
return |
|
41
|
} |
|
42
|
|
|
43
|
method base {} { return $mybase } |
|
44
|
method trunk {} { return $mytrunk } |
|
45
|
|
|
46
|
method fullpath {} { return [$myrepository base?]/$mybase } |
|
47
|
|
|
48
|
method printbase {} { |
|
49
|
if {$mybase eq ""} {return <Repository>} |
|
50
|
return $mybase |
|
51
|
} |
|
52
|
|
|
53
|
method id {} { return $myid } |
|
54
|
method setid {id} { set myid $id ; return } |
|
55
|
|
|
56
|
method addfile {rcs usr executable {fid {}}} { |
|
57
|
set myfiles($rcs) [list $usr $executable $fid] |
|
58
|
return |
|
59
|
} |
|
60
|
|
|
61
|
method filenames {} { |
|
62
|
return [lsort -dict [array names myfiles]] |
|
63
|
} |
|
64
|
|
|
65
|
method files {} { |
|
66
|
return [TheFiles] |
|
67
|
} |
|
68
|
|
|
69
|
delegate method defauthor to myrepository |
|
70
|
delegate method defcmessage to myrepository |
|
71
|
delegate method trunkonly to myrepository |
|
72
|
delegate method commitmessageof to myrepository |
|
73
|
|
|
74
|
method defmeta {bid aid cid} { |
|
75
|
return [$myrepository defmeta $myid $bid $aid $cid] |
|
76
|
} |
|
77
|
|
|
78
|
method getsymbol {name} { |
|
79
|
if {![info exists mysymbol($name)]} { |
|
80
|
set mysymbol($name) \ |
|
81
|
[sym %AUTO% $name [$myrepository defsymbol $myid $name] $self] |
|
82
|
} |
|
83
|
return $mysymbol($name) |
|
84
|
} |
|
85
|
|
|
86
|
method hassymbol {name} { |
|
87
|
return [info exists mysymbol($name)] |
|
88
|
} |
|
89
|
|
|
90
|
method purgeghostsymbols {} { |
|
91
|
set changes 1 |
|
92
|
while {$changes} { |
|
93
|
set changes 0 |
|
94
|
foreach {name symbol} [array get mysymbol] { |
|
95
|
if {![$symbol isghost]} continue |
|
96
|
log write 3 project "$mybase: Deleting ghost symbol '$name'" |
|
97
|
$symbol destroy |
|
98
|
unset mysymbol($name) |
|
99
|
set changes 1 |
|
100
|
} |
|
101
|
} |
|
102
|
return |
|
103
|
} |
|
104
|
|
|
105
|
method determinesymboltypes {} { |
|
106
|
foreach {name symbol} [array get mysymbol] { |
|
107
|
$symbol determinetype |
|
108
|
} |
|
109
|
return |
|
110
|
} |
|
111
|
|
|
112
|
# pass I persistence |
|
113
|
method persist {} { |
|
114
|
TheFiles ; # Force id assignment. |
|
115
|
|
|
116
|
state transaction { |
|
117
|
# Project data first. Required so that we have its id |
|
118
|
# ready for the files. |
|
119
|
|
|
120
|
state run { |
|
121
|
INSERT INTO project (pid, name) |
|
122
|
VALUES (NULL, $mybase); |
|
123
|
} |
|
124
|
set myid [state id] |
|
125
|
|
|
126
|
# Then all files, with proper backreference to their |
|
127
|
# project. |
|
128
|
|
|
129
|
foreach rcs [lsort -dict [array names myfiles]] { |
|
130
|
struct::list assign $myfiles($rcs) usr executable _fid_ |
|
131
|
state run { |
|
132
|
INSERT INTO file (fid, pid, name, visible, exec) |
|
133
|
VALUES (NULL, $myid, $rcs, $usr, $executable); |
|
134
|
} |
|
135
|
$myfmap($rcs) setid [state id] |
|
136
|
} |
|
137
|
} |
|
138
|
return |
|
139
|
} |
|
140
|
|
|
141
|
# pass II persistence |
|
142
|
method persistrev {} { |
|
143
|
# Note: The per file information (incl. revisions and symbols) |
|
144
|
# has already been saved and dropped. This was done |
|
145
|
# immediately after processing it, i.e. as part of the main |
|
146
|
# segment of the pass, to keep out use of memory under |
|
147
|
# control. |
|
148
|
# |
|
149
|
# The repository level information has been saved as well too, |
|
150
|
# just before saving the projects started. So now we just have |
|
151
|
# to save the remaining project level parts to fix the |
|
152
|
# left-over dangling references, which are the symbols. |
|
153
|
|
|
154
|
state transaction { |
|
155
|
foreach {name symbol} [array get mysymbol] { |
|
156
|
$symbol persistrev |
|
157
|
} |
|
158
|
} |
|
159
|
return |
|
160
|
} |
|
161
|
|
|
162
|
method changesetsinorder {} { |
|
163
|
return [rev inorder $myid] |
|
164
|
} |
|
165
|
|
|
166
|
delegate method getmeta to myrepository |
|
167
|
|
|
168
|
# # ## ### ##### ######## ############# |
|
169
|
## State |
|
170
|
|
|
171
|
variable mybase {} ; # Project directory. |
|
172
|
variable myid {} ; # Project id in the persistent state. |
|
173
|
variable mytrunk {} ; # Reference to the main line of |
|
174
|
# development for the project. |
|
175
|
variable myfiles -array {} ; # Maps the rcs archive paths to |
|
176
|
# their user-visible files. |
|
177
|
variable myfobj {} ; # File objects for the rcs archives |
|
178
|
variable myfmap -array {} ; # Map rcs archive to their object. |
|
179
|
variable myrepository {} ; # Repository the project belongs to. |
|
180
|
variable mysymbol -array {} ; # Map symbol names to project-level |
|
181
|
# symbol objects. |
|
182
|
|
|
183
|
# # ## ### ##### ######## ############# |
|
184
|
## Internal methods |
|
185
|
|
|
186
|
proc TheFiles {} { |
|
187
|
upvar 1 myfiles myfiles myfobj myfobj self self myfmap myfmap |
|
188
|
if {![llength $myfobj]} { |
|
189
|
set myfobj [EmptyFiles myfiles] |
|
190
|
} |
|
191
|
return $myfobj |
|
192
|
} |
|
193
|
|
|
194
|
proc EmptyFiles {fv} { |
|
195
|
upvar 1 $fv myfiles self self myfmap myfmap |
|
196
|
set res {} |
|
197
|
foreach rcs [lsort -dict [array names myfiles]] { |
|
198
|
struct::list assign $myfiles($rcs) f executable fid |
|
199
|
set file [file %AUTO% $fid $rcs $f $executable $self] |
|
200
|
lappend res $file |
|
201
|
set myfmap($rcs) $file |
|
202
|
} |
|
203
|
return $res |
|
204
|
} |
|
205
|
|
|
206
|
# # ## ### ##### ######## ############# |
|
207
|
## Configuration |
|
208
|
|
|
209
|
pragma -hastypeinfo no ; # no type introspection |
|
210
|
pragma -hasinfo no ; # no object introspection |
|
211
|
pragma -hastypemethods no ; # type is not relevant. |
|
212
|
|
|
213
|
# # ## ### ##### ######## ############# |
|
214
|
} |
|
215
|
|
|
216
|
namespace eval ::vc::fossil::import::cvs { |
|
217
|
namespace export project |
|
218
|
namespace eval project { |
|
219
|
namespace import ::vc::tools::log |
|
220
|
namespace import ::vc::fossil::import::cvs::file |
|
221
|
namespace import ::vc::fossil::import::cvs::state |
|
222
|
# Import not required, already a child namespace. |
|
223
|
# namespace import ::vc::fossil::import::cvs::project::sym |
|
224
|
# Import not required, already a child namespace. |
|
225
|
# namespace import ::vc::fossil::import::cvs::project::rev |
|
226
|
} |
|
227
|
} |
|
228
|
|
|
229
|
# # ## ### ##### ######## ############# ##################### |
|
230
|
## Ready |
|
231
|
|
|
232
|
package provide vc::fossil::import::cvs::project 1.0 |
|
233
|
return |
|
234
|
|