1 | #!/usr/bin/perl -w |
---|
2 | # vim:ts=2:sw=2:expandtab |
---|
3 | # |
---|
4 | # svn-graph.pl - produce a GraphViz .dot graph for the branch history |
---|
5 | # of a node |
---|
6 | # |
---|
7 | # ==================================================================== |
---|
8 | # Copyright (c) 2000-2006 CollabNet. All rights reserved. |
---|
9 | # |
---|
10 | # This software is licensed as described in the file COPYING, which |
---|
11 | # you should have received as part of this distribution. The terms |
---|
12 | # are also available at http://subversion.tigris.org/license-1.html. |
---|
13 | # If newer versions of this license are posted there, you may use a |
---|
14 | # newer version instead, at your option. |
---|
15 | # |
---|
16 | # This software consists of voluntary contributions made by many |
---|
17 | # individuals. For exact contribution history, see the revision |
---|
18 | # history and logs, available at http://subversion.tigris.org/. |
---|
19 | # ==================================================================== |
---|
20 | # |
---|
21 | # View graphs using a command like: |
---|
22 | # |
---|
23 | # svn-graph.pl file:///tmp/repos | dotty - |
---|
24 | # |
---|
25 | # TODO: |
---|
26 | # - Calculate the repository root at runtime so the user can pass |
---|
27 | # the node of interest as a single URL. |
---|
28 | # - (Also?) produce the graphical output ourselves (SVG?) instead |
---|
29 | # of writing a GraphViz ".dot" data file. This can be done with |
---|
30 | # GraphViz using 'dot'. |
---|
31 | # - Display svnmerge.py/Subversion merge history. |
---|
32 | # |
---|
33 | |
---|
34 | use strict; |
---|
35 | use Getopt::Std; |
---|
36 | |
---|
37 | # Turn off output buffering |
---|
38 | $|=1; |
---|
39 | |
---|
40 | require SVN::Core; |
---|
41 | require SVN::Ra; |
---|
42 | require SVN::Client; |
---|
43 | |
---|
44 | # The URL of the Subversion repository we wish to graph |
---|
45 | # (e.g. "http://svn.collab.net/repos/svn"). |
---|
46 | my $repos_url; |
---|
47 | |
---|
48 | # The revision range we operate on, from $startrev -> $youngest. |
---|
49 | my $youngest; |
---|
50 | my $startrev; |
---|
51 | |
---|
52 | # This is the node we're interested in |
---|
53 | my $startpath; |
---|
54 | |
---|
55 | # Set the variables declared above. |
---|
56 | parse_commandline(); |
---|
57 | |
---|
58 | # Point at the root of a repository so we get can look at |
---|
59 | # every revision. |
---|
60 | my $auth = (new SVN::Client())->auth; |
---|
61 | my $ra = SVN::Ra->new(url => $repos_url, auth => $auth); |
---|
62 | |
---|
63 | # Handle identifier for the aboslutely youngest revision. |
---|
64 | if ($youngest eq 'HEAD') |
---|
65 | { |
---|
66 | $youngest = $ra->get_latest_revnum(); |
---|
67 | } |
---|
68 | |
---|
69 | # The "interesting" nodes are potential sources for copies. This list |
---|
70 | # grows as we move through time. |
---|
71 | # The "tracking" nodes are the most recent revisions of paths we're |
---|
72 | # following as we move through time. If we hit a delete of a path |
---|
73 | # we remove it from the tracking array (i.e. we're no longer interested |
---|
74 | # in it). |
---|
75 | my %interesting = ("$startpath:$startrev", 1); |
---|
76 | my %tracking = ("$startpath", $startrev); |
---|
77 | |
---|
78 | my %codeline_changes_forward = (); |
---|
79 | my %codeline_changes_back = (); |
---|
80 | my %copysource = (); |
---|
81 | my %copydest = (); |
---|
82 | |
---|
83 | write_graph_descriptor(); |
---|
84 | #print STDERR "\n"; |
---|
85 | |
---|
86 | |
---|
87 | |
---|
88 | # Validate the command-line arguments, and set the global variables |
---|
89 | # $repos_url, $youngest, $startrev, and $startpath. |
---|
90 | sub parse_commandline |
---|
91 | { |
---|
92 | my %cmd_opts; |
---|
93 | my $usage = " |
---|
94 | usage: svn-graph.pl [-r START_REV:END_REV] [-p PATH] REPOS_URL |
---|
95 | |
---|
96 | -r the revision range (defaults to 0 through HEAD) |
---|
97 | -p the repository-relative path (defaults to /trunk) |
---|
98 | -h show this help information (other options will be ignored) |
---|
99 | "; |
---|
100 | |
---|
101 | # Defaults. |
---|
102 | $cmd_opts{'r'} = '1:HEAD'; |
---|
103 | $cmd_opts{'p'} = '/trunk'; |
---|
104 | |
---|
105 | getopts('r:p:h', \%cmd_opts) or die $usage; |
---|
106 | |
---|
107 | die $usage if scalar(@ARGV) < 1; |
---|
108 | $repos_url = $ARGV[0]; |
---|
109 | |
---|
110 | $cmd_opts{'r'} =~ m/(\d+)(:(.+))?/; |
---|
111 | if ($3) |
---|
112 | { |
---|
113 | $youngest = ($3 eq 'HEAD' ? $3 : int($3)); |
---|
114 | $startrev = int($1); |
---|
115 | } |
---|
116 | else |
---|
117 | { |
---|
118 | $youngest = ($3 eq 'HEAD' ? $1 : int($1)); |
---|
119 | $startrev = 1; |
---|
120 | } |
---|
121 | |
---|
122 | $startpath = $cmd_opts{'p'}; |
---|
123 | |
---|
124 | # Print help info (and exit nicely) if requested. |
---|
125 | if ($cmd_opts{'h'}) |
---|
126 | { |
---|
127 | print($usage); |
---|
128 | exit 0; |
---|
129 | } |
---|
130 | } |
---|
131 | |
---|
132 | # This function is a callback which is invoked for every revision as |
---|
133 | # we traverse change log messages. |
---|
134 | sub process_revision |
---|
135 | { |
---|
136 | my $changed_paths = shift; |
---|
137 | my $revision = shift || ''; |
---|
138 | my $author = shift || ''; |
---|
139 | my $date = shift || ''; |
---|
140 | my $message = shift || ''; |
---|
141 | my $pool = shift; |
---|
142 | |
---|
143 | #print STDERR "$revision\r"; |
---|
144 | |
---|
145 | foreach my $path (keys %$changed_paths) |
---|
146 | { |
---|
147 | my $copyfrom_path = $$changed_paths{$path}->copyfrom_path; |
---|
148 | my $copyfrom_rev = undef; |
---|
149 | my $action = $$changed_paths{$path}->action; |
---|
150 | |
---|
151 | # See if we're deleting one of our tracking nodes |
---|
152 | if ($action eq 'D' and exists($tracking{$path})) |
---|
153 | { |
---|
154 | print "\t\"$path:$tracking{$path}\" "; |
---|
155 | print "[label=\"$path:$tracking{$path}\\nDeleted in r$revision\",color=red];\n"; |
---|
156 | delete($tracking{$path}); |
---|
157 | next; |
---|
158 | } |
---|
159 | |
---|
160 | ### TODO: Display a commit which was the result of a merge |
---|
161 | ### operation with [sytle=dashed,color=blue] |
---|
162 | |
---|
163 | # If this is a copy, work out if it was from somewhere interesting |
---|
164 | if (defined($copyfrom_path)) |
---|
165 | { |
---|
166 | $copyfrom_rev = $tracking{$copyfrom_path}; |
---|
167 | } |
---|
168 | if (defined($copyfrom_rev) && |
---|
169 | exists($interesting{$copyfrom_path . ':' . $copyfrom_rev})) |
---|
170 | { |
---|
171 | $interesting{$path . ':' . $revision} = 1; |
---|
172 | $tracking{$path} = $revision; |
---|
173 | print "\t\"$copyfrom_path:$copyfrom_rev\" -> "; |
---|
174 | print " \"$path:$revision\""; |
---|
175 | print " [label=\"copy at r$revision\",color=green];\n"; |
---|
176 | |
---|
177 | $copysource{"$copyfrom_path:$copyfrom_rev"} = 1; |
---|
178 | $copydest{"$path:$revision"} = 1; |
---|
179 | } |
---|
180 | |
---|
181 | # For each change, we'll walk up the path one component at a time, |
---|
182 | # updating any parents that we're tracking (i.e. a change to |
---|
183 | # /trunk/asdf/foo updates /trunk). We mark that parent as |
---|
184 | # interesting (a potential source for copies), draw a link, and |
---|
185 | # update its tracking revision. |
---|
186 | do |
---|
187 | { |
---|
188 | if (exists($tracking{$path}) && $tracking{$path} != $revision) |
---|
189 | { |
---|
190 | $codeline_changes_forward{"$path:$tracking{$path}"} = |
---|
191 | "$path:$revision"; |
---|
192 | $codeline_changes_back{"$path:$revision"} = |
---|
193 | "$path:$tracking{$path}"; |
---|
194 | $interesting{$path . ':' . $revision} = 1; |
---|
195 | $tracking{$path} = $revision; |
---|
196 | } |
---|
197 | $path =~ s:/[^/]*$::; |
---|
198 | } until ($path eq ''); |
---|
199 | } |
---|
200 | } |
---|
201 | |
---|
202 | # Write a descriptor for the graph in GraphViz .dot format to stdout. |
---|
203 | sub write_graph_descriptor |
---|
204 | { |
---|
205 | # Begin writing the graph descriptor. |
---|
206 | print "digraph tree {\n"; |
---|
207 | print "\tgraph [bgcolor=white];\n"; |
---|
208 | print "\tnode [color=lightblue2, style=filled];\n"; |
---|
209 | print "\tedge [color=black, labeljust=r];\n"; |
---|
210 | print "\n"; |
---|
211 | |
---|
212 | # Retrieve the requested history. |
---|
213 | $ra->get_log(['/'], $startrev, $youngest, 0, 1, 0, \&process_revision); |
---|
214 | |
---|
215 | # Now ensure that everything is linked. |
---|
216 | foreach my $codeline_change (keys %codeline_changes_forward) |
---|
217 | { |
---|
218 | # If this node is not the first in its codeline chain, and it isn't |
---|
219 | # the source of a copy, it won't be the source of an edge |
---|
220 | if (exists($codeline_changes_back{$codeline_change}) && |
---|
221 | !exists($copysource{$codeline_change})) |
---|
222 | { |
---|
223 | next; |
---|
224 | } |
---|
225 | |
---|
226 | # If this node is the first in its chain, or the source of |
---|
227 | # a copy, then we'll print it, and then find the next in |
---|
228 | # the chain that needs to be printed too |
---|
229 | if (!exists($codeline_changes_back{$codeline_change}) or |
---|
230 | exists($copysource{$codeline_change}) ) |
---|
231 | { |
---|
232 | print "\t\"$codeline_change\" -> "; |
---|
233 | my $nextchange = $codeline_changes_forward{$codeline_change}; |
---|
234 | my $changecount = 1; |
---|
235 | while (defined($nextchange)) |
---|
236 | { |
---|
237 | if (exists($copysource{$nextchange}) or |
---|
238 | !exists($codeline_changes_forward{$nextchange}) ) |
---|
239 | { |
---|
240 | print "\"$nextchange\" [label=\"$changecount change"; |
---|
241 | if ($changecount > 1) |
---|
242 | { |
---|
243 | print 's'; |
---|
244 | } |
---|
245 | print '"];'; |
---|
246 | last; |
---|
247 | } |
---|
248 | $changecount++; |
---|
249 | $nextchange = $codeline_changes_forward{$nextchange}; |
---|
250 | } |
---|
251 | print "\n"; |
---|
252 | } |
---|
253 | } |
---|
254 | |
---|
255 | # Complete the descriptor (delaying write of font size to avoid |
---|
256 | # inheritance by any subgraphs). |
---|
257 | #my $title = "Family Tree\n$startpath, $startrev through $youngest"; |
---|
258 | #print "\tgraph [label=\"$title\", fontsize=18];\n"; |
---|
259 | print "}\n"; |
---|
260 | } |
---|