Fix left-join chaining
[dbsrgits/DBIx-Class.git] / maint / svn-log.perl
CommitLineData
f340be7a 1#!/usr/bin/env perl
2# $Id$
3
4# This program is Copyright 2005 by Rocco Caputo. All rights are
5# reserved. This program is free software. It may be modified, used,
6# and redistributed under the same terms as Perl itself.
7
8# Generate a nice looking change log from the subversion logs for a
9# Perl project. The log is also easy for machines to parse.
10
11use warnings;
12use strict;
13
14use Getopt::Long;
15use Text::Wrap qw(wrap fill $columns $huge);
16use POSIX qw(strftime);
17use XML::Parser;
18
19my %month = qw(
20 Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
21 Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12
22);
23
24$Text::Wrap::huge = "wrap";
25$Text::Wrap::columns = 74;
26
27my $days_back = 365; # Go back a year by default.
28my $send_help = 0; # Display help and exit.
29my $svn_repo; # Where to log from.
30
31use constant LOG_REV => 0;
32use constant LOG_DATE => 1;
33use constant LOG_WHO => 2;
34use constant LOG_MESSAGE => 3;
35use constant LOG_PATHS => 4;
36
37use constant PATH_PATH => 0;
38use constant PATH_ACTION => 1;
39use constant PATH_CPF_PATH => 2;
40use constant PATH_CPF_REV => 3;
41
42use constant TAG_REV => 0;
43use constant TAG_TAG => 1;
44use constant TAG_LOG => 2;
45
46use constant MAX_TIMESTAMP => "9999-99-99 99:99:99";
47
48GetOptions(
49 "age=s" => \$days_back,
50 "repo=s" => \$svn_repo,
51 "help" => \$send_help,
52) or exit;
53
54# Find the trunk for the current repository if one isn't specified.
55unless (defined $svn_repo) {
56 $svn_repo = `svn info . | grep '^URL: '`;
57 if (length $svn_repo) {
58 chomp $svn_repo;
59 $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1};
60 }
61 else {
62 $send_help = 1;
63 }
64}
65
66die(
67 "$0 usage:\n",
68 " --repo REPOSITORY\n",
69 " [--age DAYS]\n",
70 "\n",
71 "REPOSITORY must have a trunk subdirectory and a tags directory where\n",
72 "release tags are kept.\n",
73) if $send_help;
74
75my $earliest_date = strftime "%F", gmtime(time() - $days_back * 86400);
76
77### 1. Gather a list of tags for the repository, their revisions and
78### dates.
79
80my %tag;
81
82open(TAG, "svn -v list $svn_repo/tags|") or die $!;
83while (<TAG>) {
84 # The date is unused, however.
85 next unless (
86 my ($rev, $date, $tag) = m{
87 (\d+).*?(\S\S\S\s+\d\d\s+(?:\d\d\d\d|\d\d:\d\d))\s+(v[0-9_.]+)
88 }x
89 );
90
91 my @tag_log = gather_log("$svn_repo/tags/$tag", "--stop-on-copy");
92 die "Tag $tag has changes after tagging!\n" if @tag_log > 1;
93
94 my $timestamp = $tag_log[0][LOG_DATE];
95 $tag{$timestamp} = [
96 $rev, # TAG_REV
97 $tag, # TAG_TAG
98 [ ], # TAG_LOG
99 ];
100}
101close TAG;
102
103# Fictitious "HEAD" tag for revisions that came after the last tag.
104
105$tag{+MAX_TIMESTAMP} = [
106 "HEAD", # TAG_REV
107 "(untagged)", # TAG_TAG
108 undef, # TAG_LOG
109];
110
111### 2. Gather the log for the trunk. Place log entries under their
112### proper tags.
113
114my @tag_dates = sort keys %tag;
115while (my $date = pop(@tag_dates)) {
116
117 # We're done if this date's before our earliest date.
118 if ($date lt $earliest_date) {
119 delete $tag{$date};
120 next;
121 }
122
123 my $tag = $tag{$date}[TAG_TAG];
124 #warn "Gathering information for tag $tag...\n";
125
126 my $this_rev = $tag{$date}[TAG_REV];
127 my $prev_rev;
128 if (@tag_dates) {
129 $prev_rev = $tag{$tag_dates[-1]}[TAG_REV];
130 }
131 else {
132 $prev_rev = 0;
133 }
134
135 my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev");
136
137 $tag{$date}[TAG_LOG] = \@log;
138}
139
140### 3. PROFIT! No, wait... generate the nice log file.
141
142foreach my $timestamp (sort { $b cmp $a } keys %tag) {
143 my $tag_rec = $tag{$timestamp};
144
145 # Skip this tag if there are no log entries.
146 next unless @{$tag_rec->[TAG_LOG]};
147
148 my $tag_line = "$timestamp $tag_rec->[TAG_TAG]";
149 my $tag_bar = "=" x length($tag_line);
150 print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n";
151
152 foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) {
153
154 my @paths = @{$log_rec->[LOG_PATHS]};
155 if (@paths > 1) {
156 @paths = grep {
157 $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M"
158 } @paths;
159 }
160
161 my $time_line = wrap(
162 " ", " ",
163 join(
164 "; ",
165 "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]",
166 map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
167 )
168 );
169
170 if ($time_line =~ /\n/) {
171 $time_line = wrap(
172 " ", " ",
173 "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n"
174 ) .
175 wrap(
176 " ", " ",
177 join(
178 "; ",
179 map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
180 )
181 );
182 }
183
184 print $time_line, "\n\n";
185
186 # Blank lines should have the indent level of whitespace. This
187 # makes it easier for other utilities to parse them.
188
189 my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE];
190 foreach my $paragraph (@paragraphs) {
191
192 # Trim off identical leading space from every line.
193 my ($whitespace) = $paragraph =~ /^(\s*)/;
194 if (length $whitespace) {
195 $paragraph =~ s/^$whitespace//mg;
196 }
197
198 # Re-flow the paragraph if it isn't indented from the norm.
199 # This should preserve indented quoted text, wiki-style.
200 unless ($paragraph =~ /^\s/) {
201 $paragraph = fill(" ", " ", $paragraph);
202 }
203 }
204
205 print join("\n \n", @paragraphs), "\n\n";
206 }
207}
208
209print(
210 "==============\n",
211 "End of Excerpt\n",
212 "==============\n",
213);
214
215### Z. Helper functions.
216
217sub gather_log {
218 my ($url, @flags) = @_;
219
220 my (@log, @stack);
221
222 my $parser = XML::Parser->new(
223 Handlers => {
224 Start => sub {
225 my ($self, $tag, %att) = @_;
226 push @stack, [ $tag, \%att ];
227 if ($tag eq "logentry") {
228 push @log, [ ];
229 $log[-1][LOG_WHO] = "(nobody)";
230 }
231 },
232 Char => sub {
233 my ($self, $text) = @_;
234 $stack[-1][1]{0} .= $text;
235 },
236 End => sub {
237 my ($self, $tag) = @_;
238 die "close $tag w/out open" unless @stack;
239 my ($pop_tag, $att) = @{pop @stack};
240
241 die "$tag ne $pop_tag" if $tag ne $pop_tag;
242
243 if ($tag eq "date") {
244 my $timestamp = $att->{0};
245 my ($date, $time) = split /[T.]/, $timestamp;
246 $log[-1][LOG_DATE] = "$date $time";
247 return;
248 }
249
250 if ($tag eq "logentry") {
251 $log[-1][LOG_REV] = $att->{revision};
252 return;
253 }
254
255 if ($tag eq "msg") {
256 $log[-1][LOG_MESSAGE] = $att->{0};
257 return;
258 }
259
260 if ($tag eq "author") {
261 $log[-1][LOG_WHO] = $att->{0};
262 return;
263 }
264
265 if ($tag eq "path") {
266 my $path = $att->{0};
267 $path =~ s{^/trunk/}{};
268 push(
269 @{$log[-1][LOG_PATHS]}, [
270 $path, # PATH_PATH
271 $att->{action}, # PATH_ACTION
272 ]
273 );
274
275 $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if (
276 exists $att->{"copyfrom-path"}
277 );
278
279 $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if (
280 exists $att->{"copyfrom-rev"}
281 );
282 return;
283 }
284
285 }
286 }
287 );
288
289 my $cmd = "svn -v --xml @flags log $url";
290 #warn "Command: $cmd\n";
291
292 open(LOG, "$cmd|") or die $!;
293 $parser->parse(*LOG);
294 close LOG;
295
296 return @log;
297}