|
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
|
## Repository manager. Keeps projects and their files around. |
|
14
|
|
|
15
|
package provide vc::fossil::import::cvs::repository 1.0 |
|
16
|
|
|
17
|
# # ## ### ##### ######## ############# ##################### |
|
18
|
## Requirements |
|
19
|
|
|
20
|
package require Tcl 8.4 ; # Required runtime. |
|
21
|
package require snit ; # OO system. |
|
22
|
package require vc::tools::trouble ; # Error reporting. |
|
23
|
package require vc::tools::log ; # User feedback. |
|
24
|
package require vc::tools::misc ; # Text formatting. |
|
25
|
package require vc::tools::id ; # Indexing and id generation. |
|
26
|
package require vc::fossil::import::cvs::project ; # CVS projects. |
|
27
|
package require vc::fossil::import::cvs::state ; # State storage. |
|
28
|
package require struct::list ; # List operations. |
|
29
|
package require fileutil ; # File operations. |
|
30
|
|
|
31
|
# # ## ### ##### ######## ############# ##################### |
|
32
|
## |
|
33
|
|
|
34
|
snit::type ::vc::fossil::import::cvs::repository { |
|
35
|
# # ## ### ##### ######## ############# |
|
36
|
## Public API |
|
37
|
|
|
38
|
typemethod base {path} { |
|
39
|
# Could be checked, easier to defer to the overall validation. |
|
40
|
set mybase $path |
|
41
|
return |
|
42
|
} |
|
43
|
|
|
44
|
typemethod add {path} { |
|
45
|
# Most things cannot be checked immediately, as the base is |
|
46
|
# not known while projects are added. We can and do check for |
|
47
|
# uniqueness. We accept multiple occurences of a name, and |
|
48
|
# treat them as a single project. |
|
49
|
|
|
50
|
if {[lsearch -exact $myprojpaths $path] >= 0} return |
|
51
|
lappend myprojpaths $path |
|
52
|
return |
|
53
|
} |
|
54
|
|
|
55
|
typemethod trunkonly! {} { set mytrunkonly 1 ; return } |
|
56
|
typemethod trunkonly {} { return $mytrunkonly } |
|
57
|
|
|
58
|
typemethod projects {} { |
|
59
|
return [TheProjects] |
|
60
|
} |
|
61
|
|
|
62
|
typemethod base? {} { return $mybase } |
|
63
|
|
|
64
|
typemethod validate {} { |
|
65
|
if {![IsRepositoryBase $mybase msg]} { |
|
66
|
trouble fatal $msg |
|
67
|
# Without a good base directory checking any projects is |
|
68
|
# wasted time, so we leave now. |
|
69
|
return |
|
70
|
} |
|
71
|
foreach pp $myprojpaths { |
|
72
|
if {![IsProjectBase $mybase/$pp $mybase/CVSROOT msg]} { |
|
73
|
trouble fatal $msg |
|
74
|
} |
|
75
|
} |
|
76
|
return |
|
77
|
} |
|
78
|
|
|
79
|
typemethod defauthor {a} { $myauthor put $a } |
|
80
|
typemethod defcmessage {cm} { $mycmsg put $cm } |
|
81
|
typemethod defsymbol {pid name} { $mysymbol put [list $pid $name] } |
|
82
|
typemethod defmeta {pid bid aid cid} { $mymeta put [list $pid $bid $aid $cid] } |
|
83
|
|
|
84
|
typemethod commitmessageof {mid} { |
|
85
|
struct::list assign [$mymeta keyof $mid] pid bid aid cid |
|
86
|
return [$mycmsg keyof $cid] |
|
87
|
} |
|
88
|
|
|
89
|
typemethod getmeta {mid} { |
|
90
|
struct::list assign [$mymeta keyof $mid] pid bid aid cid |
|
91
|
return [list \ |
|
92
|
$myprojmap($pid) \ |
|
93
|
[$mysymbol keyof $bid] \ |
|
94
|
[$myauthor keyof $aid] \ |
|
95
|
[$mycmsg keyof $cid]] |
|
96
|
} |
|
97
|
|
|
98
|
# pass I results |
|
99
|
typemethod printstatistics {} { |
|
100
|
set prlist [TheProjects] |
|
101
|
set npr [llength $prlist] |
|
102
|
|
|
103
|
log write 2 repository "Statistics: Scanned [nsp $npr project]" |
|
104
|
|
|
105
|
if {$npr > 1} { |
|
106
|
set bmax [max [struct::list map $prlist [myproc .BaseLength]]] |
|
107
|
incr bmax 2 |
|
108
|
set bfmt %-${bmax}s |
|
109
|
|
|
110
|
set nmax [max [struct::list map $prlist [myproc .NFileLength]]] |
|
111
|
set nfmt %${nmax}s |
|
112
|
} else { |
|
113
|
set bfmt %s |
|
114
|
set nfmt %s |
|
115
|
} |
|
116
|
|
|
117
|
set keep {} |
|
118
|
foreach p $prlist { |
|
119
|
set nfiles [llength [$p filenames]] |
|
120
|
set line "Statistics: Project [format $bfmt \"[$p printbase]\"] : [format $nfmt $nfiles] [sp $nfiles file]" |
|
121
|
if {$nfiles < 1} { |
|
122
|
append line ", dropped" |
|
123
|
} else { |
|
124
|
lappend keep $p |
|
125
|
} |
|
126
|
log write 2 repository $line |
|
127
|
} |
|
128
|
|
|
129
|
if {![llength $keep]} { |
|
130
|
trouble warn "Dropped all projects" |
|
131
|
} elseif {$npr == [llength $keep]} { |
|
132
|
log write 2 repository "Keeping all projects" |
|
133
|
} else { |
|
134
|
log write 2 repository "Keeping [nsp [llength $keep] project]" |
|
135
|
trouble warn "Dropped [nsp [expr {$npr - [llength $keep]}] {empty project}]" |
|
136
|
} |
|
137
|
|
|
138
|
# Keep reduced set of projects. |
|
139
|
set projects $keep |
|
140
|
return |
|
141
|
} |
|
142
|
|
|
143
|
# pass I persistence |
|
144
|
typemethod persist {} { |
|
145
|
::variable myprojmap |
|
146
|
state transaction { |
|
147
|
foreach p [TheProjects] { |
|
148
|
$p persist |
|
149
|
set myprojmap([$p id]) $p |
|
150
|
} |
|
151
|
} |
|
152
|
return |
|
153
|
} |
|
154
|
|
|
155
|
typemethod load {} { |
|
156
|
state transaction { |
|
157
|
state foreachrow { |
|
158
|
SELECT pid, name FROM project ; |
|
159
|
} { |
|
160
|
set project [project %AUTO% $name $type] |
|
161
|
|
|
162
|
lappend myprojpaths $name |
|
163
|
lappend myprojects $project |
|
164
|
set myprojmap($pid) $project |
|
165
|
$project setid $pid |
|
166
|
} |
|
167
|
state foreachrow { |
|
168
|
SELECT fid, pid, name, visible, exec FROM file ; |
|
169
|
} { |
|
170
|
$myprojmap($pid) addfile $name $visible $exec $fid |
|
171
|
} |
|
172
|
} |
|
173
|
return |
|
174
|
} |
|
175
|
|
|
176
|
# pass II results |
|
177
|
typemethod printrevstatistics {} { |
|
178
|
log write 2 repository "Revision statistics" |
|
179
|
# number of revisions, symbols, repository wide, and per project ... |
|
180
|
|
|
181
|
set rcount [state one { SELECT COUNT (*) FROM revision }] |
|
182
|
set tcount [state one { SELECT COUNT (*) FROM tag }] |
|
183
|
set bcount [state one { SELECT COUNT (*) FROM branch }] |
|
184
|
set scount [state one { SELECT COUNT (*) FROM symbol }] |
|
185
|
set acount [state one { SELECT COUNT (*) FROM author }] |
|
186
|
set ccount [state one { SELECT COUNT (*) FROM cmessage }] |
|
187
|
set fmt %[string length [max [list $rcount $tcount $bcount $scount $acount $ccount]]]s |
|
188
|
|
|
189
|
log write 2 repository "Statistics: [format $fmt $rcount] [sp $rcount revision]" |
|
190
|
log write 2 repository "Statistics: [format $fmt $tcount] [sp $tcount tag]" |
|
191
|
log write 2 repository "Statistics: [format $fmt $bcount] [sp $bcount branch branches]" |
|
192
|
log write 2 repository "Statistics: [format $fmt $scount] [sp $scount symbol]" |
|
193
|
log write 2 repository "Statistics: [format $fmt $acount] [sp $acount author]" |
|
194
|
log write 2 repository "Statistics: [format $fmt $ccount] [sp $ccount {log message}]" |
|
195
|
|
|
196
|
set prlist [TheProjects] |
|
197
|
set npr [llength $prlist] |
|
198
|
|
|
199
|
if {$npr > 1} { |
|
200
|
set bmax [max [struct::list map $prlist [myproc .BaseLength]]] |
|
201
|
incr bmax 2 |
|
202
|
set bfmt %-${bmax}s |
|
203
|
} else { |
|
204
|
set bfmt %s |
|
205
|
} |
|
206
|
|
|
207
|
foreach p $prlist { |
|
208
|
set pid [$p id] |
|
209
|
set prefix "Project [format $bfmt \"[$p printbase]\"]" |
|
210
|
regsub -all {[^ ]} $prefix { } blanks |
|
211
|
set sep " : " |
|
212
|
|
|
213
|
set rcount [state one { SELECT COUNT (*) FROM revision R, file F WHERE R.fid = F.fid AND F.pid = $pid }] |
|
214
|
set tcount [state one { SELECT COUNT (*) FROM tag T, file F WHERE T.fid = F.fid AND F.pid = $pid }] |
|
215
|
set bcount [state one { SELECT COUNT (*) FROM branch B, file F WHERE B.fid = F.fid AND F.pid = $pid }] |
|
216
|
set scount [state one { SELECT COUNT (*) FROM symbol WHERE pid = $pid }] |
|
217
|
set acount [state one { SELECT COUNT (*) FROM author WHERE aid IN (SELECT DISTINCT aid FROM meta WHERE pid = $pid) }] |
|
218
|
set ccount [state one { SELECT COUNT (*) FROM cmessage WHERE cid IN (SELECT DISTINCT cid FROM meta WHERE pid = $pid) }] |
|
219
|
|
|
220
|
log write 2 repository "Statistics: $prefix$sep[format $fmt $rcount] [sp $rcount revision]" |
|
221
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $tcount] [sp $tcount tag]" |
|
222
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $bcount] [sp $bcount branch branches]" |
|
223
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $scount] [sp $scount symbol]" |
|
224
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $acount] [sp $acount author]" |
|
225
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $ccount] [sp $ccount {log message}]" |
|
226
|
} |
|
227
|
return |
|
228
|
} |
|
229
|
|
|
230
|
# pass II persistence |
|
231
|
typemethod persistrev {} { |
|
232
|
state transaction { |
|
233
|
SaveAuthors |
|
234
|
SaveCommitMessages |
|
235
|
# TODO: Save symbols of all projects (before the revisions |
|
236
|
# in the projects, as they are referenced by the meta |
|
237
|
# tuples) |
|
238
|
SaveMeta |
|
239
|
foreach p [TheProjects] { $p persistrev } |
|
240
|
} |
|
241
|
return |
|
242
|
} |
|
243
|
|
|
244
|
typemethod loadsymbols {} { |
|
245
|
state transaction { |
|
246
|
# We load the symbol ids at large to have the mapping |
|
247
|
# right from the beginning. |
|
248
|
|
|
249
|
state foreachrow { |
|
250
|
SELECT sid, pid, name, tag_count AS tc, branch_count AS bc, commit_count AS cc |
|
251
|
FROM symbol |
|
252
|
} { |
|
253
|
$mysymbol map $sid [list $pid $name] |
|
254
|
set project $myprojmap($pid) |
|
255
|
|
|
256
|
set force [$project hassymbol $name] |
|
257
|
set symbol [$project getsymbol $name] |
|
258
|
|
|
259
|
# Forcing happens only for the trunks. |
|
260
|
if {$force} { $symbol forceid $sid } |
|
261
|
|
|
262
|
# Set the loaded counts. |
|
263
|
$symbol defcounts $tc $bc $cc |
|
264
|
|
|
265
|
# Note: The type is neither retrieved nor set, for |
|
266
|
# this is used to load the pass II data, which means |
|
267
|
# that everything is 'undefined' at this point anyway. |
|
268
|
|
|
269
|
# future: $symbol load (blockers, and parents) |
|
270
|
} |
|
271
|
|
|
272
|
# Beyond the symbols we also load the author, commit log, |
|
273
|
# and meta information. |
|
274
|
|
|
275
|
state foreachrow { |
|
276
|
SELECT aid, name AS aname FROM author |
|
277
|
} { |
|
278
|
$myauthor map $aid $aname |
|
279
|
} |
|
280
|
state foreachrow { |
|
281
|
SELECT cid, text FROM cmessage |
|
282
|
} { |
|
283
|
$mycmsg map $cid $text |
|
284
|
} |
|
285
|
state foreachrow { |
|
286
|
SELECT mid, pid, bid, aid, cid FROM meta |
|
287
|
} { |
|
288
|
$mymeta map $mid [list $pid $bid $aid $cid] |
|
289
|
} |
|
290
|
} |
|
291
|
return |
|
292
|
} |
|
293
|
|
|
294
|
typemethod determinesymboltypes {} { |
|
295
|
foreach project [TheProjects] { |
|
296
|
$project determinesymboltypes |
|
297
|
} |
|
298
|
return |
|
299
|
} |
|
300
|
|
|
301
|
typemethod projectof {pid} { |
|
302
|
return $myprojmap($pid) |
|
303
|
} |
|
304
|
|
|
305
|
|
|
306
|
# pass IV+ results |
|
307
|
typemethod printcsetstatistics {} { |
|
308
|
log write 2 repository "Changeset statistics" |
|
309
|
# number of revisions, symbols, repository wide, and per project ... |
|
310
|
|
|
311
|
set ccount [state one { SELECT COUNT (*) FROM changeset }] |
|
312
|
set rcount [state one { SELECT COUNT (*) FROM changeset WHERE type = 0 }] |
|
313
|
set tcount [state one { SELECT COUNT (*) FROM changeset WHERE type = 1 }] |
|
314
|
set bcount [state one { SELECT COUNT (*) FROM changeset WHERE type = 2 }] |
|
315
|
set fmt %[string length [max [list $ccount $rcount $tcount $bcount]]]s |
|
316
|
|
|
317
|
log write 2 repository "Statistics: [format $fmt $ccount] [sp $ccount changeset]" |
|
318
|
log write 2 repository "Statistics: [format $fmt $rcount] [sp $rcount {revision changeset}]" |
|
319
|
log write 2 repository "Statistics: [format $fmt $tcount] [sp $tcount {tag symbol changeset}]" |
|
320
|
log write 2 repository "Statistics: [format $fmt $bcount] [sp $bcount {branch symbol changeset}]" |
|
321
|
|
|
322
|
set prlist [TheProjects] |
|
323
|
set npr [llength $prlist] |
|
324
|
|
|
325
|
if {$npr > 1} { |
|
326
|
set bmax [max [struct::list map $prlist [myproc .BaseLength]]] |
|
327
|
incr bmax 2 |
|
328
|
set bfmt %-${bmax}s |
|
329
|
} else { |
|
330
|
set bfmt %s |
|
331
|
} |
|
332
|
|
|
333
|
foreach p $prlist { |
|
334
|
set pid [$p id] |
|
335
|
set prefix "Project [format $bfmt \"[$p printbase]\"]" |
|
336
|
regsub -all {[^ ]} $prefix { } blanks |
|
337
|
set sep " : " |
|
338
|
|
|
339
|
set ccount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid }] |
|
340
|
set rcount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid AND type = 0 }] |
|
341
|
set tcount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid AND type = 1 }] |
|
342
|
set bcount [state one { SELECT COUNT (*) FROM changeset WHERE pid = $pid AND type = 2 }] |
|
343
|
|
|
344
|
log write 2 repository "Statistics: $prefix$sep[format $fmt $ccount] [sp $ccount changeset]" |
|
345
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $rcount] [sp $rcount {revision changeset}]" |
|
346
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $tcount] [sp $tcount {tag symbol changeset}]" |
|
347
|
log write 2 repository "Statistics: $blanks$sep[format $fmt $bcount] [sp $bcount {branch symbol changeset}]" |
|
348
|
} |
|
349
|
return |
|
350
|
} |
|
351
|
|
|
352
|
# # ## ### ##### ######## ############# |
|
353
|
## State |
|
354
|
|
|
355
|
typevariable mybase {} ; # Base path to CVS repository. |
|
356
|
typevariable myprojpaths {} ; # List of paths to all declared |
|
357
|
# projects, relative to mybase. |
|
358
|
typevariable myprojects {} ; # List of objects for all |
|
359
|
# declared projects. |
|
360
|
typevariable myprojmap -array {} ; # Map from project ids to their |
|
361
|
# objects. |
|
362
|
typevariable myauthor {} ; # Names of all authors found, |
|
363
|
# maps to their ids. |
|
364
|
typevariable mycmsg {} ; # All commit messages found, |
|
365
|
# maps to their ids. |
|
366
|
typevariable mymeta {} ; # Maps all meta data tuples |
|
367
|
# (project, branch, author, |
|
368
|
# cmessage) to their ids. |
|
369
|
typevariable mysymbol {} ; # Map symbols identified by |
|
370
|
# project and name to their |
|
371
|
# id. This information is not |
|
372
|
# saved directly. |
|
373
|
typevariable mytrunkonly 0 ; # Boolean flag. Set by option |
|
374
|
# processing when the user |
|
375
|
# requested a trunk-only import |
|
376
|
|
|
377
|
# # ## ### ##### ######## ############# |
|
378
|
## Internal methods |
|
379
|
|
|
380
|
typeconstructor { |
|
381
|
set myauthor [vc::tools::id %AUTO%] |
|
382
|
set mycmsg [vc::tools::id %AUTO%] |
|
383
|
set mymeta [vc::tools::id %AUTO%] |
|
384
|
set mysymbol [vc::tools::id %AUTO%] |
|
385
|
return |
|
386
|
} |
|
387
|
|
|
388
|
proc .BaseLength {p} { |
|
389
|
return [string length [$p printbase]] |
|
390
|
} |
|
391
|
|
|
392
|
proc .NFileLength {p} { |
|
393
|
return [string length [llength [$p filenames]]] |
|
394
|
} |
|
395
|
|
|
396
|
proc IsRepositoryBase {path mv} { |
|
397
|
::variable mybase |
|
398
|
upvar 1 $mv msg |
|
399
|
if {![fileutil::test $mybase edr msg {CVS Repository}]} {return 0} |
|
400
|
if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0} |
|
401
|
return 1 |
|
402
|
} |
|
403
|
|
|
404
|
proc IsProjectBase {path admin mv} { |
|
405
|
upvar 1 $mv msg |
|
406
|
if {![fileutil::test $path edr msg Project]} {return 0} |
|
407
|
if { |
|
408
|
($path eq $admin) || |
|
409
|
[string match $admin/* $path] |
|
410
|
} { |
|
411
|
set msg "Administrative subdirectory $path cannot be a project" |
|
412
|
return 0 |
|
413
|
} |
|
414
|
return 1 |
|
415
|
} |
|
416
|
|
|
417
|
proc TheProjects {} { |
|
418
|
upvar 1 type type |
|
419
|
::variable myprojects |
|
420
|
::variable myprojpaths |
|
421
|
|
|
422
|
if {![llength $myprojects]} { |
|
423
|
set myprojects [EmptyProjects $myprojpaths] |
|
424
|
} |
|
425
|
return $myprojects |
|
426
|
} |
|
427
|
|
|
428
|
proc EmptyProjects {projpaths} { |
|
429
|
::variable mybase |
|
430
|
upvar 1 type type |
|
431
|
set res {} |
|
432
|
if {[llength $projpaths]} { |
|
433
|
foreach pp $projpaths { |
|
434
|
lappend res [project %AUTO% $pp $type] |
|
435
|
} |
|
436
|
} else { |
|
437
|
# Base is the single project. |
|
438
|
lappend res [project %AUTO% "" $type] |
|
439
|
} |
|
440
|
return $res |
|
441
|
} |
|
442
|
|
|
443
|
proc SaveAuthors {} { |
|
444
|
::variable myauthor |
|
445
|
foreach {name aid} [$myauthor get] { |
|
446
|
state run { |
|
447
|
INSERT INTO author ( aid, name) |
|
448
|
VALUES ($aid, $name); |
|
449
|
} |
|
450
|
} |
|
451
|
return |
|
452
|
} |
|
453
|
|
|
454
|
proc SaveCommitMessages {} { |
|
455
|
::variable mycmsg |
|
456
|
foreach {text cid} [$mycmsg get] { |
|
457
|
state run { |
|
458
|
INSERT INTO cmessage ( cid, text) |
|
459
|
VALUES ($cid, $text); |
|
460
|
} |
|
461
|
} |
|
462
|
return |
|
463
|
} |
|
464
|
|
|
465
|
proc SaveMeta {} { |
|
466
|
::variable mymeta |
|
467
|
foreach {key mid} [$mymeta get] { |
|
468
|
struct::list assign $key pid bid aid cid |
|
469
|
state run { |
|
470
|
INSERT INTO meta ( mid, pid, bid, aid, cid) |
|
471
|
VALUES ($mid, $pid, $bid, $aid, $cid); |
|
472
|
} |
|
473
|
} |
|
474
|
return |
|
475
|
} |
|
476
|
|
|
477
|
# # ## ### ##### ######## ############# |
|
478
|
## Configuration |
|
479
|
|
|
480
|
pragma -hasinstances no ; # singleton |
|
481
|
pragma -hastypeinfo no ; # no introspection |
|
482
|
pragma -hastypedestroy no ; # immortal |
|
483
|
|
|
484
|
# # ## ### ##### ######## ############# |
|
485
|
} |
|
486
|
|
|
487
|
namespace eval ::vc::fossil::import::cvs { |
|
488
|
namespace export repository |
|
489
|
namespace eval repository { |
|
490
|
namespace import ::vc::fossil::import::cvs::project |
|
491
|
namespace import ::vc::fossil::import::cvs::state |
|
492
|
namespace import ::vc::tools::misc::* |
|
493
|
namespace import ::vc::tools::id |
|
494
|
namespace import ::vc::tools::trouble |
|
495
|
namespace import ::vc::tools::log |
|
496
|
log register repository |
|
497
|
} |
|
498
|
} |
|
499
|
|
|
500
|
# # ## ### ##### ######## ############# ##################### |
|
501
|
## Ready |
|
502
|
return |
|
503
|
|