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