synch_hg_p4/synch_hg_p4.pl
changeset 0 02cd6b52f378
child 1 4a4ca5a019bb
equal deleted inserted replaced
-1:000000000000 0:02cd6b52f378
       
     1 #! perl
       
     2 
       
     3 # sync_hg_p4.pl
       
     4 
       
     5 use strict;
       
     6 use Getopt::Long;
       
     7 use File::Temp qw/ tempfile tempdir /;	# for tempfile()
       
     8 
       
     9 my $verbose;
       
    10 my $debug = 0;
       
    11 my $rootdir;
       
    12 my $help;
       
    13 my $remoterepo;
       
    14 my $hgbranch;
       
    15 my $sync_prefix = "sync_";
       
    16 
       
    17 # abandon_sync, all ye who enter here
       
    18 # This should send a notification to someone, as it will probably mean manual repair
       
    19 #
       
    20 sub abandon_sync(@)
       
    21 	{
       
    22 	print "ERROR - synchronisation of $rootdir abandoned\n\n";
       
    23 	print @_;
       
    24 	print "\n\n";
       
    25 	exit(1);
       
    26 	}
       
    27 	
       
    28 # utility to run an external command
       
    29 #
       
    30 sub run_cmd($;$)
       
    31 	{
       
    32 	my ($cmd,$failurematch) = @_;
       
    33 	print "--- $cmd\n" if ($verbose || $debug);
       
    34 	my @output = `$cmd`;
       
    35 	print @output,"\n---\n" if ($debug);
       
    36 	
       
    37 	if (defined $failurematch)
       
    38 		{
       
    39 		if (grep /$failurematch/, @output)
       
    40 			{
       
    41 			abandon_sync("COMMAND FAILED: $cmd\n", @output,"\n\n",
       
    42 				"Output matched $failurematch\n");
       
    43 			}
       
    44 		else
       
    45 			{
       
    46 			print "CMD OK - Didn't match /$failurematch/\n" if ($debug);
       
    47 			}
       
    48 		}
       
    49 	if ($?)
       
    50 		{
       
    51 		print @output,"\n---\n" if ($verbose);
       
    52 		abandon_sync("COMMAND FAILED: exit status = $?\n",$cmd,"\n");
       
    53 		}
       
    54 	
       
    55 	return @output;
       
    56 	}
       
    57 	
       
    58 
       
    59 # -------------- hg section -------------
       
    60 #
       
    61 # Code relating to other SCM system is abstracted into 
       
    62 # functions to do relatively simple actions. This section
       
    63 # contains the driving logic for the script, and all of the
       
    64 # manipulations of Mercurial
       
    65 #
       
    66 
       
    67 sub scm_usage();		# forward declarations
       
    68 sub scm_options();
       
    69 sub scm_init($@);
       
    70 sub scm_checkout($);	# non-destructive, i.e. leave untouched any workspace files not managed in SCM
       
    71 sub scm_checkin($$$$$$);
       
    72 
       
    73 sub Usage(;$)
       
    74 	{
       
    75 	my ($errmsg) = @_;
       
    76 	print "\nERROR: $errmsg\n" if (defined $errmsg);
       
    77 	scm_usage();
       
    78 	print <<'EOF';
       
    79 
       
    80 General options:
       
    81 
       
    82 -root rootdir       root of the Mercurial gateway repository
       
    83 -v                  verbose
       
    84 -h                  print this usage information
       
    85 
       
    86 Setting up a new synchronisation:
       
    87 
       
    88 -clone remoterepo   clones gateway from remote repository 
       
    89 -branch hgbranch    Mercurial branch name (if needed)
       
    90 
       
    91 EOF
       
    92 	exit 1;
       
    93 	}
       
    94 
       
    95 Usage() if !GetOptions(
       
    96 	'root=s' => \$rootdir,
       
    97 	'h' => \$help,
       
    98 	'v' => \$verbose,
       
    99 	'debug' => \$debug,
       
   100 	'clone=s' => \$remoterepo,
       
   101 	'branch=s' => \$hgbranch,
       
   102 	scm_options()
       
   103 	);
       
   104 
       
   105 Usage() if ($help);
       
   106 
       
   107 Usage("Must specify root directory for Mercurial gateway") if (!defined $rootdir);
       
   108 Usage("-branch is only used with -clone") if (defined $hgbranch && !defined $remoterepo);
       
   109 
       
   110 if ($verbose)
       
   111 	{
       
   112 	my @hgversion = run_cmd("hg --version");
       
   113 	print @hgversion;
       
   114 	}
       
   115 
       
   116 # utility to return the heads descended from a particular point
       
   117 #
       
   118 sub hg_heads($)
       
   119 	{
       
   120 	my ($rev_on_branch) = @_;
       
   121 	my @heads = run_cmd("hg heads --template {rev}\\t{tags}\\n $rev_on_branch");
       
   122 	return @heads;
       
   123 	}
       
   124 
       
   125 # return an unsorted list of synchronisation points, identified by
       
   126 # tags beginning with "sync_"
       
   127 # 
       
   128 sub hg_syncpoints(;$)
       
   129 	{
       
   130 	my ($tip_rev) = @_;
       
   131 	my @tags = run_cmd("hg tags");
       
   132 	my @syncpoints;
       
   133 	foreach my $tag (@tags)
       
   134 		{
       
   135 		if ($tag =~ /^tip\s+(\d+):\S+$/)
       
   136 			{
       
   137 			$$tip_rev = $1 if (defined $tip_rev);
       
   138 			next;
       
   139 			}
       
   140 		if ($tag =~ /^$sync_prefix(.*\S)\s+\S+$/)
       
   141 			{
       
   142 			push @syncpoints, $1;
       
   143 			next
       
   144 			}
       
   145 		}
       
   146 	if ($debug)
       
   147 		{
       
   148 		printf "Found %d syncpoints in %d tags:", scalar @syncpoints, scalar @tags;
       
   149 		print join("\n * ", "",@syncpoints), "\n";
       
   150 		}
       
   151 	return @syncpoints;
       
   152 	}
       
   153 
       
   154 my $hg_updated = 0;
       
   155 
       
   156 # Update the Mercurial workspace to a given sync point
       
   157 #
       
   158 sub hg_checkout($)
       
   159 	{
       
   160 	my ($scmref) = @_;
       
   161 	
       
   162 	my $tag = $sync_prefix.$scmref;
       
   163 	my @output = run_cmd("hg update --clean --rev $tag", "^abort:");
       
   164 	$hg_updated = 1;	# could check the output in case it didn't change anything
       
   165 	}
       
   166 
       
   167 # 0. Create the gateway repository, if -clone is specified
       
   168 
       
   169 if (defined $remoterepo)
       
   170 	{
       
   171 	Usage("Cannot create gateway because $rootdir already exists") if (-d $rootdir);
       
   172 
       
   173 	my $clonecmd = "clone";
       
   174 	$clonecmd .= " --rev $hgbranch" if (defined $hgbranch);
       
   175 	my @output = run_cmd("hg $clonecmd $remoterepo $rootdir");
       
   176 	$hg_updated = 1;
       
   177 	}
       
   178 
       
   179 chdir $rootdir;
       
   180 Usage("$rootdir is not a Mercurial repository") if (!-d ".hg");
       
   181 
       
   182 my $something_to_push = 0;
       
   183 
       
   184 # 1. Prime the SCM system, and get the ordered list of changes available to 
       
   185 # convert into Mercurial commits
       
   186 
       
   187 my $first_sync;		# is this the first synchronisation?
       
   188 my $scm_tip_only;	# can we process a series of changes in the SCM system?
       
   189 
       
   190 my $tip_rev = -1;
       
   191 my @syncpoints = hg_syncpoints(\$tip_rev);
       
   192 
       
   193 if (scalar @syncpoints != 0)
       
   194 	{
       
   195 	$first_sync = 0;	# no - it's already synchronised
       
   196 	$scm_tip_only = 0;	# so can allow sequence of SCM changes
       
   197 	}
       
   198 else
       
   199 	{
       
   200 	print "First synchronisation through this gateway\n" if ($verbose);
       
   201  	$first_sync = 1;
       
   202 	if ($tip_rev != -1)
       
   203 		{
       
   204  		$scm_tip_only = 1;	# because there's already something in the repository
       
   205  		}
       
   206  	else
       
   207  		{
       
   208 		print "Mercurial repository is empty\n" if ($verbose);
       
   209 		$scm_tip_only = 0;	# allow multiple SCM changes, because there's nothing to merge with
       
   210 		}
       
   211 	}
       
   212 
       
   213 my $opening_scmtag;	# ancestor by which we judge the headcount of the result
       
   214 my $latest_scmtag;
       
   215 
       
   216 my @scmrefs = scm_init($scm_tip_only, @syncpoints);
       
   217 
       
   218 if (scalar @scmrefs == 0)
       
   219 	{
       
   220 	print "No changes to process in local SCM\n";
       
   221 	$opening_scmtag = $tip_rev;
       
   222 	}
       
   223 else
       
   224 	{
       
   225 	$opening_scmtag = $sync_prefix.$scmrefs[0];
       
   226 	}
       
   227 $latest_scmtag = $opening_scmtag;
       
   228 
       
   229 if ($scm_tip_only && scalar @scmrefs > 1)
       
   230 	{
       
   231 	print "ERROR - cannot handle multiple SCM changes in this situation\n";
       
   232 	exit(1);
       
   233 	}
       
   234 
       
   235 # 2. Process the SCM changes, turning them into Mercurial commits and marking with tags
       
   236 # - we guarantee that there is at most one change, if this is the first synchronisation
       
   237 
       
   238 foreach my $scmref (@scmrefs)
       
   239 	{
       
   240 	my ($user,$date,@description) = scm_checkout($scmref);
       
   241 	
       
   242 	# commit the result
       
   243 
       
   244 	my ($fh,$filename) = tempfile();
       
   245 	print $fh join("\n",@description), "\n";
       
   246 	close $fh;
       
   247 	
       
   248 	run_cmd("hg commit --addremove --date \"$date\" --user \"$user\" --logfile  $filename", "^abort\:");
       
   249 	$something_to_push = 1;
       
   250 	
       
   251 	unlink($filename);	# remove temporary file
       
   252 
       
   253 	my $tag = $sync_prefix.$scmref;
       
   254 	run_cmd("hg tag --local $tag");
       
   255 	$latest_scmtag = $tag;
       
   256 	print "Synchronised $scmref into Mercurial gateway repository\n";
       
   257 	}
       
   258 
       
   259 # 3. Put the full Mercurial state into the SCM, if this is the first synchronisation
       
   260 
       
   261 if ($first_sync)
       
   262 	{
       
   263 	my @traceback = run_cmd("hg log --limit 1 --template {rev}\\t{node}\\t{tags}\\n");
       
   264 	my $line = shift @traceback;
       
   265 
       
   266 	chomp $line;
       
   267 	my ($rev,$node,$tags) = split /\t/,$line;
       
   268 	
       
   269 	if ($rev != 0)
       
   270 		{
       
   271 		# repository was not empty, so need to commit the current state back into Perforce
       
   272 	
       
   273 		my @description = run_cmd("hg log --rev $rev --template \"{author}\\n{date|isodate}\\n{desc}\"");
       
   274 		chomp @description;
       
   275 		my $author = shift @description;
       
   276 		my $date = shift @description;
       
   277 		my @changes = run_cmd("hg status --clean");	# include info on unmodified files
       
   278 		@changes = sort @changes;
       
   279 
       
   280 		# Deliver changes to SCM
       
   281 		my $scmref = scm_checkin($node,$author,$date,\@changes,\@description,$tags);
       
   282 		
       
   283 		my $tag = $sync_prefix.$scmref;
       
   284 		run_cmd("hg tag --local $tag");
       
   285 		$latest_scmtag = $tag;
       
   286 		print "Synchronised $scmref from Mercurial gateway, to initialise the synchronisation\n";
       
   287 		}
       
   288 	
       
   289 	$opening_scmtag = $latest_scmtag;	# don't consider history before this point
       
   290 	}
       
   291 
       
   292 
       
   293 # 3. pull from Mercurial default path, deal with new stuff
       
   294 
       
   295 my @pull_output = run_cmd("hg pull --update");
       
   296 $hg_updated = 1;
       
   297 
       
   298 my @heads = hg_heads($opening_scmtag);
       
   299 
       
   300 if (scalar @heads > 1)
       
   301 	{
       
   302 	# more than one head - try a safe merge
       
   303 	print "WARNING: multiple heads\n",@heads,"\nMerge is needed\n\n\n" if ($verbose);
       
   304 	
       
   305 	my @merge_output = run_cmd("hg --config \"ui.merge=internal:fail\" merge");	# which head?
       
   306 	if ($merge_output[0] =~ / 0 files unresolved/)
       
   307 		{
       
   308 		# successful merge - commit it.
       
   309 		run_cmd("hg commit --message \"Automatic merge\"");
       
   310 		$something_to_push = 1;
       
   311 		}
       
   312 	else
       
   313 		{
       
   314 		# clean up any partially merged files
       
   315 		run_cmd("hg update -C");
       
   316 		}
       
   317 	}
       
   318 
       
   319 # 4. Identify the sequence of Mercurial changes on the trunk and put them into the SCM
       
   320 # - Do only the head revision if this is the first synchronisation, to avoid copying ancient history
       
   321 
       
   322 my $options = "--follow-first";
       
   323 $options .= " --prune $latest_scmtag";
       
   324 
       
   325 my @traceback = run_cmd("hg log $options --template {rev}\\t{node}\\t{tags}\\n");
       
   326 foreach my $line (reverse @traceback)
       
   327 	{
       
   328 	chomp $line;
       
   329 	my ($rev,$node,$tags) = split /\t/,$line;
       
   330 	if ($tags =~ /$sync_prefix/)
       
   331 		{
       
   332 		# shouldn't happen - it would mean that tip goes back to an ancestor
       
   333 		# of the latest sync point
       
   334 		abandon_sync("Cannot handle this structure\n",@traceback);
       
   335 		}
       
   336 	
       
   337 	# Read commit information and update workspace from Mercurial
       
   338 	
       
   339 	my @description = run_cmd("hg log --rev $rev --template \"{author}\\n{date|isodate}\\n{desc}\"");
       
   340 	chomp @description;
       
   341 	my $author = shift @description;
       
   342 	my $date = shift @description;
       
   343 	my @changes = run_cmd("hg status --rev $latest_scmtag --rev $rev");
       
   344 	@changes = sort @changes;
       
   345 
       
   346 	run_cmd("hg update -C --rev $rev");
       
   347 	$hg_updated = 1;
       
   348 	
       
   349 	# Deliver changes to SCM
       
   350 	my $scmref = scm_checkin($node,$author,$date,\@changes,\@description,$tags);
       
   351 	
       
   352 	# Tag as the latest sync point
       
   353 	my $tag = $sync_prefix.$scmref;
       
   354 	run_cmd("hg tag --local $tag");
       
   355 	$latest_scmtag = $tag;
       
   356 	print "Synchronised $scmref from Mercurial gateway\n";
       
   357 	}
       
   358 
       
   359 # 3. push changes to the destination gateway
       
   360 
       
   361 if ($something_to_push)
       
   362 	{
       
   363 	my @output = run_cmd("hg -v push --force --rev $latest_scmtag");
       
   364 	print "\n",@output,"\n" if ($verbose);
       
   365 	print "Destination Mercurial repository has been updated\n"; 
       
   366 	}
       
   367 else
       
   368 	{
       
   369 	print "Nothing to push to destination Mercurial repository\n";
       
   370 	}
       
   371 
       
   372 # 4. Check to see if we are in a clean state
       
   373 
       
   374 @heads = hg_heads($opening_scmtag);
       
   375 if (scalar @heads > 1)
       
   376 	{
       
   377 	print "\n------------------\n";
       
   378 	print "WARNING: Mercurial repository has multiple heads - manual merge recommended\n";
       
   379 	}
       
   380 
       
   381 exit(0);
       
   382 
       
   383 
       
   384 # -------------- SCM section -------------
       
   385 #
       
   386 # Code relating to non-Mercurial SCM system.
       
   387 # This version implements the sync with Perforce
       
   388 #
       
   389 
       
   390 sub scm_usage()
       
   391 	{
       
   392 	print <<'EOF';
       
   393 
       
   394 perl sync_hg_p4.pl -root rootdir [options]
       
   395 version 0.7
       
   396  
       
   397 Synchronise a branch in Perforce with a branch in Mercurial.
       
   398 
       
   399 The branch starts at rootdir, which is a local Mercurial repository.
       
   400 The Perforce clientspec is assumed to exist, to specify modtime & rmdir, 
       
   401 and to exclude the .hg directory from the rootdir.
       
   402 
       
   403 The tool will sync rootdir/... to the specified changelist, and
       
   404 then reflect all changes affecting this part of the directory tree into
       
   405 Mercurial.
       
   406 
       
   407 The -first option is used to specify the first sync point if the gateway
       
   408 has not been previously synchronised, e.g. when -clone is specified.
       
   409 
       
   410 Perforce-related options:
       
   411 
       
   412 -m maxchangelist    highest changelist to consider
       
   413                     defaults to #head
       
   414 
       
   415 EOF
       
   416 	}
       
   417 
       
   418 my $max_changelist;
       
   419 
       
   420 sub scm_options()
       
   421 	{
       
   422 	# set defaults
       
   423 	
       
   424 	$max_changelist = "#head";
       
   425 	
       
   426 	# return the GetOpt specification
       
   427 	return (
       
   428 		'm|max=s' => \$max_changelist,
       
   429 		);
       
   430 	}
       
   431 
       
   432 sub p4_sync($)
       
   433 	{
       
   434 	my ($changelist)= @_;
       
   435 	
       
   436 	my $sync = $hg_updated? "sync -k":"sync";
       
   437 	my @sync_output = run_cmd("p4 $sync ...\@$changelist 2>&1");
       
   438 
       
   439 	$hg_updated = 0;	# avoid doing sync -f next time, if possible
       
   440 	return @sync_output;
       
   441 	}
       
   442 
       
   443 sub scm_init($@)
       
   444 	{
       
   445 	my ($tip_only, @syncpoints) = @_;
       
   446 	
       
   447 	my $first_changelist;
       
   448 	
       
   449 	# decide on the range of changelists to process
       
   450 	
       
   451 	if ($tip_only)
       
   452 		{
       
   453 		# Script says we must synchronise from the Perforce tip revision
       
   454 		my @changes = run_cmd("p4 changes -m2 ...");
       
   455 		foreach my $change (@changes)
       
   456 			{
       
   457 			if ($change =~ /^(Change (\d+) on (\S+) by (\S+)@\S+) /)
       
   458 				{
       
   459 				$first_changelist = $2;
       
   460 				last;
       
   461 				}
       
   462 			}
       
   463 		if (!defined $first_changelist)
       
   464 			{
       
   465 			print "Perforce branch contains no changes\n";
       
   466 			return ();
       
   467 			}
       
   468 		print "Synchronisation from tip ($first_changelist)\n" if ($verbose);
       
   469 		$max_changelist = "#head";
       
   470 		}
       
   471 	else
       
   472 		{
       
   473 		# deduce the last synchronisation point from the tags
       
   474 		@syncpoints = sort {$b <=> $a} @syncpoints;
       
   475 		$first_changelist = shift @syncpoints;
       
   476 		printf "%d changes previously synchronised, most recent is %s\n", 
       
   477 				1+scalar @syncpoints, $first_changelist;
       
   478 		
       
   479 		# Get Mercurial & Perforce into the synchronised state
       
   480 		run_cmd("p4 revert ... 2>&1");
       
   481 		hg_checkout($first_changelist);
       
   482 		p4_sync($first_changelist);
       
   483 		$first_changelist += 1;		# we've already synched that one
       
   484 		}
       
   485 	
       
   486 	# enumerate the changelists
       
   487 
       
   488 	my @changes = run_cmd("p4 changes ...\@$first_changelist,$max_changelist");
       
   489 
       
   490 	my @scmrefs;
       
   491 	foreach my $change (reverse @changes)
       
   492 		{
       
   493 		# Change 297463 on 2003/09/24 by ErnestoG@LON-ERNESTOG02 'Initial MRP files for Component
       
   494 		if ($change =~ /^(Change (\d+) on (\S+) by (\S+)@\S+) /)
       
   495 			{
       
   496 			my $scmref = $2;
       
   497 			push @scmrefs, $2;
       
   498 			}
       
   499 		}
       
   500 
       
   501 	if ($debug && scalar @scmrefs > 3)
       
   502 		{
       
   503 		print "DEBUG - Processing only the first 3 SCM changes\n";
       
   504 		@scmrefs = ($scmrefs[0],$scmrefs[1],$scmrefs[2]);
       
   505 		}
       
   506 
       
   507 	if ($verbose)
       
   508 		{
       
   509 		printf "Found %d new changelists to process (range %d to %s)\n",
       
   510 			scalar @scmrefs, $first_changelist, $max_changelist;
       
   511 		print join(", ", @scmrefs), "\n";
       
   512 		}
       
   513 	
       
   514 	return @scmrefs;
       
   515 	}
       
   516 
       
   517 # scm_checkout
       
   518 # Update the workspace to reflect the given SCM reference
       
   519 #
       
   520 sub scm_checkout($)
       
   521 	{
       
   522 	my ($scmref) = @_;
       
   523 	
       
   524 	my @changelist = run_cmd("p4 describe -s $scmref 2>&1", "$scmref - no such changelist");
       
   525 	
       
   526 	my @change_description;
       
   527 	my $change_date;
       
   528 	my $change_user;
       
   529 	
       
   530 	my $change_summary = shift @changelist;
       
   531 	if ($change_summary =~ /^Change (\d+) by (\S+)@\S+ on (\S+ \S+)/)
       
   532 		{
       
   533 		$change_user = $2;
       
   534 		$change_date = $3;
       
   535 		}
       
   536 	else
       
   537 		{
       
   538 		print "Failed to parse change summary => $change_summary\n";
       
   539 		exit(1);
       
   540 		}
       
   541 	
       
   542 	# Extract the descriptive part of the change description, watching for
       
   543 	# the Symbian XML format enforced by the submission checker
       
   544 	#
       
   545 	my $symbian_format = 0;
       
   546 	foreach my $line (@changelist)
       
   547 		{
       
   548 		last if ($line =~ /^(Affected files|Jobs fixed)/);
       
   549 
       
   550 		$line =~ s/^\t//;	# remove leading tab from description text
       
   551 		if ($line =~ /^<EXTERNAL>/)
       
   552 			{
       
   553 			$symbian_format = 1;
       
   554 			@change_description = ();
       
   555 			next;
       
   556 			}
       
   557 		if ($line =~ /^<\/EXTERNAL>/)
       
   558 			{
       
   559 			$symbian_format = 2;
       
   560 			next;
       
   561 			}
       
   562 		
       
   563 		chomp $line;
       
   564 		push @change_description, $line if ($symbian_format < 2);
       
   565 		
       
   566 		# <detail submitter=      "Sangamma VChandangoudar" />
       
   567 		if ($line =~ /detail submitter=\s*\"([^\"]+)\"/)	# name in " marks
       
   568 			{
       
   569 			$change_user = $1;
       
   570 			}
       
   571 		}
       
   572 	
       
   573 	$change_date =~ s/\//-/g;	# convert to yyyy-mm-dd hh:mm::ss"
       
   574 	
       
   575 	p4_sync($scmref);
       
   576 	
       
   577 	return ($change_user,$change_date,@change_description);
       
   578 	}
       
   579 
       
   580 # scm_checkin
       
   581 # Describe the changes to the workspace as an SCM change
       
   582 # Return the new SCM reference
       
   583 #
       
   584 sub scm_checkin($$$$$$)
       
   585 	{
       
   586 	my ($hgnode,$author,$date,$changes,$description,$tags) = @_;
       
   587 	
       
   588 	my @hg_tags = grep !/^tip$/, split /\s+/, $tags;
       
   589 	my @p4_edit;
       
   590 	my @p4_delete;
       
   591 	my @p4_add;
       
   592 	
       
   593 	foreach my $line (@$changes)
       
   594 		{
       
   595 		my $type = substr($line,0,2,"");	# removes type as well as extracting it
       
   596 		if ($type eq "M ")
       
   597 			{
       
   598 			push @p4_edit, $line;
       
   599 			next;
       
   600 			}
       
   601 		if ($type eq "A " || $type eq "C ")
       
   602 			{
       
   603 			push @p4_add, $line;
       
   604 			next;
       
   605 			}		
       
   606 		if ($type eq "R ")
       
   607 			{
       
   608 			push @p4_delete, $line;
       
   609 			next;
       
   610 			}
       
   611 		
       
   612 		abandon_sync("Unexpected hg status line: $type$line");
       
   613 		}
       
   614 	
       
   615 	if (scalar @p4_add)
       
   616 		{
       
   617 		open P4ADD, "|p4 -x - add";
       
   618 		print P4ADD @p4_add;
       
   619 		close P4ADD;
       
   620 		abandon_sync("Perforce error on p4 add: $?\n") if ($?);
       
   621 		}
       
   622 	
       
   623 	if (scalar @p4_edit)
       
   624 		{
       
   625 		open P4EDIT, "|p4 -x - edit";
       
   626 		print P4EDIT @p4_edit;
       
   627 		close P4EDIT;
       
   628 		abandon_sync("Perforce error on p4 edit: $?\n") if ($?);
       
   629 		}
       
   630 	if (scalar @p4_delete)
       
   631 		{
       
   632 		open P4DELETE, "|p4 -x - delete";
       
   633 		print P4DELETE @p4_delete;
       
   634 		close P4DELETE;
       
   635 		abandon_sync("Perforce error on p4 delete: $?\n") if ($?);
       
   636 		}
       
   637 	
       
   638 	my @pending_change = run_cmd("p4 change -o");
       
   639 	
       
   640 	# Can't do anything with the author or date information?
       
   641 	
       
   642 	my ($fh,$filename) = tempfile();
       
   643 
       
   644 	my $hasfiles = 0;
       
   645 	foreach my $line (@pending_change)
       
   646 		{
       
   647 		if ($line =~ /<enter description here>/)
       
   648 			{
       
   649 			print $fh "\t(Synchronised from Mercurial commit $hgnode: $date $author)";
       
   650 			print $fh "\t(Mercurial tags: ", join(", ",$tags),")" if (scalar @hg_tags != 0);
       
   651 			print $fh join("\n\t", "", @$description), "\n";
       
   652 			next;
       
   653 			}
       
   654 		$hasfiles = 1 if ($line =~/^Files:/);
       
   655 		print $fh $line;
       
   656 		}
       
   657 	
       
   658 	close $fh;
       
   659 	
       
   660 	abandon_sync("No files in Perforce submission? $filename\n", @pending_change) if (!$hasfiles);
       
   661 	
       
   662 	my @submission = run_cmd("p4 submit -i < $filename 2>&1");
       
   663 	
       
   664 	unlink($filename);	# remove temporary file
       
   665 	
       
   666 	# Change 1419488 renamed change 1419490 and submitted.
       
   667 	# Change 1419487 submitted.
       
   668 	foreach my $line (reverse @submission)
       
   669 		{
       
   670 		if ($line =~ /change (\d+)( and)? submitted/i)
       
   671 			{
       
   672 			return $1;
       
   673 			}
       
   674 		}
       
   675 	
       
   676 	abandon_sync("Failed to parse output of p4 submit:\n",@submission);
       
   677 	}