tools/cross-commit

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Getopt::Long;
   5 Getopt::Long::Configure("bundling", "pass_through");
   6 use File::Spec;
   7 use File::Temp qw(tempfile tempdir);
   8
   9
  10 ################################################################################
  11 # Configure Script
  12
  13 # Whether or not to be chatty about what we're doing.
  14 # Set this on the command line with --verbose.
  15 our $VERBOSE = 1;
  16
  17 # A horizontal rule for formatting lines.
  18 my $ss = "--------------------------------------------------------------------";
  19
  20 # Whether or not to continue when we encounter a potentially serious problem.
  21 # Set this on the command line with --live-dangerously.
  22 our $DOUBLEOH7 = 0;
  23
  24 # The branches to land on.
  25 # Set this on the command line once for each branch with --branch <name>.
  26 our @branches;
  27
  28 # Convenient shorthand for --branch HEAD and --branch MOZILLA_1_8_BRANCH.
  29 # Set these on the command line with --trunk and --moz18.
  30 my $TRUNK;
  31 my $MOZ18;
  32
  33 # The branches to land on if the user doesn't specify a branch.
  34 my @DEFAULT_BRANCHES = qw(HEAD MOZILLA_1_8_BRANCH);
  35
  36 # The CVS options.  Some of these may not make sense in the context
  37 # of this script.  Use them at your own risk.  Note that -f and -r are both
  38 # CVS options and CVS commit options (i.e. they can go either before
  39 # the command as general CVS options or after the commit command as different
  40 # commit-specific options). To avoid ambiguity, you must specify
  41 # the CVS options as --cvs-f and --cvs-r.
  42 our $CVS_OPTION_allow_root;
  43 our $CVS_OPTION_a;
  44 our $CVS_OPTION_b;
  45 our $CVS_OPTION_T;
  46 our $CVS_OPTION_d;
  47 our $CVS_OPTION_e;
  48 our $CVS_OPTION_f;
  49 our $CVS_OPTION_n;
  50 our $CVS_OPTION_Q;
  51 our $CVS_OPTION_q;
  52 our $CVS_OPTION_r;
  53 our $CVS_OPTION_s;
  54 our $CVS_OPTION_t;
  55 our $CVS_OPTION_v;
  56 our $CVS_OPTION_w;
  57 our $CVS_OPTION_x;
  58 our $CVS_OPTION_z;
  59
  60 our @CVS_OPTIONS;
  61
  62 # The CVS commit options: -l -R -r -F <file> -f and -m.
  63 # Some of these may not make sense in the context of this script.
  64 # Use them at your own risk.
  65 our $CVS_COMMIT_OPTION_l;
  66 our $CVS_COMMIT_OPTION_R;
  67 our $CVS_COMMIT_OPTION_r;
  68 our $CVS_COMMIT_OPTION_F;
  69 our $CVS_COMMIT_OPTION_f;
  70 our $CVS_COMMIT_OPTION_m;
  71
  72 our @CVS_COMMIT_OPTIONS;
  73
  74 # Retrieve configuration from a config file, if any.  Config files are just
  75 # regular Perl files and can override the values of all configuration variables
  76 # declared above with "our".
  77 my $cfg_file;
  78 if    (-e ".xcconfig")   { $cfg_file = ".xcconfig" }
  79 elsif (-e "~/.xcconfig") { $cfg_file = "~/.xcconfig" }
  80 if ($cfg_file) {
  81     my $return = do $cfg_file;
  82     die "couldn't parse $cfg_file: $@" if $@;
  83     die "couldn't do $cfg_file: $!"    unless defined $return;
  84     die "couldn't run $cfg_file"       unless $return;
  85 }
  86
  87 # Parse options from the command line.
  88 GetOptions(
  89             # Options specific to this script.
  90             "verbose"               => \$VERBOSE,
  91             "trunk"                 => \$TRUNK,
  92             "moz18"                 => \$MOZ18,
  93             "branch=s"              => \@branches,
  94             "live-dangerously"      => \$DOUBLEOH7,
  95
  96             # CVS options (those that go between "cvs" and "commit").
  97             "allow-root=s"          => \$CVS_OPTION_allow_root,
  98             "a"                     => \$CVS_OPTION_a,
  99             "b=s"                   => \$CVS_OPTION_b,
 100             "T=s"                   => \$CVS_OPTION_T,
 101             "d=s"                   => \$CVS_OPTION_d,
 102             "e=s"                   => \$CVS_OPTION_e,
 103             "cvs-f"                 => \$CVS_OPTION_f,
 104             "n"                     => \$CVS_OPTION_n,
 105             "Q"                     => \$CVS_OPTION_Q,
 106             "q"                     => \$CVS_OPTION_q,
 107             "cvs-r"                 => \$CVS_OPTION_r,
 108             "s"                     => \$CVS_OPTION_s,
 109             "t"                     => \$CVS_OPTION_t,
 110             "v|version"             => \$CVS_OPTION_v,
 111             "w"                     => \$CVS_OPTION_w,
 112             "x"                     => \$CVS_OPTION_x,
 113             "z"                     => \$CVS_OPTION_z,
 114
 115             # CVS commit options (those that go after "commit").
 116             "l"                     => \$CVS_COMMIT_OPTION_l,
 117             "R"                     => \$CVS_COMMIT_OPTION_R,
 118             "r"                     => \$CVS_COMMIT_OPTION_r,
 119             "F=s"                   => \$CVS_COMMIT_OPTION_F,
 120             "f"                     => \$CVS_COMMIT_OPTION_f,
 121             "m=s"                   => \$CVS_COMMIT_OPTION_m,
 122           );
 123
 124
 125 # The rest of the command line should be files or directories to commit.
 126 # You can also leave it blank, in which case it'll check the current directory,
 127 # just like "cvs commit" does.
 128
 129 push(@CVS_OPTIONS,
 130         $CVS_OPTION_allow_root ? ("--allow-root", $CVS_OPTION_allow_root) : (),
 131         $CVS_OPTION_a ? "-a"                   : (),
 132         $CVS_OPTION_b ? ("-b", $CVS_OPTION_b)  : (),
 133         $CVS_OPTION_T ? ("-T", $CVS_OPTION_T)  : (),
 134         $CVS_OPTION_d ? ("-d", $CVS_OPTION_d)  : (),
 135         $CVS_OPTION_e ? ("-e", $CVS_OPTION_e)  : (),
 136         $CVS_OPTION_f ? "-f"                   : (),
 137         $CVS_OPTION_n ? "-n"                   : (),
 138         $CVS_OPTION_Q ? "-Q"                   : (),
 139         $CVS_OPTION_q ? "-q"                   : (),
 140         $CVS_OPTION_r ? "-r"                   : (),
 141         $CVS_OPTION_s ? "-s"                   : (),
 142         $CVS_OPTION_t ? "-t"                   : (),
 143         $CVS_OPTION_v ? "-v"                   : (),
 144         $CVS_OPTION_w ? "-w"                   : (),
 145         $CVS_OPTION_x ? "-x"                   : (),
 146         $CVS_OPTION_z ? ("-z", $CVS_OPTION_z)  : (),
 147 );
 148
 149 push(@CVS_COMMIT_OPTIONS,
 150         $CVS_COMMIT_OPTION_l ? "-l"                         : (),
 151         $CVS_COMMIT_OPTION_R ? "-R"                         : (),
 152         $CVS_COMMIT_OPTION_r ? "-r"                         : (),
 153         $CVS_COMMIT_OPTION_F ? ("-F", $CVS_COMMIT_OPTION_F) : (),
 154         $CVS_COMMIT_OPTION_f ? "-f"                         : (),
 155         $CVS_COMMIT_OPTION_m ? ("-m", $CVS_COMMIT_OPTION_m) : (),
 156 );
 157
 158
 159 ################################################################################
 160 # Initialize
 161
 162 # Duplicate the VERBOSE filehandle to STDOUT if we're being verbose;
 163 # otherwise point it to /dev/null.
 164 my $devnull = File::Spec->devnull();
 165 open(VERBOSE, $VERBOSE ? ">-" : ">$devnull") or warn "Can't output verbose: $!";
 166
 167
 168 ################################################################################
 169 # Get Modified Files and Current Branch
 170
 171 my $files = get_modified_files(\@ARGV);
 172 if (scalar(keys(%$files)) == 0) {
 173     die "*** Didn't find any modified files.\n";
 174 }
 175 else {
 176     print VERBOSE "*** Modified Files:\n  " .
 177                   join("\n  ", sort(keys(%$files))) . "\n";
 178 }
 179
 180 my $current_branch = get_current_branch($files);
 181 print VERBOSE "*** Working Branch:\n  $current_branch\n";
 182
 183
 184 ################################################################################
 185 # Get Branches to Land On
 186
 187 # Figure out what branches the user wants to land on.  Branches can be specified
 188 # via "--branch <name>" or the "--trunk" and "--moz18" shortcuts.  If the user
 189 # doesn't specify any branches, we land on the trunk and the MOZILLA_1_8_BRANCH.
 190 push(@branches, "HEAD") if $TRUNK and !grep($_ eq "HEAD", @branches);
 191 push(@branches, "MOZILLA_1_8_BRANCH")
 192   if $MOZ18 and !grep($_ eq "MOZILLA_1_8_BRANCH", @branches);
 193 push(@branches, @DEFAULT_BRANCHES) if scalar(@branches) == 0;
 194 print VERBOSE "*** Committing to Branches:\n  " . join("\n  ", @branches) .
 195               "\n";
 196
 197 ################################################################################
 198 # Check for Problems
 199
 200 # Make sure the changes apply cleanly to all branches the user wants
 201 # to land them on.
 202 my @conflicts;
 203 foreach my $branch (@branches) {
 204     print VERBOSE "*** Checking for conflicts on $branch... ";
 205     foreach my $spec (sort(keys(%$files))) {
 206         my ($rv, $output, $errors) =
 207           run_cvs("update", [cvs_branch($branch), $spec], 1, 1);
 208         if ($rv != 0) {
 209             # These are spurious errors that go away once we check in
 210             # the removal to the working branch, so we can ignore them.
 211             # XXX Can we really?  Might they not also occur in other situations
 212             # where we shouldn't ignore them?
 213             if ($errors =~ m/removed $spec was modified by second party/) {
 214                 print VERBOSE "(we can safely ignore this conflict)\n";
 215                 next;
 216             }
 217             push(@conflicts, $branch);
 218         }
 219     }
 220 }
 221 if (scalar(@conflicts) > 0) {
 222     die "Conflicts found on " . join(", ", @conflicts) . ".\n"
 223         . "Please resolve them, then try your commit again.\n";
 224 }
 225 else {
 226     print VERBOSE "No conflicts found; good.\n";
 227 }
 228
 229
 230 ################################################################################
 231 # Land on Some Branch
 232
 233 # From now on, if we encounter an error, we should try to return the user's tree
 234 # to its original state, so override the die handler with a function that tries
 235 # to CVS update the tree back to the original working branch.
 236 local $SIG{__DIE__} = sub {
 237     my ($message) = @_;
 238
 239     print $message;
 240     print VERBOSE "*** Returning your tree to its original working branch... ";
 241     run_cvs("update", [cvs_branch($current_branch), keys(%$files)]);
 242     die;
 243 };
 244
 245 # We gotta land somewhere once and then merge those changes into other branches.
 246 my $land_branch;
 247 if (grep($_ eq $current_branch, @branches)) {
 248     # The changes are landing on the current branch.  Groovy, let's land
 249     # there first.  It matters for additions and removals, I think.
 250     $land_branch = $current_branch;
 251 }
 252 else {
 253     # Just land on the first branch in the list.
 254     $land_branch = $branches[0];
 255     print VERBOSE "*** Switching to $land_branch... ";
 256     run_cvs("update", [cvs_branch($land_branch), keys(%$files)]);
 257 }
 258
 259 print VERBOSE "*** Committing to $land_branch... ";
 260 my ($rv, $output, $errors) =
 261   run_cvs("commit", [@CVS_COMMIT_OPTIONS, keys(%$files)]);
 262
 263
 264 ################################################################################
 265 # Extract Commit Info
 266
 267 print VERBOSE "*** Extracting commit info.\n";
 268 my @lines = (split/\n/, $output);
 269 for ( my $i = 0 ; $i < scalar(@lines); $i++ ) {
 270     if ($lines[$i] =~ m/^(?:Checking in|Removing) (.*);$/) {
 271         my $spec = $1;
 272         print VERBOSE "  $spec: ";
 273         my $entry = $files->{$spec};
 274         $entry or die " not on the list of files committed!\n";
 275         $i += 2;
 276         $lines[$i] =~ m/^(initial|new)\srevision:\s
 277                         ([\d\.]+|delete)(?:;\s
 278                         previous\srevision:\s
 279                         ([\d\.]+))?$/x;
 280         if ($1 eq "new") {
 281             print VERBOSE "$3 -> $2.\n";
 282             $entry->{new_rev} = $2 eq "delete" ? "" : $2;
 283             $entry->{old_rev} = $3;
 284         }
 285         elsif ($1 eq "initial") {
 286             print VERBOSE "new file -> $2.\n";
 287             $entry->{new_rev} = $2;
 288             $entry->{old_rev} = "";
 289         }
 290         else {
 291             die "can't figure out its old and new revisions!\n";
 292         }
 293     }
 294 }
 295
 296
 297 ################################################################################
 298 # Check In to Other Branches
 299
 300 foreach my $branch (@branches) {
 301     next if $branch eq $land_branch;
 302
 303     foreach my $spec (sort(keys(%$files))) {
 304         my $entry = $files->{$spec};
 305
 306         if ($entry->{old_rev} && $entry->{new_rev}) {
 307             print VERBOSE "*** Merging $spec changes from $entry->{old_rev} " .
 308                           "to $entry->{new_rev} into $branch... ";
 309             run_cvs("update", [cvs_branch($branch), "-j", $entry->{old_rev},
 310                                "-j", $entry->{new_rev}, $spec]);
 311         }
 312         elsif ($entry->{old_rev}) {
 313             print VERBOSE "*** Removing $spec on $branch... ";
 314             # CVS doesn't tag removed files with a new revision number,
 315             # so we merge from the old revision to the branch itself.
 316             run_cvs("update", [cvs_branch($branch), "-j", $entry->{old_rev},
 317                                "-j", $land_branch, $spec]);
 318         }
 319         elsif ($entry->{new_rev}) {
 320             print VERBOSE "*** Adding $spec on $branch... ";
 321             run_cvs("update", [cvs_branch($branch), "-j", $entry->{new_rev},
 322                                $spec]);
 323         }
 324
 325         print VERBOSE "*** Committing $spec on $branch... ";
 326         run_cvs("commit", [@CVS_COMMIT_OPTIONS, $spec]);
 327     }
 328 }
 329
 330 print VERBOSE "*** Returning your tree to its original working branch... ";
 331 run_cvs("update", [cvs_branch($current_branch), keys(%$files)]);
 332
 333 ################################################################################
 334 # Utility Functions
 335
 336 # Returns a hash of modified files indexed by file spec.
 337 sub get_modified_files {
 338     my ($args) = @_;
 339
 340     # We figure out which files are modified by running "cvs update"
 341     # and grepping for /^(M|A) /.  We run the command in dry run mode so we
 342     # don't actually update the files in the process.
 343     # XXX perhaps we should update them, since we won't be able to commit them
 344     # if they aren't up-to-date; on the other hand, CVS makes you update them
 345     # manually rather than automatically upon commit, so perhaps there's method
 346     # to its madness.
 347
 348     print VERBOSE "*** Looking for modified files... ";
 349     my ($rv, $output, $errors) = run_cvs("update", $args, 1);
 350     # Break the output into lines and filter for lines about changes.
 351     my @lines = grep(m/^(M|A|R) /, split(/\n/, $output));
 352     my %files;
 353     foreach my $line (@lines) {
 354         $line =~ m/^(M|A|R) (.*)/;
 355         $files{$2} = get_cvs_file($2);
 356         $files{$2}->{change_type} = $1;
 357     }
 358     return \%files;
 359 }
 360
 361 # Given a file spec, returns a hash of information about the file extracted
 362 # from the CVS/Entries file.
 363 sub get_cvs_file {
 364     my ($spec) = @_;
 365     my ($volume, $directories, $filename) = File::Spec->splitpath($spec);
 366     my $cvsdir = $directories ? File::Spec->catdir($directories, "CVS") : "CVS";
 367     my $files = File::Spec->catpath($volume, $cvsdir, "Entries");
 368     open(ENTRIES, "<", $files)
 369       or die "Can't read entries file $files for file $spec: $!";
 370     while (<ENTRIES>) {
 371         my ($name, $revision, $timestamp, $conflict, $options, $tagdate) =
 372           ($_ =~ m|/([^/]*)    # filename
 373                    /([^/]*)    # revision
 374                    /([^/+]*)   # timestamp
 375                    (\+[^/]*)?  # (optional) conflict
 376                    /([^/]*)    # options
 377                    /([^/]*)    # tag/date
 378                   |x);
 379         next if $name ne $filename;
 380         close ENTRIES;
 381         return { name => $name, revision => $revision, conflict => $conflict,
 382                  options => $options, tagdate => $tagdate };
 383     }
 384     die "Couldn't find entry for file $spec in entries file $files.";
 385 }
 386
 387 # Given a set of files, extracts their current working branch, testing for
 388 # multiple branches and date-based tags in the process.
 389 sub get_current_branch {
 390     my ($files) = @_;
 391     my %branches;
 392     foreach my $filename (keys %$files) {
 393         my $entry = $files->{$filename};
 394         $entry->{tagdate} =~ m/^(T|D)?(.*)/;
 395         if    ($1 and $1 eq "D") { warn "$filename checked out by date $1\n" }
 396         elsif ($2 eq "")         { $branches{"HEAD"}++ }
 397         else                     { $branches{$2}++ }
 398         if (scalar(keys(%branches)) > 1 && !$DOUBLEOH7) {
 399             die("Modified files checked out from multiple branches:\n  "
 400                 . join("\n  ", map("$_: $files->{$_}->{tagdate}",
 401                                    sort(keys(%$files))))
 402                 . "Sounds scary, so I'm stopping.  Want me to continue?\n"
 403                 . "Run me again with --live-dangerously and tell my authors\n"
 404                 . "how it went.\n");
 405         }
 406     }
 407     return (keys(%branches))[0];
 408 }
 409
 410 # Runs a CVS command and outputs the results.  Runs the command in dry run mode
 411 # if dry run is enabled globally ($DRY_RUN) or for this specific function call;
 412 # and dies on error by default, but can be set to merely warn on error.
 413 # Returns the return value of the CVS command, its output, and its errors.
 414 sub run_cvs {
 415     my ($cmd, $args, $dry_run, $warn_on_err) = @_;
 416     # Let callers override dry run setting, since certain information gathering
 417     # routines always run in dry run mode no matter what the global setting is.
 418
 419     my ($rv, $output, $errors) =
 420       system_capture("cvs",
 421                      @CVS_OPTIONS,
 422                      $dry_run && !$CVS_OPTION_n ? "-n" : (),
 423                      $cmd,
 424                      @$args);
 425     if ($rv != 0) {
 426         if (!$warn_on_err) {
 427             die "\n$errors\n$ss\n";
 428         }
 429         warn "\n$errors\n$ss\n"
 430     }
 431     else {
 432         print VERBOSE "\n$output\n$ss\n";
 433     }
 434     return ($rv, $output, $errors);
 435 }
 436
 437 # Returns the appropriate CVS command line argument for specifying a branch.
 438 # Usually this is -r <branch name>, but if we're dealing with the special HEAD
 439 # branch it's -A instead.
 440 sub cvs_branch {
 441     my ($branch) = @_;
 442     return $branch eq "HEAD" ? "-A" : ("-r", $branch);
 443 }
 444
 445 # Runs a command and captures its output and errors.
 446 # Returns the command's exit code, output, and errors.
 447 sub system_capture {
 448     # XXX This should be using in-memory files, but they require that we close
 449     # STDOUT and STDERR before reopening them on the in-memory files, and doing
 450     # that on STDERR causes CVS to choke with return value 256.
 451
 452     my ($command, @args) = @_;
 453
 454     my ($rv, $output, $errors);
 455
 456     # Back up the original STDOUT and STDERR so we can restore them later.
 457     open(OLDOUT, ">&STDOUT") or die "Can't back up STDOUT to OLDOUT: $!";
 458     open(OLDERR, ">&STDERR") or die "Can't back up STDERR to OLDERR: $!";
 459     use vars qw( *OLDOUT *OLDERR ); # suppress "used only once" warnings
 460
 461     # Close and reopen STDOUT and STDERR to in-memory files, which are just
 462     # scalars that take output and append it to their value.
 463     # XXX Disabled in-memory files in favor of temp files until in-memory issues
 464     # can be worked out.
 465     #close(STDOUT);
 466     #close(STDERR);
 467     #open(STDOUT, ">", \$output) or die "Can't open STDOUT to output var: $!";
 468     #open(STDERR, ">", \$errors) or die "Can't open STDERR to errors var: $!";
 469     my $outfile = tempfile();
 470     my $errfile = tempfile();
 471     # Perl 5.6.1 filehandle duplication doesn't support the three-argument form
 472     # of open, so we can't just open(STDOUT, ">&", $outfile); instead we have to
 473     # create an alias OUTFILE and then do open(STDOUT, ">&OUTFILE").
 474     local *OUTFILE = *$outfile;
 475     local *ERRFILE = *$errfile;
 476     use vars qw( *OUTFILE *ERRFILE ); # suppress "used only once" warnings
 477     open(STDOUT, ">&OUTFILE") or open(STDOUT, ">&OLDOUT")
 478                                  and die "Can't dupe STDOUT to output file: $!";
 479     open(STDERR, ">&ERRFILE") or open(STDOUT, ">&OLDOUT")
 480                                  and open(STDERR, ">&OLDERR")
 481                                  and die "Can't dupe STDERR to errors file: $!";
 482
 483     # Run the command.
 484     print VERBOSE "$command " . join(" ", @args) . "\n";
 485     $rv = system($command, @args);
 486
 487     # Grab output and errors from the temp files.  In a block to localize $/.
 488     # XXX None of this would be necessary if in-memory files was working.
 489     {
 490         local $/ = undef;
 491         seek($outfile, 0, 0);
 492         seek($errfile, 0, 0);
 493         $output = <$outfile>;
 494         $errors = <$errfile>;
 495     }
 496
 497     # Restore original STDOUT and STDERR.
 498     close(STDOUT);
 499     close(STDERR);
 500     open(STDOUT, ">&OLDOUT") or die "Can't restore STDOUT from OLDOUT: $!";
 501     open(STDERR, ">&OLDERR") or die "Can't restore STDERR from OLDERR: $!";
 502
 503     return ($rv, $output, $errors);
 504 }