#!@@Perl@@ -w

=head1 NAME

@@Name@@ - Merge tool for B<p4 resolve> based on B<tkdiff>

=head1 SYNOPSIS

B<@@Name@@> F<base> F<theirs> F<yours> F<merge>

B<@@Name@@> B<-v>

=head1 DESCRIPTION

This program is suitable for invoking from B<p4 resolve> via the
B<P4MERGE> environment variable when the user selects the "m" option.

First, an attempt is made to determine meaningful names for the BASE,
THEIRS and YOURS files using B<p4 resolve -n> and B<p4 where>.
Second, those files are searched for any existing conflict markers.
Third, B<diff3> is run to merge the files, generating conflict
markers where necessary.
Finally, B<tkdiff> is run in merge mode. This allows the user to interactively
select whether THEIRS or YOURS should prevail for each of the conflicting
chunks.

If any of the 3 source files for the merge already have conflict markers,
then I<@@Name@@> will give up immediately and demand that you clean them
up before proceeding, which is what you should want to do anyway to save
yourself from massive confusion.
This almost always indicates that somebody checked-in a file without resolving
the conflicts, which should be viewed as extremely anti-social behavior.

The meaningful name of the YOURS file is based on the client.
The meaningful name of the THEIRS and  BASE files is based on the client
if the resolve was scheduled by a B<p4 sync>, or based on the depot if
the resolve was scheduled by a B<p4 integrate>.
The version number of the BASE meaningful name will be "#0" if the merge
is baseless.
If a meaningful name cannot be determined, then the local OS filename
(which for BASE and THEIRS is the name of a temporary file) is used.

=head1 OPTIONS

=over 4

=item B<-v>

Print the version number and exit.

=back

=head1 CAVEATS

=over 2

=item *

B<tkdiff> does not allow further editing to the file beyond selecting either
the THEIRS or YOURS files for each conflicting chunk.
If this does not result in an effective merging of the changes, then you
should either edit the file after merging (using B<p4 resolve>'s "e" option),
or quit tkdiff without saving and then edit the file starting with the
original conflict markers.
You might even prefer to skip the file (using B<p4 resolve>'s "s" option),
and then resolve/edit it again to start with Perforce-style conflict markers.

=item *

I<@@Name@@> relies on the fact that B<p4 resolve> does the resolves in the
same order as reported by B<p4 resolve -n>.
This appears to be the case, even though Perforce does not explicitly
guarantee it.

=item *

If any file or directory names end in whitespace, then the "meaningful" names
determined by I<@@Name@@> can be misleading.
It is recommended that you simply avoid this.

=back

=head1 SEE ALSO

=over 2

=item *

tkdiff (http://www.accurev.com/free/tkdiff/)

=item *

diff3 (run B<diff3 --help>)

=back

=cut

use strict;
use Getopt::Long;

# Leaves $? unmodified.
sub check_status {
	my $status=$?;
	my $max=shift || 0;
	if($status>>8 > $max && $max>=0) {
		# Presumedly, the child process generated a message already.
		exit($status>>8);
	}
	elsif($status & 0x7f) {
		my $sig=$status & 0x7f;
		# TBD: If $status & 0x80, then limit coredumpsize 0
		kill $sig, $$;
		die("Signal $sig\n"); # In case it survives.
	}
	return !$status;
}

sub check_for_markers {
	my $file=shift;
	my $tag=shift;
	my $result=1;
	open(IN, "<$file") || die("Failed to read $file because $!");
	while(<IN>) {
		if(/^(<<<<<<< |=======$|>>>>>>> )/) {
			print STDERR "$tag already has conflict markers\n";
			print STDERR "($file line $.)\n";
			$result=0;
			last;
		}
	}
	close(IN);
	return $result;
}

GetOptions(
  'v|version' => sub {
  	print "@@Name@@ @@Version@@\n";
	exit(0);
  }
);

if(@ARGV != 4) {
	print STDERR "usage: @@Name@@ <base> <theirs> <yours> <merge>\n";
	exit 2;
}

my $base=shift;
my $theirs=shift;
my $yours=shift;
my $merge=shift;

my $depot_theirs;
my $theirs_rev;
my $base_rev;
if(open(IN, "@@P4@@ resolve -n $yours |")) {
	$_=<IN>;
	close(IN);
	if(check_status(-1) && m|\s//(.*?)#(\d+)(,#(\d+))?\b|) {
		$depot_theirs="//$1";
		$base_rev=$2;
		$theirs_rev=$2;
		if(defined $4) {
			$theirs_rev=$4;
		}
		--$base_rev;
	}
}
else {
	warn("Failed to read from p4 resolve because $!");
}
warn("Failed to determine location of THEIRS/BASE")
  unless defined $depot_theirs;

my $depot_yours;
my $yours_tag1=$yours;
if(open(IN, "@@P4@@ where $yours |")) {
	$_=<IN>;
	close(IN);
	if(check_status(-1) && m|^(.*)\s+//(.*)\s+[/\\]|) {
		$depot_yours=$1;
		$yours_tag1="//$2";
	}
}
else {
	warn("Failed to read from p4 where because $!");
}
warn("Failed to determine location of YOURS") unless defined $depot_yours;
my $yours_tag="$yours_tag1 (YOURS)";

my $theirs_tag=$theirs;
my $base_tag=$base;
if(defined $depot_theirs) {
	if(defined($depot_yours) && $depot_theirs eq $depot_yours) {
		$theirs_tag=$yours_tag1;
	}
	else {
		$theirs_tag=$depot_theirs;
	}
	$base_tag="$theirs_tag#$base_rev";
	$theirs_tag.="#$theirs_rev";
}
$theirs_tag.=" (THEIRS)";
$base_tag.=" (BASE)";

check_for_markers($base, $base_tag) || exit 1;
check_for_markers($theirs, $theirs_tag) || exit 1;
check_for_markers($yours, $yours_tag) || exit 1;

my $munge=sub {
	if(/^>>>>>>> /) {
		$_ = ">>>>>>> $theirs_tag\n";
	}
	elsif(/^<<<<<<< /) {
		$_ = "<<<<<<< $yours_tag\n";
	}
};

open(IN, "@@Diff3@@ --show-overlap --merge $yours $base $theirs 2>/dev/null |")
  || die("Failed to read from diff3 because $!");
open(OUT, ">$merge") ||
  die("Failed to write $merge because $!");
my $ok;
while(<IN>) {
	$ok=1;
	&$munge;
	print OUT;
}
close(OUT);
close(IN);
check_status(-1);
if(($?>>8)>1 || (($?>>8) && !$ok)) {
	use IO::File;
	use File::Copy;
	copy($yours, $merge) || die("Failed to overwrite $merge because $!");
	system(
	  "@@Diff3@@ -E $yours $base $theirs | ed $merge > /dev/null 2>&1"
	);
	check_status(1);
	my $fh=IO::File::new_tmpfile ||
	  die("Failed to create anonymous temp file because $!");
	open(IN, "<$merge") || die("Failed to read $merge because $!");
	while(<IN>) {
		$fh->print($_);
	}
	close(IN);
	$fh->seek(0, SEEK_SET);
	open(OUT, ">$merge") || die("Failed to overwrite $merge because $!");
	while(<$fh>) {
		&$munge;
		print OUT;
	}
	close(OUT);
	close($fh);
}

exec("@@Tkdiff@@ -conflict $merge -o $merge") ||
  die("Failed to exec tkdiff because $!");