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 }