die in Storage::DBI::Pg when it can't find the autoinc sequence
[dbsrgits/DBIx-Class.git] / maint / svn-log.perl
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
11 use warnings;
12 use strict;
13
14 use Getopt::Long;
15 use Text::Wrap qw(wrap fill $columns $huge);
16 use POSIX qw(strftime);
17 use XML::Parser;
18
19 my %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
27 my $days_back  = 365;   # Go back a year by default.
28 my $send_help  = 0;     # Display help and exit.
29 my $svn_repo;           # Where to log from.
30
31 use constant LOG_REV        => 0;
32 use constant LOG_DATE       => 1;
33 use constant LOG_WHO        => 2;
34 use constant LOG_MESSAGE    => 3;
35 use constant LOG_PATHS      => 4;
36
37 use constant PATH_PATH      => 0;
38 use constant PATH_ACTION    => 1;
39 use constant PATH_CPF_PATH  => 2;
40 use constant PATH_CPF_REV   => 3;
41
42 use constant TAG_REV        => 0;
43 use constant TAG_TAG        => 1;
44 use constant TAG_LOG        => 2;
45
46 use constant MAX_TIMESTAMP  => "9999-99-99 99:99:99";
47
48 GetOptions(
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.
55 unless (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
66 die(
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
75 my $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
80 my %tag;
81
82 open(TAG, "svn -v list $svn_repo/tags|") or die $!;
83 while (<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 }
101 close 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
114 my @tag_dates = sort keys %tag;
115 while (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
142 foreach 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
209 print(
210         "==============\n",
211         "End of Excerpt\n",
212         "==============\n",
213 );
214
215 ### Z. Helper functions.
216
217 sub 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 }