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 }