|
1
|
#!/bin/sh |
|
2
|
## -*- tcl -*- \ |
|
3
|
exec tclsh "$0" ${1+"$@"} |
|
4
|
|
|
5
|
# # ## ### ##### ######## ############# ##################### |
|
6
|
## Copyright (c) 2007 Andreas Kupries. |
|
7
|
# |
|
8
|
# This software is licensed as described in the file LICENSE, which |
|
9
|
# you should have received as part of this distribution. |
|
10
|
# |
|
11
|
# This software consists of voluntary contributions made by many |
|
12
|
# individuals. For exact contribution history, see the revision |
|
13
|
# history and logs, available at http://fossil-scm.hwaci.com/fossil |
|
14
|
# # ## ### ##### ######## ############# ##################### |
|
15
|
|
|
16
|
## Helper application, debugging of cvs2fossil. This application |
|
17
|
## extracts the tree of revisions for a file of interest, specified |
|
18
|
## either directly through its id, or indirectly through the id of a |
|
19
|
## revision it contains, and generates a nice graphical representation |
|
20
|
## of it (png image). It uses GraphiViz's 'dot' tool to do all the |
|
21
|
## layouting. |
|
22
|
|
|
23
|
# # ## ### ##### ######## ############# ##################### |
|
24
|
## Requirements, extended package management for local packages. |
|
25
|
|
|
26
|
lappend auto_path [file join [file dirname [info script]] lib] |
|
27
|
|
|
28
|
package require Tcl 8.4 ; # Required runtime. |
|
29
|
package require struct::graph ; # Graph handling. |
|
30
|
package require struct::list ; # Higher order list ops. |
|
31
|
package require vc::fossil::import::cvs::project::rev ; # Changesets |
|
32
|
package require vc::fossil::import::cvs::state ; # State storage. |
|
33
|
package require vc::tools::misc ; # Min/max. |
|
34
|
package require vc::tools::dot ; # Graph export to DOT. |
|
35
|
package require vc::tools::trouble ; # Error reporting |
|
36
|
package require vc::tools::log ; # User feedback |
|
37
|
|
|
38
|
namespace import ::vc::fossil::import::cvs::state |
|
39
|
namespace import ::vc::fossil::import::cvs::project::rev |
|
40
|
namespace import ::vc::tools::dot |
|
41
|
namespace import ::vc::tools::trouble |
|
42
|
namespace import ::vc::tools::log |
|
43
|
namespace import ::vc::tools::misc::* |
|
44
|
|
|
45
|
log verbosity 0 |
|
46
|
|
|
47
|
# Process the command line, i.e. get the database to access, and file |
|
48
|
# of interest. The latter can be specified by name, id, or indirectly |
|
49
|
# through the id of one of the revisions it contains. |
|
50
|
|
|
51
|
state use [lindex $argv 0] |
|
52
|
state reading project |
|
53
|
state reading file |
|
54
|
state reading revision |
|
55
|
state reading revisionbranchchildren |
|
56
|
state reading changeset |
|
57
|
state reading csitem |
|
58
|
state reading csorder |
|
59
|
|
|
60
|
set what [lindex $argv 1] |
|
61
|
set centralrid -1 |
|
62
|
|
|
63
|
switch -exact -- $what { |
|
64
|
rid { |
|
65
|
# Get the revision of interest, identified by the internal |
|
66
|
# numeric id used by cvs2fossil. |
|
67
|
set centralrid [lindex $argv 2] |
|
68
|
|
|
69
|
puts "Revision : [state one { SELECT rev FROM revision WHERE rid = $centralrid }] ($centralrid)" |
|
70
|
|
|
71
|
# Map it to the file containing the revision of interest. |
|
72
|
set fid [state one { SELECT fid FROM revision WHERE rid = $centralrid }] |
|
73
|
} |
|
74
|
fid { |
|
75
|
# Get the file of interest, identified by internal numeric id |
|
76
|
# used by cvs2fossil. |
|
77
|
set fid [lindex $argv 2] |
|
78
|
} |
|
79
|
fname { |
|
80
|
# Get the file of interest, identified by its name. |
|
81
|
|
|
82
|
set fname [lindex $argv 2] |
|
83
|
set fid [state one { SELECT fid FROM file WHERE name == $fname }] |
|
84
|
} |
|
85
|
default { |
|
86
|
trouble fatal \ |
|
87
|
"Unknown spec \"$what\", expected one of \"fid\", \"fname\", or \"rid\"" |
|
88
|
} |
|
89
|
} |
|
90
|
trouble abort? |
|
91
|
|
|
92
|
set pid [state one { SELECT pid FROM file WHERE fid == $fid }] |
|
93
|
|
|
94
|
puts "File : [state one { SELECT name FROM file WHERE fid = $fid }] ($fid)" |
|
95
|
puts "Project : [state one { SELECT name FROM project WHERE pid = $pid }] ($pid)" |
|
96
|
|
|
97
|
# Get the data of all revisions in the file of interest, as a list for |
|
98
|
# iteration, and as array for random access of neighbouring revisions. |
|
99
|
|
|
100
|
array set rev {} |
|
101
|
foreach {rid revnr lod date isdefault} [set revisions [state run { |
|
102
|
SELECT R.rid, R.rev, S.name, R.date, R.isdefault |
|
103
|
FROM revision R, symbol S |
|
104
|
WHERE R.fid = $fid |
|
105
|
AND R.lod = S.sid |
|
106
|
}]] { |
|
107
|
set cs [state run { |
|
108
|
SELECT CR.cid, CO.pos, CT.name |
|
109
|
FROM csitem CR, csorder CO, cstype CT, changeset C |
|
110
|
WHERE CR.iid = $rid |
|
111
|
AND CR.cid = CO.cid |
|
112
|
AND CR.cid = C.cid |
|
113
|
AND CT.tid = C.type |
|
114
|
}] |
|
115
|
|
|
116
|
set rev($rid) [list $revnr $lod $date $isdefault $cs] |
|
117
|
} |
|
118
|
|
|
119
|
puts "#Revs : [array size rev]" |
|
120
|
|
|
121
|
# Start the graph |
|
122
|
|
|
123
|
struct::graph dg |
|
124
|
|
|
125
|
# Convert the revisions into nodes of the graph, and use node |
|
126
|
# attributes to highlight various pieces of interest for the dot |
|
127
|
# conversion. Label => Revnr, Symbol (LOD), Changeset id (if |
|
128
|
# available), formatted date. Background fill colors to show the |
|
129
|
# different branches ?. |
|
130
|
|
|
131
|
foreach {rid revnr lod date isdefault} $revisions { |
|
132
|
set label "$rid = <$revnr> @ $lod / [clock format $date]" |
|
133
|
set cs [lindex $rev($rid) 4] |
|
134
|
if {[llength $cs]} { |
|
135
|
foreach {cs ord cstype} $cs { |
|
136
|
append label "\\nCS/${cstype}($cs) @$ord" |
|
137
|
} |
|
138
|
} |
|
139
|
set key [list rev $rid] |
|
140
|
dg node insert $key |
|
141
|
dg node set $key label $label |
|
142
|
dg node set $key shape [expr {$isdefault ? "diamond" : "box"}] |
|
143
|
} |
|
144
|
|
|
145
|
# Go through the revisions a second time and set up the arcs based on |
|
146
|
# the stored successor information. |
|
147
|
|
|
148
|
::vc::fossil::import::cvs::project::rev::rev successors dep [array names rev] |
|
149
|
|
|
150
|
proc Ord {cmd rid} {return 0 |
|
151
|
global rev |
|
152
|
set ords {} |
|
153
|
foreach {cs ord cstype} [lindex $rev($rid) 4] { lappend ords $ord } |
|
154
|
return [$cmd $ords] |
|
155
|
} |
|
156
|
|
|
157
|
foreach {rid children} [array get dep] { |
|
158
|
set max [Ord max $rid] |
|
159
|
|
|
160
|
foreach child $children { |
|
161
|
if {[catch { |
|
162
|
set a [dg arc insert $rid $child] |
|
163
|
}]} continue |
|
164
|
|
|
165
|
if {$max > [Ord min $child]} { |
|
166
|
puts "Backward : $rid -> $child" |
|
167
|
dg arc set $a color red |
|
168
|
} |
|
169
|
} |
|
170
|
} |
|
171
|
|
|
172
|
# Convert the graph to dot, then run the layouter and convert to png, |
|
173
|
# at last show the image. |
|
174
|
|
|
175
|
vc::tools::dot layout png dg SymbolTree st.png |
|
176
|
exec display st.png |
|
177
|
file delete st.png |
|
178
|
exit |
|
179
|
|