[dbsrgits/DBIx-Class.git] / maint / svn-log.perl

#!/usr/bin/env perl
# $Id$

# This program is Copyright 2005 by Rocco Caputo.  All rights are
# reserved.  This program is free software.  It may be modified, used,
# and redistributed under the same terms as Perl itself.

# Generate a nice looking change log from the subversion logs for a
# Perl project.  The log is also easy for machines to parse.

use warnings;
use strict;

use Getopt::Long;
use Text::Wrap qw(wrap fill $columns $huge);
use POSIX qw(strftime);
use XML::Parser;

my %month = qw(
 Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
 Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12
);

$Text::Wrap::huge     = "wrap";
$Text::Wrap::columns  = 74;

my $days_back  = 365;   # Go back a year by default.
my $send_help  = 0;     # Display help and exit.
my $svn_repo;           # Where to log from.

use constant LOG_REV        => 0;
use constant LOG_DATE       => 1;
use constant LOG_WHO        => 2;
use constant LOG_MESSAGE    => 3;
use constant LOG_PATHS      => 4;

use constant PATH_PATH      => 0;
use constant PATH_ACTION    => 1;
use constant PATH_CPF_PATH  => 2;
use constant PATH_CPF_REV   => 3;

use constant TAG_REV        => 0;
use constant TAG_TAG        => 1;
use constant TAG_LOG        => 2;

use constant MAX_TIMESTAMP  => "9999-99-99 99:99:99";

GetOptions(
  "age=s"      => \$days_back,
  "repo=s"     => \$svn_repo,
  "help"       => \$send_help,
) or exit;

# Find the trunk for the current repository if one isn't specified.
unless (defined $svn_repo) {
  $svn_repo = `svn info . | grep '^URL: '`;
  if (length $svn_repo) {
    chomp $svn_repo;
    $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1};
  }
  else {
    $send_help = 1;
  }
}

die(
  "$0 usage:\n",
  "  --repo REPOSITORY\n",
  "  [--age DAYS]\n",
  "\n",
  "REPOSITORY must have a trunk subdirectory and a tags directory where\n",
  "release tags are kept.\n",
) if $send_help;

my $earliest_date = strftime "%F", gmtime(time() - $days_back * 86400);

### 1. Gather a list of tags for the repository, their revisions and
### dates.

my %tag;

open(TAG, "svn -v list $svn_repo/tags|") or die $!;
while (<TAG>) {
  # The date is unused, however.
  next unless (
    my ($rev, $date, $tag) = m{
      (\d+).*?(\S\S\S\s+\d\d\s+(?:\d\d\d\d|\d\d:\d\d))\s+(v[0-9_.]+)
    }x
  );

  my @tag_log = gather_log("$svn_repo/tags/$tag", "--stop-on-copy");
  die "Tag $tag has changes after tagging!\n" if @tag_log > 1;

  my $timestamp = $tag_log[0][LOG_DATE];
  $tag{$timestamp} = [
    $rev,     # TAG_REV
    $tag,     # TAG_TAG
    [ ],      # TAG_LOG
  ];
}
close TAG;

# Fictitious "HEAD" tag for revisions that came after the last tag.

$tag{+MAX_TIMESTAMP} = [
  "HEAD",         # TAG_REV
  "(untagged)",   # TAG_TAG
  undef,          # TAG_LOG
];

### 2. Gather the log for the trunk.  Place log entries under their
### proper tags.

my @tag_dates = sort keys %tag;
while (my $date = pop(@tag_dates)) {

  # We're done if this date's before our earliest date.
  if ($date lt $earliest_date) {
    delete $tag{$date};
    next;
  }

  my $tag = $tag{$date}[TAG_TAG];
  #warn "Gathering information for tag $tag...\n";

  my $this_rev = $tag{$date}[TAG_REV];
  my $prev_rev;
  if (@tag_dates) {
    $prev_rev = $tag{$tag_dates[-1]}[TAG_REV];
  }
  else {
    $prev_rev = 0;
  }

  my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev");

  $tag{$date}[TAG_LOG] = \@log;
}

### 3. PROFIT!  No, wait... generate the nice log file.

foreach my $timestamp (sort { $b cmp $a } keys %tag) {
  my $tag_rec = $tag{$timestamp};

  # Skip this tag if there are no log entries.
  next unless @{$tag_rec->[TAG_LOG]};

  my $tag_line = "$timestamp $tag_rec->[TAG_TAG]";
  my $tag_bar  = "=" x length($tag_line);
  print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n";

  foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) {

    my @paths = @{$log_rec->[LOG_PATHS]};
    if (@paths > 1) {
      @paths = grep {
        $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M"
      } @paths;
    }

    my $time_line = wrap(
      "  ", "  ",
      join(
        "; ",
        "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]",
        map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
      )
    );

    if ($time_line =~ /\n/) {
      $time_line = wrap(
        "  ", "  ",
        "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n"
      ) .
      wrap(
        "  ", "  ",
        join(
          "; ",
          map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths
        )
      );
    }

    print $time_line, "\n\n";

    # Blank lines should have the indent level of whitespace.  This
    # makes it easier for other utilities to parse them.

    my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE];
    foreach my $paragraph (@paragraphs) {

      # Trim off identical leading space from every line.
      my ($whitespace) = $paragraph =~ /^(\s*)/;
      if (length $whitespace) {
        $paragraph =~ s/^$whitespace//mg;
      }

      # Re-flow the paragraph if it isn't indented from the norm.
      # This should preserve indented quoted text, wiki-style.
      unless ($paragraph =~ /^\s/) {
        $paragraph = fill("    ", "    ", $paragraph);
      }
    }

    print join("\n    \n", @paragraphs), "\n\n";
  }
}

print(
  "==============\n",
  "End of Excerpt\n",
  "==============\n",
);

### Z. Helper functions.

sub gather_log {
  my ($url, @flags) = @_;

  my (@log, @stack);

  my $parser = XML::Parser->new(
    Handlers => {
      Start => sub {
        my ($self, $tag, %att) = @_;
        push @stack, [ $tag, \%att ];
        if ($tag eq "logentry") {
          push @log, [ ];
          $log[-1][LOG_WHO] = "(nobody)";
        }
      },
      Char  => sub {
        my ($self, $text) = @_;
        $stack[-1][1]{0} .= $text;
      },
      End => sub {
        my ($self, $tag) = @_;
        die "close $tag w/out open" unless @stack;
        my ($pop_tag, $att) = @{pop @stack};

        die "$tag ne $pop_tag" if $tag ne $pop_tag;

        if ($tag eq "date") {
          my $timestamp = $att->{0};
          my ($date, $time) = split /[T.]/, $timestamp;
          $log[-1][LOG_DATE] = "$date $time";
          return;
        }

        if ($tag eq "logentry") {
          $log[-1][LOG_REV] = $att->{revision};
          return;
        }

        if ($tag eq "msg") {
          $log[-1][LOG_MESSAGE] = $att->{0};
          return;
        }

        if ($tag eq "author") {
          $log[-1][LOG_WHO] = $att->{0};
          return;
        }

        if ($tag eq "path") {
          my $path = $att->{0};
          $path =~ s{^/trunk/}{};
          push(
            @{$log[-1][LOG_PATHS]}, [
              $path,            # PATH_PATH
              $att->{action},   # PATH_ACTION
            ]
          );

          $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if (
            exists $att->{"copyfrom-path"}
          );

          $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if (
            exists $att->{"copyfrom-rev"}
          );
          return;
        }

      }
    }
  );

  my $cmd = "svn -v --xml @flags log $url";
  #warn "Command: $cmd\n";

  open(LOG, "$cmd|") or die $!;
  $parser->parse(*LOG);
  close LOG;

  return @log;
}
Commit	Line	Data
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
	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(
d7f20fdf	20	Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06
d7f20fdf	21	Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12
f340be7a	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,
d7f20fdf	51	"help" => \$send_help,
f340be7a	52	) or exit;
	53
	54	# Find the trunk for the current repository if one isn't specified.
	55	unless (defined $svn_repo) {
d7f20fdf	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	}
f340be7a	64	}
	65
	66	die(
d7f20fdf	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",
f340be7a	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>) {
d7f20fdf	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	];
f340be7a	100	}
	101	close TAG;
	102
	103	# Fictitious "HEAD" tag for revisions that came after the last tag.
	104
	105	$tag{+MAX_TIMESTAMP} = [
d7f20fdf	106	"HEAD", # TAG_REV
	107	"(untagged)", # TAG_TAG
	108	undef, # TAG_LOG
f340be7a	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
d7f20fdf	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	}
f340be7a	122
d7f20fdf	123	my $tag = $tag{$date}[TAG_TAG];
d7f20fdf	124	#warn "Gathering information for tag $tag...\n";
f340be7a	125
d7f20fdf	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	}
f340be7a	134
d7f20fdf	135	my @log = gather_log("$svn_repo/trunk", "-r", "$this_rev:$prev_rev");
f340be7a	136
d7f20fdf	137	$tag{$date}[TAG_LOG] = \@log;
f340be7a	138	}
	139
	140	### 3. PROFIT! No, wait... generate the nice log file.
	141
	142	foreach my $timestamp (sort { $b cmp $a } keys %tag) {
d7f20fdf	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	}
f340be7a	207	}
	208
	209	print(
d7f20fdf	210	"==============\n",
	211	"End of Excerpt\n",
	212	"==============\n",
f340be7a	213	);
	214
	215	### Z. Helper functions.
	216
	217	sub gather_log {
d7f20fdf	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;
f340be7a	297	}