Added a script to run the tree merge procedure

From: Mauro Carvalho Chehab <mchehab@redhat.com>

hgimport was recommending a basic merge procedure. However, with some troubles:
- The procedure only works if the pulled tree creates a new head;
- The merge message should be manually written;
- No sanity checks were done before doing the merge;
- No error status were done.

The new perl script implements a better way to handle it, doing the necessary checks.

hgimport was updated to recommend the script usage.

Priority: normal

Signed-off-by: Mauro Carvalho Chehab <mchehab@redhat.com>

1 files changed, 175 insertions, 0 deletions

diff --git a/v4l/scripts/do_merge.pl b/v4l/scripts/do_merge.pl
new file mode 100755
index 000000000..1ceb0ce75
--- /dev/null
+++ b/v4l/scripts/do_merge.pl
@@ -0,0 +1,175 @@
+#!/usr/bin/perl
+
+my $merge_tree=shift or die "Should specify the pulled tree";
+
+sub hgrcuser($)
+{
+	my $file = shift;
+	my $ui = 0;
+	open IN, '<', $file;
+	while (<IN>) {
+		$ui = 1 if (/^\s*\[ui\]/);
+		if ($ui && /^\s*username\s*=\s*(\S.*?)\s*$/) {
+			close IN;
+			return($1);
+		}
+	}
+	close IN;
+	return("");
+}
+
+sub check_heads()
+{
+	my $count=0;
+	open IN, 'hg heads|';
+	while (<IN>) {
+		if (m/^[Cc]hangeset:/) {
+			$count++;
+		}
+	}
+	close IN;
+	return $count;
+}
+
+sub curr_changeset()
+{
+	my $changeset = -1;
+
+	open IN, 'hg heads|';
+	while (<IN>) {
+		if (m/^[Cc]hangeset:\s*(\d+)/) {
+			if ($changeset < 0) {
+				$changeset = $1;
+			} else {
+				if ($1 < $changeset) {
+					$changeset = $1;
+				}
+			}
+		}
+	}
+	close IN;
+	return $changeset;
+}
+
+sub check_status()
+{
+	my $count=0;
+	open IN, 'hg status -m -a -d -r|';
+	while (<IN>) {
+		$count++;
+	}
+	close IN;
+	return $count;
+}
+
+sub rollback()
+{
+	print "Rolling back hg pull $merge_tree\n";
+	system("hg rollback");
+	system("hg update -C");
+	exit -1;
+}
+
+####################
+# Determine username
+
+# Get Hg username from environment
+my $user = $ENV{HGUSER};
+
+# Didn't work? Try the repo's .hgrc file
+if ($user eq "") {
+	my $hgroot = `hg root`;
+	chomp($hgroot);
+	$user = hgrcuser("$hgroot/.hg/hgrc");
+}
+# Ok, try ~/.hgrc next
+if ($user eq "") {
+	$user = hgrcuser("$ENV{HOME}/.hgrc");
+}
+
+# Still no luck? Try some other environment variables
+if ($user eq "") {
+	my $name = $ENV{CHANGE_LOG_NAME};
+	my $email = $ENV{CHANGE_LOG_EMAIL_ADDRESS};
+	$user = "$name <$email>" if ($name ne "" || $email ne "");
+}
+
+# Last try to come up with something
+if ($user eq "") {
+	print "User not known. Can't procceed\n";
+	exit -1;
+}
+
+######################
+# Do some sanity tests
+
+print "Checking if everything is ok, before applying the new tree.\n";
+
+my $n_heads = check_heads();
+die "Your tree currently have more than one head (it has $n_heads heads). Can't procceed\n" if ($n_heads > 1);
+
+my $dirty = check_status();
+die "Your tree currently has changes. Can't procceed\n" if ($dirty);
+
+my $curr_cs = curr_changeset();
+
+###########
+# Pull tree
+
+print "hg pull $merge_tree\n";
+
+my $ret = system("hg pull $merge_tree");
+die "Couldn't pull from $merge_tree\n" if ($ret);
+
+#############################
+# Merge and commit, if needed
+
+$n_heads = check_heads();
+if ($n_heads > 2) {
+	print "The merged tree have more than one head (it has $n_heads heads). Can't procceed.\n";
+	rollback();
+}
+
+if ($n_heads == 2) {
+	print "Merging the new changesets\n";
+
+	$ret = system("hg merge");
+	if ($ret) {
+		print "hg merge failed. Can't procceed.\n";
+		rollback();
+	}
+
+	print "Committing the new tree\n";
+	# Write the commit message
+	$msg= "merge: $merge_tree\n\nFrom: $user\n\nSigned-off-by: $user\n";
+	$ret=system("hg commit -m '$msg'");
+	if ($ret) {
+		print "hg commit failed. Can't procceed.\n";
+		rollback();
+	}
+}
+
+#####################
+# Test resulting tree
+
+print "Testing if the build didn't break compilation. Only errors and warnings will be displayed. Please wait.\n";
+$ret = system ('make all|grep -v "^ CC"|grep -v "^ LD"');
+if ($ret) {
+	print "Build failed. Can't procceed.\n";
+
+	# To avoid the risk of doing something really bad, let's ask the user to run hg strip
+	print "Your tree is dirty. Since hg has only one rollback level, you'll need to use, instead:";
+	print "\thg strip $curr_cs; hg update -C";
+	print "You'll need to have hg mq extension enabled for hg strip to work.\n";
+
+	exit -1;
+}
+
+##############################
+# Everything is ok, let's push
+
+print "Pushing the new tree at the remote repository specified at .hg/hgrc\n";
+$ret=system ("hg push");
+if ($ret) {
+	print "hg push failed. Don't forget to do the push later.\n";
+}