#!perl
######################################################################

=head1 NAME

TrimMergeInfo.pl - Trim Matching Subversion Merge Information

=head1 SYNOPSIS

    perl TrimMergeInfo.pl <wc_dir> <path_regex>
        [--revisions=<range>] [<path_regex> ...]

=head1 DESCRIPTION

Recursively trim matching "C<svn:mergeinfo>" entries from the
indicated working copy directory. This script can be run multiple
times on the same working copy in order to apply different sets of
regular expressions.

This script does not commit any changes. If you make a mistake, you
can use "C<svn revert>" to restore the trimmed information.

Merge information is recorded for both folders and files.

B<NOTE:> This will NOT trim merge information contained within
"C<svn:externals>" folders. To trim their merge information, you must
explicitly run this on the corresponding directories in the working
copy.

This script uses the Subversion command line tools.

=head2 Arguments

=over

=item <wc_dir>

This argument specifies the pathname of the working copy directory.
The merge information for this directory, and all contained files and
subdirectories, will be trimmed.

Only one working copy directory may be specified.

=item <path_regex>

These arguments specify Perl regular expressions to look for in the
merge source paths. Any entry that matches one of these will have its
merged revision numbers trimmed. If merge source path ends up with no
revision numbers, it is removed. If all the merge source paths are
removed, the merge info property is deleted.

One or more of these arguments are required.

=item --revisions

This optional argument specifies a revision number range to remove
from the matching source paths.

Four forms of revision ranges are supported:

=over

=item C<0:HEAD>

This is the default. It indicates that all merge info for the matching
source paths should be trimmed.

=item C<0:>I<endrev>

This range indicates that any revision numbers prior to, and
including, I<endrev> should be trimmed. This is often used to
remove any merge info prior to the creation of a branch.

=item I<startrev>C<:>I<endrev>

This specifies an inclusive range of revisions to be trimmed.

=item I<startrev>C<:HEAD>

This range indicates that any revisions after, and including,
I<startrev> should be trimmed.

=back

=back

=cut

######################################################################
use strict;
use warnings;

use Getopt::Long;
use XML::Simple;

######################################################################
# Functions
######################################################################
#=====================================================================
# Trim a source path revision number range. The returned range set
# must be in ascending order.
# Inputs:
#	$iWCPath
#		Pathname of the working copy
#	$iSrcPath
#		Repository pathname of the merge source
#   $iSrcRange
#       Revision number range of a matched source path
#   $iMinTrimRev
#       Minimum revision number of inclusive trim range
#   $iMaxTrimRev
#       Maximum revision number (or HEAD) of inclusive trim range
#   $iIsChangedRef
#       Reference to a flag that indicates the merge info has changed
# Returns:
#   $aUpdatedRangesRef
#       Reference to the array of trimmed source path revision number
#       ranges
#=====================================================================
sub trimMergedRange
{
    my ($iWCPath, $iSrcPath, $iSrcRange, $iMinTrimRev, $iMaxTrimRev,
    	$iIsChangedRef) = @_;

    # Parse the merged revision number range.

    my ($aMinSrcRev, $aMaxSrcRev);
    if ($iSrcRange =~ m{^(\d+)-(\d+)$})
    {
        ($aMinSrcRev, $aMaxSrcRev) = ($1, $2);
        
        # Make sure the range is properly oriented.
        
        die("Reversed revision range '$iSrcRange'"
        	. " for source '$iSrcPath'"
        	. " of working copy item '$iWCPath'")
        	if ($aMaxSrcRev < $aMinSrcRev);
    }
    elsif ($iSrcRange =~ m{^(\d+)$})
    {
        ($aMinSrcRev, $aMaxSrcRev) = ($1, $1);
    }

    # Drop any unparsible merged revision number ranges.

    else
    {
        die("Illegal revision range '$iSrcRange'"
        	. " for source '$iSrcPath'"
        	. " of working copy item '$iWCPath'");
    }

    # Handle a merged revision range that isn't altered.

    return [ $iSrcRange ] if (
        ($aMaxSrcRev < $iMinTrimRev)
        || (($iMaxTrimRev ne 'HEAD')
            && ($aMinSrcRev > $iMaxTrimRev)));

    # At this point, we know that the merged revision range for this
    # matching source path will change. That means the merge info
    # property will need to be updated.

    $$iIsChangedRef = 1;

    # Handle a merge range that's completely trimmed off.

    return [] if (($aMinSrcRev >= $iMinTrimRev)
        && (($iMaxTrimRev eq 'HEAD')
            || ($aMaxSrcRev <= $iMaxTrimRev)));

    # Handle a merge range that's split by the trim range.

    if (($aMinSrcRev < $iMinTrimRev)
        && ($iMaxTrimRev ne 'HEAD')
        && ($aMaxSrcRev > $iMaxTrimRev))
    {
        # Get the new lower range.

        my $aLowerRange = ($aMinSrcRev == ($iMinTrimRev - 1))
            ? $aMinSrcRev : $aMinSrcRev . '-' . ($iMinTrimRev - 1);

        # Get the new upper range.

        my $aUpperRange = ($aMaxSrcRev == ($iMaxTrimRev + 1))
            ? $aMaxSrcRev : ($iMaxTrimRev + 1) . '-' . $aMaxSrcRev;

        # Return the new set of bracketing ranges.

        return [ $aLowerRange, $aUpperRange ];
    }

    # Handle a merge range whose upper end is trimmed by the trim
    # range.

    if (($aMaxSrcRev >= $iMinTrimRev)
    	&& (($iMaxTrimRev eq 'HEAD')
    		|| ($aMaxSrcRev <= $iMaxTrimRev)))
    {
        # Return a single revision merge range.

        return [ $aMinSrcRev ]
            if ($aMinSrcRev == ($iMinTrimRev - 1));

        # Return a truncated merge range.

        return [ $aMinSrcRev . '-' . ($iMinTrimRev - 1) ];
    }

    # The merge range's lower end overlaps the trim range. Return a
    # new single revision merge range.

    return [ $aMaxSrcRev ]
        if ($aMaxSrcRev == ($iMaxTrimRev + 1));

    # Return a foreshortened merge range.

    return [ ($iMaxTrimRev + 1) . '-' . $aMaxSrcRev ];
}

######################################################################
# Main Script
######################################################################

# Get any options.

our $gTrimRevisions = '0:HEAD';
GetOptions(
    'revisions=s' => \$gTrimRevisions,
) or die("Unable to parse command line");

# Get the root working copy directory.

die('Working copy directory is required') unless (@ARGV);
our $gWCRoot = shift @ARGV;
die(qq{Working copy directory, "$gWCRoot", not found})
    unless (-d $gWCRoot);

# Get the list of repository path regular expressions.

die('Repository path regular expressions required') unless (@ARGV);
our @gPathRegexes = @ARGV;

# Make sure the revision range is meaningful.

my ($aMinTrimRev, $aMaxTrimRev);
if ($gTrimRevisions =~ m{^(\d+):(\d+|HEAD)$})
{
    ($aMinTrimRev, $aMaxTrimRev) = ($1, $2);
}
else
{
    die("Colon-separated revision range is required");
}

die("Revision range is reversed")
    if ($aMaxTrimRev ne 'HEAD' && $aMaxTrimRev < $aMinTrimRev);

# Get the recursive XML listing of merge info properties.

my $aXml = qx{svn pg svn:mergeinfo "$gWCRoot" --depth=infinity --xml};

die(qq{Unable to get merge info for "$gWCRoot"}) if ($?);

# Parse the XML listing of merge information.

my $aPropertyList = eval{
    XMLin($aXml,
        forcearray => [ 'target' ],
        keyattr    => [],
    )};
die($@) if ($@);

# Make sure there's something to be trimmed.

die(qq{No merge info found for "$gWCRoot"})
    unless (defined $aPropertyList->{'target'});

# Process the working copy entries with merge info.

foreach (sort(
    { lc $a->{'path'} cmp lc $b->{'path'} }
    @{$aPropertyList->{'target'}}))
{
    # Get the path of the working copy item with merge info.

    my $aWCPath = $_->{'path'};

    # Get the merge info.

    my $aMergeInfo = $_->{'property'}->{'content'};

    # If the merge info property is present, and not empty, process
    # its value.

    my %aUpdMergeInfo;
    if ((defined $aMergeInfo) && ($aMergeInfo !~ m{^\s*$}s))
    {
        my $aIsChanged = 0;

        # Extract the merge info. Process each line separately.

        # Subversion uses a platform-specific line ending within the
        # generated XML tag content. I've found it necessary to use
        # the general-purpose line ending class, "\R", to split up
        # these lines of data.

        foreach (split(m{\R+}, $aMergeInfo))
        {
            # Separate the source repository path from the merged
            # revision numbers.

            my ($aSrcPath, $aMergedRevs) = split(m{:}, $_);

            # Compare the repository path to the regular expressions.

            my $aIsPathMatch = 0;
            foreach my $aPathRegex (@gPathRegexes)
            {
                # When the repository path matches a pattern, set the
                # match flag.

                if ($aSrcPath =~ qr{$aPathRegex})
                {
                    $aIsPathMatch = 1;
                    last;
                }
            }

            # If the source path didn't match, copy it into the
            # updated property value set and go on to the next source
            # path.

            unless ($aIsPathMatch)
            {
                $aUpdMergeInfo{$aSrcPath} = $aMergedRevs;
                next;
            }

            # The source path has matched a regular expression.
            # Extract any non-inheritable (terminal "*") marker.

            my $aNonInheritFlag = '';
            if ($aMergedRevs =~ m{(.*)(\*)$})
            {
                ($aMergedRevs, $aNonInheritFlag) = ($1, $2);
            }

            # Trim the list of merged revision numbers.
            #
            # NOTE: The revision number ranges must be kept in
            #       ascending order.

            my @aMergedRanges;
            push(@aMergedRanges, @{trimMergedRange(
            	$aWCPath, $aSrcPath, $_, $aMinTrimRev, $aMaxTrimRev,
            	\$aIsChanged)}) foreach (split(m{,}, $aMergedRevs));

            # If none of the merged revision numbers are retained,
            # don't output an entry for the source path.

            next unless (@aMergedRanges);

            # Add a possibly updated source path entry.

            $aUpdMergeInfo{$aSrcPath}
                = join(',', @aMergedRanges) . $aNonInheritFlag;
        }

        # If nothing's changed, don't alter the property.

        next unless ($aIsChanged);
    }

    # Handle a reduced set of merge info.

    if (keys %aUpdMergeInfo)
    {
        # Write the modified merge info to a temporary file.

        my $aTmpFile = "$gWCRoot\\svn-mergeinfo.tmp";
        open(my $aTFh, '>', $aTmpFile)
            or die(qq{Unable to write to file "$aTmpFile"});
        print($aTFh $_, ':', $aUpdMergeInfo{$_}, "\n")
            foreach (sort keys %aUpdMergeInfo);
        close($aTFh);

        # Update the directory merge info.

        print `svn ps svn:mergeinfo "$aWCPath" -F "$aTmpFile"`;

        die(qq{Property "svn:mergeinfo" update}
            . qq{ failed for "$aWCPath"}) if ($?);

        # Get rid of the temporary file.

        unlink($aTmpFile);
    }

    # Delete merge info that no longer applies.

    else
    {
        print `svn pd svn:mergeinfo "$aWCPath"`;

        die(qq{Property "svn:mergeinfo" deletion}
            . qq{ failed for "$aWCPath"}) if ($?);
    }
}

__END__
######################################################################

=head2 Listing Merge Info

The following Subversion command will give you a full listing of the
merge information in a working copy.

    svn propget svn:mergeinfo D:\my\working\copy --depth=infinity

Please note that this won't contain information from external folders.

=head2 Merge Info Data Format

The "C<svn:mergeinfo>" property of files and folders consists of a
multi-line value. Each line represents merge information for a merge
source in the common repository.

Example value for file "C<branches/15.5/foo.c>":

    /project/bar/trunk/foo.c:127-201,212
    /project/bar/branches/alt_a/foo.c:208,210,218-220

This script can be used to trim any or all of these lines. This is
particularly useful when one of the referenced branches has been
deleted from the HEAD of the repository.

=head1 VERSION

    $Id: TrimMergeInfo.pl 13 2009-07-06 16:48:03Z Geoffrey $

=head1 COPYRIGHT

Copyright (c)2009 Geoff Rowell. All rights reserved.

