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

=head1 NAME

TrimMergeInfo.pl - Trim Matching Subversion Merge Information

=head1 SYNOPSIS

    perl TrimMergeInfo.pl <wcdir> <regex> [<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 <wcdir>

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 <regex>

These arguments specify Perl regular expressions to look for in the
merge information property. Any entry that matches one of these will
be dropped from the updated property. If dropping the entry would
result in an empty property, the property is deleted.

One or more of these arguments are required.

=back

=cut

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

use IO::Pipe;
use XML::Simple;

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

# 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 exclusion expressions.

die('Repository path exclusion expressions required') unless (@ARGV);
our @gPathExclusions = @ARGV;

# Open a pipe to the recursive XML listing of merge info properties.

my $aPipe = IO::Pipe->new;
$aPipe->reader(
    qq{svn pg svn:mergeinfo "$gWCRoot" --depth=infinity --xml});

die(qq{Unable to get merge info for "$gWCRoot"})
    if ($aPipe->error);

# Read and parse the XML listing of merge information.

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

undef $aPipe;  # Explicitly close the listing pipe.

# 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'};

    # 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.

    my %aMergeInfo;
    my $aIsChanged = 0;
    foreach (split(m{\R+}, $_->{'property'}->{'content'}))
    {
        # Separate the repository path from the revision numbers.

        my ($aReposPath, $aRevisions) = split(m{:}, $_);

        # Compare the repository path to the exclusion patterns.

        my $aSkipIt = 0;
        foreach my $aReposRegex (@gPathExclusions)
        {
            # When the repository path matches a pattern, set the
            # "skip it" flag and indicate a property update.

            if ($aReposPath =~ qr{$aReposRegex})
            {
                $aSkipIt = 1;
                $aIsChanged = 1;
                last;
            }
        }
        next if ($aSkipIt);

        # Save all the entries that don't match a pattern.

        $aMergeInfo{$aReposPath} = $aRevisions;
    }

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

    next unless ($aIsChanged);

    # Handle a reduced set of merge info.

    if (keys %aMergeInfo)
    {
        # 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 $_, ':', $aMergeInfo{$_}, "\n")
            foreach (sort keys %aMergeInfo);
        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);
    }

    # Handle an empty set of merge info.

    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 3 2009-06-01 14:13:36Z Geoffrey $

=head1 COPYRIGHT

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