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