--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/synch_hg_p4/synch_hg_p4.pl Thu May 28 10:10:03 2009 +0100
@@ -0,0 +1,677 @@
+#! perl
+
+# sync_hg_p4.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 Perforce
+#
+
+sub scm_usage()
+ {
+ print <<'EOF';
+
+perl sync_hg_p4.pl -root rootdir [options]
+version 0.7
+
+Synchronise a branch in Perforce 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;
+
+sub scm_options()
+ {
+ # set defaults
+
+ $max_changelist = "#head";
+
+ # return the GetOpt specification
+ return (
+ 'm|max=s' => \$max_changelist,
+ );
+ }
+
+sub p4_sync($)
+ {
+ my ($changelist)= @_;
+
+ my $sync = $hg_updated? "sync -k":"sync";
+ my @sync_output = run_cmd("p4 $sync ...\@$changelist 2>&1");
+
+ $hg_updated = 0; # avoid doing sync -f next time, if possible
+ return @sync_output;
+ }
+
+sub scm_init($@)
+ {
+ my ($tip_only, @syncpoints) = @_;
+
+ my $first_changelist;
+
+ # decide on the range of changelists to process
+
+ if ($tip_only)
+ {
+ # Script says we must synchronise from the Perforce tip revision
+ my @changes = run_cmd("p4 changes -m2 ...");
+ foreach my $change (@changes)
+ {
+ if ($change =~ /^(Change (\d+) on (\S+) by (\S+)@\S+) /)
+ {
+ $first_changelist = $2;
+ last;
+ }
+ }
+ if (!defined $first_changelist)
+ {
+ print "Perforce branch contains no changes\n";
+ return ();
+ }
+ print "Synchronisation from tip ($first_changelist)\n" if ($verbose);
+ $max_changelist = "#head";
+ }
+ else
+ {
+ # deduce the last synchronisation point from the tags
+ @syncpoints = sort {$b <=> $a} @syncpoints;
+ $first_changelist = shift @syncpoints;
+ printf "%d changes previously synchronised, most recent is %s\n",
+ 1+scalar @syncpoints, $first_changelist;
+
+ # Get Mercurial & Perforce into the synchronised state
+ run_cmd("p4 revert ... 2>&1");
+ hg_checkout($first_changelist);
+ p4_sync($first_changelist);
+ $first_changelist += 1; # we've already synched that one
+ }
+
+ # enumerate the changelists
+
+ my @changes = run_cmd("p4 changes ...\@$first_changelist,$max_changelist");
+
+ my @scmrefs;
+ foreach my $change (reverse @changes)
+ {
+ # Change 297463 on 2003/09/24 by ErnestoG@LON-ERNESTOG02 'Initial MRP files for Component
+ if ($change =~ /^(Change (\d+) on (\S+) by (\S+)@\S+) /)
+ {
+ my $scmref = $2;
+ push @scmrefs, $2;
+ }
+ }
+
+ if ($debug && scalar @scmrefs > 3)
+ {
+ print "DEBUG - Processing only the first 3 SCM changes\n";
+ @scmrefs = ($scmrefs[0],$scmrefs[1],$scmrefs[2]);
+ }
+
+ if ($verbose)
+ {
+ printf "Found %d new changelists to process (range %d to %s)\n",
+ scalar @scmrefs, $first_changelist, $max_changelist;
+ print join(", ", @scmrefs), "\n";
+ }
+
+ return @scmrefs;
+ }
+
+# scm_checkout
+# Update the workspace to reflect the given SCM reference
+#
+sub scm_checkout($)
+ {
+ my ($scmref) = @_;
+
+ my @changelist = run_cmd("p4 describe -s $scmref 2>&1", "$scmref - no such changelist");
+
+ my @change_description;
+ my $change_date;
+ my $change_user;
+
+ my $change_summary = shift @changelist;
+ if ($change_summary =~ /^Change (\d+) by (\S+)@\S+ on (\S+ \S+)/)
+ {
+ $change_user = $2;
+ $change_date = $3;
+ }
+ else
+ {
+ print "Failed to parse change summary => $change_summary\n";
+ exit(1);
+ }
+
+ # Extract the descriptive part of the change description, watching for
+ # the Symbian XML format enforced by the submission checker
+ #
+ my $symbian_format = 0;
+ foreach my $line (@changelist)
+ {
+ last if ($line =~ /^(Affected files|Jobs fixed)/);
+
+ $line =~ s/^\t//; # remove leading tab from description text
+ if ($line =~ /^<EXTERNAL>/)
+ {
+ $symbian_format = 1;
+ @change_description = ();
+ next;
+ }
+ if ($line =~ /^<\/EXTERNAL>/)
+ {
+ $symbian_format = 2;
+ next;
+ }
+
+ chomp $line;
+ push @change_description, $line if ($symbian_format < 2);
+
+ # <detail submitter= "Sangamma VChandangoudar" />
+ if ($line =~ /detail submitter=\s*\"([^\"]+)\"/) # name in " marks
+ {
+ $change_user = $1;
+ }
+ }
+
+ $change_date =~ s/\//-/g; # convert to yyyy-mm-dd hh:mm::ss"
+
+ p4_sync($scmref);
+
+ return ($change_user,$change_date,@change_description);
+ }
+
+# scm_checkin
+# Describe the changes to the workspace as an SCM change
+# Return the new SCM reference
+#
+sub scm_checkin($$$$$$)
+ {
+ my ($hgnode,$author,$date,$changes,$description,$tags) = @_;
+
+ my @hg_tags = grep !/^tip$/, split /\s+/, $tags;
+ my @p4_edit;
+ my @p4_delete;
+ my @p4_add;
+
+ foreach my $line (@$changes)
+ {
+ my $type = substr($line,0,2,""); # removes type as well as extracting it
+ if ($type eq "M ")
+ {
+ push @p4_edit, $line;
+ next;
+ }
+ if ($type eq "A " || $type eq "C ")
+ {
+ push @p4_add, $line;
+ next;
+ }
+ if ($type eq "R ")
+ {
+ push @p4_delete, $line;
+ next;
+ }
+
+ abandon_sync("Unexpected hg status line: $type$line");
+ }
+
+ if (scalar @p4_add)
+ {
+ open P4ADD, "|p4 -x - add";
+ print P4ADD @p4_add;
+ close P4ADD;
+ abandon_sync("Perforce error on p4 add: $?\n") if ($?);
+ }
+
+ if (scalar @p4_edit)
+ {
+ open P4EDIT, "|p4 -x - edit";
+ print P4EDIT @p4_edit;
+ close P4EDIT;
+ abandon_sync("Perforce error on p4 edit: $?\n") if ($?);
+ }
+ if (scalar @p4_delete)
+ {
+ open P4DELETE, "|p4 -x - delete";
+ print P4DELETE @p4_delete;
+ close P4DELETE;
+ abandon_sync("Perforce error on p4 delete: $?\n") if ($?);
+ }
+
+ my @pending_change = run_cmd("p4 change -o");
+
+ # Can't do anything with the author or date information?
+
+ my ($fh,$filename) = tempfile();
+
+ my $hasfiles = 0;
+ foreach my $line (@pending_change)
+ {
+ if ($line =~ /<enter description here>/)
+ {
+ print $fh "\t(Synchronised from Mercurial commit $hgnode: $date $author)";
+ print $fh "\t(Mercurial tags: ", join(", ",$tags),")" if (scalar @hg_tags != 0);
+ print $fh join("\n\t", "", @$description), "\n";
+ next;
+ }
+ $hasfiles = 1 if ($line =~/^Files:/);
+ print $fh $line;
+ }
+
+ close $fh;
+
+ abandon_sync("No files in Perforce submission? $filename\n", @pending_change) if (!$hasfiles);
+
+ my @submission = run_cmd("p4 submit -i < $filename 2>&1");
+
+ unlink($filename); # remove temporary file
+
+ # Change 1419488 renamed change 1419490 and submitted.
+ # Change 1419487 submitted.
+ foreach my $line (reverse @submission)
+ {
+ if ($line =~ /change (\d+)( and)? submitted/i)
+ {
+ return $1;
+ }
+ }
+
+ abandon_sync("Failed to parse output of p4 submit:\n",@submission);
+ }