#!/usr/bin/perl -w

# this script extracts all the mergeinfo from the SVN working copy that is its working directory (must be the root of the branch) and
# combines it into giant "svn merge" operations.  The intent is to convince SVN to elide all the mergeinfo on the child paths, so it
# is concentrated only at the root.  This may case some weirdness because paths that weren't actually merged may now be marked as merged,
# but it will not lose any information.

# it is written for Perl 5.10.0 and SVN 1.6.1 and intended to run in the Cygwin environment under Windows, but should work on *nix as well.
# The Perl SVN bindings don't have functions to manipulate mergeinfo, so I have to call the SVN executable directly and parse the output.

# parts of this script are specific to solving my problem and will need to be generalized for it to be of use to anyone else

# written in May 2009 by Ryan Meador (rmeador@softscape.com)

use strict;

# this path must be set to the repo root URL.  I could extract this from "svn info", but I'm lazy
my $sourceRootURL = "http://localhost/svn/eng";

sub trim($) # trims leading and trailing whitespace
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

sub NormalizePath($) # cut down a merge path to the "lightyear" level.  this simply needs to figure out the path to the branch root, which in my case is always a folder matching that regex.  a general solution will need to be found.
{
	my $path = shift;

	my ($normalizedPath) = ($path =~ /(.*\/[Ll]ight[Yy]ear[^\/]*)/);

	if (!defined($normalizedPath))
	{
		die "path did not contain lightyear directory: " . $path;
	}

	return $normalizedPath;
}

sub GetMergeInfo($)
{
	my $path = shift;

	my @mergeinfo = `svn propget -vR "svn:mergeinfo" "$path"`;

	print "SVN command output " . scalar @mergeinfo . " lines\n";

	my $currentMergePath;
	my %pathMap;

	chomp(@mergeinfo);

	foreach my $line (@mergeinfo)
	{
		if ($line =~ /Properties on '(.*)':/) # this line of output indicates we're moving to a new merge target path
		{
			$currentMergePath = $1;
			print "Current merge target path: " . $currentMergePath . "\n";
		}
		elsif ($line =~ /svn:mergeinfo/) # skip the line of output that just lists the property name
		{
			next;
		}
		else # all other output should be mergeinfo property values
		{
			if ($line =~ /\*/) #contains an asterisk; means non-inheritable mergeinfo.  maybe we need to deal with this better than just dying?
			{
				die "Non-inheritable mergeinfo found on '$currentMergePath': " . $line . "\n";
			}

			my ($currentSourcePath, $revisions) = split(/:/, $line, 2);

			if (!defined($currentSourcePath) || !defined($revisions)) # empty mergeinfo
			{
				print "Empty mergeinfo\n";
				next;
			}

			$currentSourcePath = trim($currentSourcePath);
			$revisions = trim($revisions);

			print "Current source path: " . $currentSourcePath . ", ";

			$currentSourcePath = NormalizePath($currentSourcePath);

			print "normalized: " . $currentSourcePath;

			my @revisionList = split(/,/, $revisions);

			if (defined($pathMap{$currentSourcePath}))
			{
				my $oldRevs = $pathMap{$currentSourcePath};
				@revisionList = (@revisionList, @{$oldRevs});
			}

			$pathMap{$currentSourcePath} = \@revisionList;
			print " - " . join(",", @revisionList) . "\n"; # prints all revisions on that normalized source path so far encountered (so there will be a lot of duplicates)
		}
	}

	return %pathMap;
}

sub NormalizeMergeInfo(\%) # remove duplicate revisions and revision ranges.  maybe should try to remove revisions/ranges that fall inside other ranges, but I haven't hit that case so I haven't worried about it yet.
{
	my %pathMap = %{$_[0]}; # hash of normalized paths to arrays of revisions/ranges

	foreach my $path (keys %pathMap)
	{
		my @revs = sort @{$pathMap{$path}}; # sort them so duplicates will be next to each other
		my @normalizedRevs = ();

		foreach my $rev (@revs)
		{
			if (scalar(@normalizedRevs) == 0) # empty list (always insert first element)
			{
				push @normalizedRevs, $rev;
				next;
			}

			if ($normalizedRevs[-1] eq $rev) # if the previous entry is equal to the current one, skip it
			{
				next;
			}

			push @normalizedRevs, $rev;
		}

		$pathMap{$path} = \@normalizedRevs;
	}

	return %pathMap;
}

# ACTUAL MAIN CODE

open(OUTPUT_FILE, '>', "merge.sh") or die "couldn't open output file";

print OUTPUT_FILE "#!/usr/bin/bash\n\n";

my %pathMap = GetMergeInfo(".");

%pathMap = NormalizeMergeInfo(%pathMap);

foreach my $path (keys %pathMap)
{
	print OUTPUT_FILE "svn merge --record-only " . $sourceRootURL . $path;
	foreach my $rev (@{$pathMap{$path}})
	{
		if ($rev =~ /-/) # check for revision range by looking for a dash
		{
			my ($startRev, $endRev) = split(/-/, $rev);
			
			--$startRev; # revision ranges need to start at 1 less because unlike "-c", the "-r" option does not do this for us

			print OUTPUT_FILE " -r " . $startRev . ":" . $endRev;
		}
		else # single revision number
		{
			print OUTPUT_FILE " -c " . $rev;
		}
	}

	print OUTPUT_FILE "\n\n";
}

close(OUTPUT_FILE);

print "Done\n"
