#! perl

# sync_hg_xxx.pl

use strict;

use Getopt::Long;

use File::Temp qw/ tempfile tempdir /;	# for tempfile()

my $verbose;

my $debug = 0;

my $rootdir;

my $help;

my $remoterepo;

my $hgbranch;

my $sync_prefix = "sync_";

# abandon_sync, all ye who enter here

# This should send a notification to someone, as it will probably mean manual repair

#

sub abandon_sync(@)

	{

	print "ERROR - synchronisation of $rootdir abandoned\n\n";

	print @_;

	print "\n\n";

	exit(1);

	}

# utility to run an external command

#

sub run_cmd($;$)

	{

	my ($cmd,$failurematch) = @_;

	print "--- $cmd\n" if ($verbose || $debug);

	my @output = `$cmd`;

	print @output,"\n---\n" if ($debug);

	if (defined $failurematch)

		{

		if (grep /$failurematch/, @output)

			{

			abandon_sync("COMMAND FAILED: $cmd\n", @output,"\n\n",

				"Output matched $failurematch\n");

			}

		else

			{

			print "CMD OK - Didn't match /$failurematch/\n" if ($debug);

			}

		}

	if ($?)

		{

		print @output,"\n---\n" if ($verbose);

		abandon_sync("COMMAND FAILED: exit status = $?\n",$cmd,"\n");

		}

	return @output;

	}

# -------------- hg section -------------

#

# Code relating to other SCM system is abstracted into 

# functions to do relatively simple actions. This section

# contains the driving logic for the script, and all of the

# manipulations of Mercurial

#

sub scm_usage();		# forward declarations

sub scm_options();

sub scm_init($@);

sub scm_checkout($);	# non-destructive, i.e. leave untouched any workspace files not managed in SCM

sub scm_checkin($$$$$$);

sub Usage(;$)

	{

	my ($errmsg) = @_;

	print "\nERROR: $errmsg\n" if (defined $errmsg);

	scm_usage();

	print <<'EOF';

General options:

-root rootdir       root of the Mercurial gateway repository

-v                  verbose

-h                  print this usage information

Setting up a new synchronisation:

-clone remoterepo   clones gateway from remote repository 

-branch hgbranch    Mercurial branch name (if needed)

EOF

	exit 1;

	}

Usage() if !GetOptions(

	'root=s' => \$rootdir,

	'h' => \$help,

	'v' => \$verbose,

	'debug' => \$debug,

	'clone=s' => \$remoterepo,

	'branch=s' => \$hgbranch,

	scm_options()

	);

Usage() if ($help);

Usage("Must specify root directory for Mercurial gateway") if (!defined $rootdir);

Usage("-branch is only used with -clone") if (defined $hgbranch && !defined $remoterepo);

if ($verbose)

	{

	my @hgversion = run_cmd("hg --version");

	print @hgversion;

	}

# utility to return the heads descended from a particular point

#

sub hg_heads($)

	{

	my ($rev_on_branch) = @_;

	my @heads = run_cmd("hg heads --template {rev}\\t{tags}\\n $rev_on_branch");

	return @heads;

	}

# return an unsorted list of synchronisation points, identified by

# tags beginning with "sync_"

# 

sub hg_syncpoints(;$)

	{

	my ($tip_rev) = @_;

	my @tags = run_cmd("hg tags");

	my @syncpoints;

	foreach my $tag (@tags)

		{

		if ($tag =~ /^tip\s+(\d+):\S+$/)

			{

			$$tip_rev = $1 if (defined $tip_rev);

			next;

			}

		if ($tag =~ /^$sync_prefix(.*\S)\s+\S+$/)

			{

			push @syncpoints, $1;

			next

			}

		}

	if ($debug)

		{

		printf "Found %d syncpoints in %d tags:", scalar @syncpoints, scalar @tags;

		print join("\n * ", "",@syncpoints), "\n";

		}

	return @syncpoints;

	}

my $hg_updated = 0;

# Update the Mercurial workspace to a given sync point

#

sub hg_checkout($)

	{

	my ($scmref) = @_;

	my $tag = $sync_prefix.$scmref;

	my @output = run_cmd("hg update --clean --rev $tag", "^abort:");

	$hg_updated = 1;	# could check the output in case it didn't change anything

	}

# 0. Create the gateway repository, if -clone is specified

if (defined $remoterepo)

	{

	Usage("Cannot create gateway because $rootdir already exists") if (-d $rootdir);

	my $clonecmd = "clone";

	$clonecmd .= " --rev $hgbranch" if (defined $hgbranch);

	my @output = run_cmd("hg $clonecmd $remoterepo $rootdir");

	$hg_updated = 1;

	}

chdir $rootdir;

Usage("$rootdir is not a Mercurial repository") if (!-d ".hg");

my $something_to_push = 0;

# 1. Prime the SCM system, and get the ordered list of changes available to 

# convert into Mercurial commits

my $first_sync;		# is this the first synchronisation?

my $scm_tip_only;	# can we process a series of changes in the SCM system?

my $tip_rev = -1;

my @syncpoints = hg_syncpoints(\$tip_rev);

if (scalar @syncpoints != 0)

	{

	$first_sync = 0;	# no - it's already synchronised

	$scm_tip_only = 0;	# so can allow sequence of SCM changes

	}

else

	{

	print "First synchronisation through this gateway\n" if ($verbose);

 	$first_sync = 1;

	if ($tip_rev != -1)

		{

 		$scm_tip_only = 1;	# because there's already something in the repository

 		}

 	else

 		{

		print "Mercurial repository is empty\n" if ($verbose);

		$scm_tip_only = 0;	# allow multiple SCM changes, because there's nothing to merge with

		}

	}

my $opening_scmtag;	# ancestor by which we judge the headcount of the result

my $latest_scmtag;

my @scmrefs = scm_init($scm_tip_only, @syncpoints);

if (scalar @scmrefs == 0)

	{

	print "No changes to process in local SCM\n";

	$opening_scmtag = $tip_rev;

	}

else

	{

	$opening_scmtag = $sync_prefix.$scmrefs[0];

	}

$latest_scmtag = $opening_scmtag;

if ($scm_tip_only && scalar @scmrefs > 1)

	{

	print "ERROR - cannot handle multiple SCM changes in this situation\n";

	exit(1);

	}

# 2. Process the SCM changes, turning them into Mercurial commits and marking with tags

# - we guarantee that there is at most one change, if this is the first synchronisation

foreach my $scmref (@scmrefs)

	{

	my ($user,$date,@description) = scm_checkout($scmref);

	# commit the result

	my ($fh,$filename) = tempfile();

	print $fh join("\n",@description), "\n";

	close $fh;

	run_cmd("hg commit --addremove --date \"$date\" --user \"$user\" --logfile  $filename", "^abort\:");

	$something_to_push = 1;

	unlink($filename);	# remove temporary file

	my $tag = $sync_prefix.$scmref;

	run_cmd("hg tag --local $tag");

	$latest_scmtag = $tag;

	print "Synchronised $scmref into Mercurial gateway repository\n";

	}

# 3. Put the full Mercurial state into the SCM, if this is the first synchronisation

if ($first_sync)

	{

	my @traceback = run_cmd("hg log --limit 1 --template {rev}\\t{node}\\t{tags}\\n");

	my $line = shift @traceback;

	chomp $line;

	my ($rev,$node,$tags) = split /\t/,$line;

	if ($rev != 0)

		{

		# repository was not empty, so need to commit the current state back into Perforce

		my @description = run_cmd("hg log --rev $rev --template \"{author}\\n{date|isodate}\\n{desc}\"");

		chomp @description;

		my $author = shift @description;

		my $date = shift @description;

		my @changes = run_cmd("hg status --clean");	# include info on unmodified files

		@changes = sort @changes;

		# Deliver changes to SCM

		my $scmref = scm_checkin($node,$author,$date,\@changes,\@description,$tags);

		my $tag = $sync_prefix.$scmref;

		run_cmd("hg tag --local $tag");

		$latest_scmtag = $tag;

		print "Synchronised $scmref from Mercurial gateway, to initialise the synchronisation\n";

		}

	$opening_scmtag = $latest_scmtag;	# don't consider history before this point

	}

# 3. pull from Mercurial default path, deal with new stuff

my @pull_output = run_cmd("hg pull --update");

$hg_updated = 1;

my @heads = hg_heads($opening_scmtag);

if (scalar @heads > 1)

	{

	# more than one head - try a safe merge

	print "WARNING: multiple heads\n",@heads,"\nMerge is needed\n\n\n" if ($verbose);

	my @merge_output = run_cmd("hg --config \"ui.merge=internal:fail\" merge");	# which head?

	if ($merge_output[0] =~ / 0 files unresolved/)

		{

		# successful merge - commit it.

		run_cmd("hg commit --message \"Automatic merge\"");

		$something_to_push = 1;

		}

	else

		{

		# clean up any partially merged files

		run_cmd("hg update -C");

		}

	}

# 4. Identify the sequence of Mercurial changes on the trunk and put them into the SCM

# - Do only the head revision if this is the first synchronisation, to avoid copying ancient history

my $options = "--follow-first";

$options .= " --prune $latest_scmtag";

my @traceback = run_cmd("hg log $options --template {rev}\\t{node}\\t{tags}\\n");

foreach my $line (reverse @traceback)

	{

	chomp $line;

	my ($rev,$node,$tags) = split /\t/,$line;

	if ($tags =~ /$sync_prefix/)

		{

		# shouldn't happen - it would mean that tip goes back to an ancestor

		# of the latest sync point

		abandon_sync("Cannot handle this structure\n",@traceback);

		}

	# Read commit information and update workspace from Mercurial

	my @description = run_cmd("hg log --rev $rev --template \"{author}\\n{date|isodate}\\n{desc}\"");

	chomp @description;

	my $author = shift @description;

	my $date = shift @description;

	my @changes = run_cmd("hg status --rev $latest_scmtag --rev $rev");

	@changes = sort @changes;

	run_cmd("hg update -C --rev $rev");

	$hg_updated = 1;

	# Deliver changes to SCM

	my $scmref = scm_checkin($node,$author,$date,\@changes,\@description,$tags);

	# Tag as the latest sync point

	my $tag = $sync_prefix.$scmref;

	run_cmd("hg tag --local $tag");

	$latest_scmtag = $tag;

	print "Synchronised $scmref from Mercurial gateway\n";

	}

# 3. push changes to the destination gateway

if ($something_to_push)

	{

	my @output = run_cmd("hg -v push --force --rev $latest_scmtag");

	print "\n",@output,"\n" if ($verbose);

	print "Destination Mercurial repository has been updated\n"; 

	}

else

	{

	print "Nothing to push to destination Mercurial repository\n";

	}

# 4. Check to see if we are in a clean state

@heads = hg_heads($opening_scmtag);

if (scalar @heads > 1)

	{

	print "\n------------------\n";

	print "WARNING: Mercurial repository has multiple heads - manual merge recommended\n";

	}

exit(0);

# -------------- SCM section -------------

#

# Code relating to non-Mercurial SCM system.

# This version implements the sync with XXX

#

# Utility functions you might want to call are:

#

# run_cmd($cmd)

# - Function which runs the specified command in a subshell and returns the stdout output as a list

#   of strings. The whole script will terminate if the command returns with a non-zero exit status.

#

# abandon_sync(@messagelines)

# - Terminate the synchronisation script and pass on the message to someone who might care...

#

# $hg_updated

# - Global variable set to 1 if Mercurial changes the content of the workspace. This can be used to

#   optimise the XXX system processing during initialisation, because it indicates when the workspace

#   can be considered "clean" by the XXX system. Should be set to 0 whenever the XXX system knows the

#   state of the workspace.

#

# hg_checkout($scmref)

# - Function to call "hg update" to the sync label associated with $scmref. Used during the scm_init

#   function as part of getting the workspaces in harmony before transferring changes. Will set

#   $hg_updated to 1.

# scm_usage()

#

# This function is called to supply the main "usage" statement for the script, as the

# interesting description is all about the interaction between Mercurial and XXX. It takes no

# arguments and should return nothing.

#

sub scm_usage()

	{

	print <<'EOF';

perl sync_hg_xxx.pl -root rootdir [options]

version 0.7

Synchronise a branch in XXX with a branch in Mercurial.

The branch starts at rootdir, which is a local Mercurial repository.

The Perforce clientspec is assumed to exist, to specify modtime & rmdir, 

and to exclude the .hg directory from the rootdir.

The tool will sync rootdir/... to the specified changelist, and

then reflect all changes affecting this part of the directory tree into

Mercurial.

The -first option is used to specify the first sync point if the gateway

has not been previously synchronised, e.g. when -clone is specified.

Perforce-related options:

-m maxchangelist    highest changelist to consider

                    defaults to #head

EOF

	}

my $max_changelist;			# put XXX-specific global variables here

sub scm_options()

	{

	# set defaults

	$max_changelist = "#head";		# initialise the XXX global variables here, otherwise it doesn't happen

	# return the GetOpt specification

	return (

		'm|max=s' => \$max_changelist,		# add your own bits of GetOpt arguments

		);

	}

# scm_init ($tip_only, @syncpoints)

#

# The main code calls this routine once, passing two arguments, and expects to get a 

# list of identifiers to XXX changes which could be synchronised as individual Mercurial

# commits. These references can be anything which can be used as part of a Mercurial tag name,

# and the main code will call back into this routine supplying the references one at a time

# in the list order.

#

# If $tip_only is true, then the synchronisation can only handle the most recent version

# of the code in the XXX system, and will not be able to sync intermediate steps. This usually

# means that this is the first synchronisation of this branch with Mercurial. At most one identifier

# should be returned.

#

# @syncpoints contains a list of identifiers extracted from the local sync_* tags which mark a change

# that was synchronised with Mercurial in some previous run. This information allows the XXX system

# to ignore changes which have previously been processed, and to set itself into a state where

# the workspace corresponds to the contents of the XXX system at that point.

#

# The function returns the list of change identifiers for changes to be taken out of XXX and applied

# to Mercurial. This list can be empty if there are no new changes since the last synchronisation point,

# or if there is no content in the branch.

sub scm_init($@)

	{

	my ($tip_only, @syncpoints) = @_;

	my $first_changelist;

	if ($tip_only)

		{

		# Script says we must synchronise from the XXX tip revision

		# Find the first changelist

		if (!defined $first_changelist)

			{

			print "XXX branch contains no changes\n";

			return ();

			}

		print "Synchronisation from tip ($first_changelist)\n" if ($verbose);

		# fall through to complete the initialisation

		}

	else

		{

		# deduce the last synchronisation point from the @syncpoints list

		$first_changelist = some_function_of(@syncpoints);

		# Get Mercurial & XXX into the synchronised state

		hg_checkout($first_changelist);		# call back to Mercurial to update from hg repository

		# get XXX into state associated with $first_changelist

		## NB this is a bit Perforce specific - you might prefer to separate tip_only processing

		## from the normal "changes since last synchronisation" processing

		##

		$first_changelist += 1;		# we've already synched that one

		##

		}

	# enumerate the changelists available from the XXX system & return as an ordered list

	my @scmrefs = some_function($first_changelist);

	if ($verbose)

		{

		printf "Found %d new changelists to process\n", scalar @scmrefs;

		print join(", ", @scmrefs), "\n";