author | Arnaud Lenoir |
Mon, 19 Oct 2009 18:06:51 +0100 | |
changeset 100 | 24273662fe97 |
parent 1 | 4a4ca5a019bb |
permissions | -rw-r--r-- |
#! perl # Copyright (c) 2009 Symbian Foundation Ltd # This component and the accompanying materials are made available # under the terms of the License "Eclipse Public License v1.0" # which accompanies this distribution, and is available # at the URL "http://www.eclipse.org/legal/epl-v10.html". # # Initial Contributors: # Symbian Foundation Ltd - initial contribution. # # Contributors: # # Description: # Perl script to synchronise a Perforce branch with a Mercurial repository 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); }