mozilla
/
gecko-dev
зеркало из https://github.com/mozilla/gecko-dev.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность
gecko-dev/tools/cross-commit

505 строки
19 KiB
Perl
Executable File
Исходник Ответственный История

#!/usr/bin/perl -w
use strict;
use Getopt::Long;
Getopt::Long::Configure("bundling", "pass_through");
use File::Spec;
use File::Temp qw(tempfile tempdir);
################################################################################
# Configure Script
# Whether or not to be chatty about what we're doing.
# Set this on the command line with --verbose.
our $VERBOSE = 1;
# A horizontal rule for formatting lines.
my $ss = "--------------------------------------------------------------------";
# Whether or not to continue when we encounter a potentially serious problem.
# Set this on the command line with --live-dangerously.
our $DOUBLEOH7 = 0;
# The branches to land on.
# Set this on the command line once for each branch with --branch <name>.
our @branches;
# Convenient shorthand for --branch HEAD and --branch MOZILLA_1_8_BRANCH.
# Set these on the command line with --trunk and --moz18.
my $TRUNK;
my $MOZ18;
# The branches to land on if the user doesn't specify a branch.
my @DEFAULT_BRANCHES = qw(HEAD MOZILLA_1_8_BRANCH);
# The CVS options. Some of these may not make sense in the context
# of this script. Use them at your own risk. Note that -f and -r are both
# CVS options and CVS commit options (i.e. they can go either before
# the command as general CVS options or after the commit command as different
# commit-specific options). To avoid ambiguity, you must specify
# the CVS options as --cvs-f and --cvs-r.
our $CVS_OPTION_allow_root;
our $CVS_OPTION_a;
our $CVS_OPTION_b;
our $CVS_OPTION_T;
our $CVS_OPTION_d;
our $CVS_OPTION_e;
our $CVS_OPTION_f;
our $CVS_OPTION_n;
our $CVS_OPTION_Q;
our $CVS_OPTION_q;
our $CVS_OPTION_r;
our $CVS_OPTION_s;
our $CVS_OPTION_t;
our $CVS_OPTION_v;
our $CVS_OPTION_w;
our $CVS_OPTION_x;
our $CVS_OPTION_z;
our @CVS_OPTIONS;
# The CVS commit options: -l -R -r -F <file> -f and -m.
# Some of these may not make sense in the context of this script.
# Use them at your own risk.
our $CVS_COMMIT_OPTION_l;
our $CVS_COMMIT_OPTION_R;
our $CVS_COMMIT_OPTION_r;
our $CVS_COMMIT_OPTION_F;
our $CVS_COMMIT_OPTION_f;
our $CVS_COMMIT_OPTION_m;
our @CVS_COMMIT_OPTIONS;
# Retrieve configuration from a config file, if any. Config files are just
# regular Perl files and can override the values of all configuration variables
# declared above with "our".
my $cfg_file;
if (-e ".xcconfig") { $cfg_file = ".xcconfig" }
elsif (-e "~/.xcconfig") { $cfg_file = "~/.xcconfig" }
if ($cfg_file) {
my $return = do $cfg_file;
die "couldn't parse $cfg_file: $@" if $@;
die "couldn't do $cfg_file: $!" unless defined $return;
die "couldn't run $cfg_file" unless $return;
}
# Parse options from the command line.
GetOptions(
# Options specific to this script.
"verbose" => \$VERBOSE,
"trunk" => \$TRUNK,
"moz18" => \$MOZ18,
"branch=s" => \@branches,
"live-dangerously" => \$DOUBLEOH7,
# CVS options (those that go between "cvs" and "commit").
"allow-root=s" => \$CVS_OPTION_allow_root,
"a" => \$CVS_OPTION_a,
"b=s" => \$CVS_OPTION_b,
"T=s" => \$CVS_OPTION_T,
"d=s" => \$CVS_OPTION_d,
"e=s" => \$CVS_OPTION_e,
"cvs-f" => \$CVS_OPTION_f,
"n" => \$CVS_OPTION_n,
"Q" => \$CVS_OPTION_Q,
"q" => \$CVS_OPTION_q,
"cvs-r" => \$CVS_OPTION_r,
"s" => \$CVS_OPTION_s,
"t" => \$CVS_OPTION_t,
"v|version" => \$CVS_OPTION_v,
"w" => \$CVS_OPTION_w,
"x" => \$CVS_OPTION_x,
"z" => \$CVS_OPTION_z,
# CVS commit options (those that go after "commit").
"l" => \$CVS_COMMIT_OPTION_l,
"R" => \$CVS_COMMIT_OPTION_R,
"r" => \$CVS_COMMIT_OPTION_r,
"F=s" => \$CVS_COMMIT_OPTION_F,
"f" => \$CVS_COMMIT_OPTION_f,
"m=s" => \$CVS_COMMIT_OPTION_m,
);
# The rest of the command line should be files or directories to commit.
# You can also leave it blank, in which case it'll check the current directory,
# just like "cvs commit" does.
push(@CVS_OPTIONS,
$CVS_OPTION_allow_root ? ("--allow-root", $CVS_OPTION_allow_root) : (),
$CVS_OPTION_a ? "-a" : (),
$CVS_OPTION_b ? ("-b", $CVS_OPTION_b) : (),
$CVS_OPTION_T ? ("-T", $CVS_OPTION_T) : (),
$CVS_OPTION_d ? ("-d", $CVS_OPTION_d) : (),
$CVS_OPTION_e ? ("-e", $CVS_OPTION_e) : (),
$CVS_OPTION_f ? "-f" : (),
$CVS_OPTION_n ? "-n" : (),
$CVS_OPTION_Q ? "-Q" : (),
$CVS_OPTION_q ? "-q" : (),
$CVS_OPTION_r ? "-r" : (),
$CVS_OPTION_s ? "-s" : (),
$CVS_OPTION_t ? "-t" : (),
$CVS_OPTION_v ? "-v" : (),
$CVS_OPTION_w ? "-w" : (),
$CVS_OPTION_x ? "-x" : (),
$CVS_OPTION_z ? ("-z", $CVS_OPTION_z) : (),
);
push(@CVS_COMMIT_OPTIONS,
$CVS_COMMIT_OPTION_l ? "-l" : (),
$CVS_COMMIT_OPTION_R ? "-R" : (),
$CVS_COMMIT_OPTION_r ? "-r" : (),
$CVS_COMMIT_OPTION_F ? ("-F", $CVS_COMMIT_OPTION_F) : (),
$CVS_COMMIT_OPTION_f ? "-f" : (),
$CVS_COMMIT_OPTION_m ? ("-m", $CVS_COMMIT_OPTION_m) : (),
);
################################################################################
# Initialize
# Duplicate the VERBOSE filehandle to STDOUT if we're being verbose;
# otherwise point it to /dev/null.
my $devnull = File::Spec->devnull();
open(VERBOSE, $VERBOSE ? ">-" : ">$devnull") or warn "Can't output verbose: $!";
################################################################################
# Get Modified Files and Current Branch
my $files = get_modified_files(\@ARGV);
if (scalar(keys(%$files)) == 0) {
die "*** Didn't find any modified files.\n";
}
else {
print VERBOSE "*** Modified Files:\n " .
join("\n ", sort(keys(%$files))) . "\n";
}
my $current_branch = get_current_branch($files);
print VERBOSE "*** Working Branch:\n $current_branch\n";
################################################################################
# Get Branches to Land On
# Figure out what branches the user wants to land on. Branches can be specified
# via "--branch <name>" or the "--trunk" and "--moz18" shortcuts. If the user
# doesn't specify any branches, we land on the trunk and the MOZILLA_1_8_BRANCH.
push(@branches, "HEAD") if $TRUNK and !grep($_ eq "HEAD", @branches);
push(@branches, "MOZILLA_1_8_BRANCH")
if $MOZ18 and !grep($_ eq "MOZILLA_1_8_BRANCH", @branches);
push(@branches, @DEFAULT_BRANCHES) if scalar(@branches) == 0;
print VERBOSE "*** Committing to Branches:\n " . join("\n ", @branches) .
"\n";
################################################################################
# Check for Problems
# Make sure the changes apply cleanly to all branches the user wants
# to land them on.
my @conflicts;
foreach my $branch (@branches) {
print VERBOSE "*** Checking for conflicts on $branch... ";
foreach my $spec (sort(keys(%$files))) {
my ($rv, $output, $errors) =
run_cvs("update", [cvs_branch($branch), $spec], 1, 1);
if ($rv != 0) {
# These are spurious errors that go away once we check in
# the removal to the working branch, so we can ignore them.
# XXX Can we really? Might they not also occur in other situations
# where we shouldn't ignore them?
if ($errors =~ m/removed $spec was modified by second party/) {
print VERBOSE "(we can safely ignore this conflict)\n";
next;
}
push(@conflicts, $branch);
}
}
}
if (scalar(@conflicts) > 0) {
die "Conflicts found on " . join(", ", @conflicts) . ".\n"
. "Please resolve them, then try your commit again.\n";
}
else {
print VERBOSE "No conflicts found; good.\n";
}
################################################################################
# Land on Some Branch
# From now on, if we encounter an error, we should try to return the user's tree
# to its original state, so override the die handler with a function that tries
# to CVS update the tree back to the original working branch.
local $SIG{__DIE__} = sub {
my ($message) = @_;
print $message;
print VERBOSE "*** Returning your tree to its original working branch... ";
run_cvs("update", [cvs_branch($current_branch), keys(%$files)]);
die;
};
# We gotta land somewhere once and then merge those changes into other branches.
my $land_branch;
if (grep($_ eq $current_branch, @branches)) {
# The changes are landing on the current branch. Groovy, let's land
# there first. It matters for additions and removals, I think.
$land_branch = $current_branch;
}
else {
# Just land on the first branch in the list.
$land_branch = $branches[0];
print VERBOSE "*** Switching to $land_branch... ";
run_cvs("update", [cvs_branch($land_branch), keys(%$files)]);
}
print VERBOSE "*** Committing to $land_branch... ";
my ($rv, $output, $errors) =
run_cvs("commit", [@CVS_COMMIT_OPTIONS, keys(%$files)]);
################################################################################
# Extract Commit Info
print VERBOSE "*** Extracting commit info.\n";
my @lines = (split/\n/, $output);
for ( my $i = 0 ; $i < scalar(@lines); $i++ ) {
if ($lines[$i] =~ m/^(?:Checking in|Removing) (.*);$/) {
my $spec = $1;
print VERBOSE " $spec: ";
my $entry = $files->{$spec};
$entry or die " not on the list of files committed!\n";
$i += 2;
$lines[$i] =~ m/^(initial|new)\srevision:\s
([\d\.]+|delete)(?:;\s
previous\srevision:\s
([\d\.]+))?$/x;
if ($1 eq "new") {
print VERBOSE "$3 -> $2.\n";
$entry->{new_rev} = $2 eq "delete" ? "" : $2;
$entry->{old_rev} = $3;
}
elsif ($1 eq "initial") {
print VERBOSE "new file -> $2.\n";
$entry->{new_rev} = $2;
$entry->{old_rev} = "";
}
else {
die "can't figure out its old and new revisions!\n";
}
}
}
################################################################################
# Check In to Other Branches
foreach my $branch (@branches) {
next if $branch eq $land_branch;
foreach my $spec (sort(keys(%$files))) {
my $entry = $files->{$spec};
if ($entry->{old_rev} && $entry->{new_rev}) {
print VERBOSE "*** Merging $spec changes from $entry->{old_rev} " .
"to $entry->{new_rev} into $branch... ";
run_cvs("update", [cvs_branch($branch), "-j", $entry->{old_rev},
"-j", $entry->{new_rev}, $spec]);
}
elsif ($entry->{old_rev}) {
print VERBOSE "*** Removing $spec on $branch... ";
# CVS doesn't tag removed files with a new revision number,
# so we merge from the old revision to the branch itself.
run_cvs("update", [cvs_branch($branch), "-j", $entry->{old_rev},
"-j", $land_branch, $spec]);
}
elsif ($entry->{new_rev}) {
print VERBOSE "*** Adding $spec on $branch... ";
run_cvs("update", [cvs_branch($branch), "-j", $entry->{new_rev},
$spec]);
}
print VERBOSE "*** Committing $spec on $branch... ";
run_cvs("commit", [@CVS_COMMIT_OPTIONS, $spec]);
}
}
print VERBOSE "*** Returning your tree to its original working branch... ";
run_cvs("update", [cvs_branch($current_branch), keys(%$files)]);
################################################################################
# Utility Functions
# Returns a hash of modified files indexed by file spec.
sub get_modified_files {
my ($args) = @_;
# We figure out which files are modified by running "cvs update"
# and grepping for /^(M|A) /. We run the command in dry run mode so we
# don't actually update the files in the process.
# XXX perhaps we should update them, since we won't be able to commit them
# if they aren't up-to-date; on the other hand, CVS makes you update them
# manually rather than automatically upon commit, so perhaps there's method
# to its madness.
print VERBOSE "*** Looking for modified files... ";
my ($rv, $output, $errors) = run_cvs("update", $args, 1);
# Break the output into lines and filter for lines about changes.
my @lines = grep(m/^(M|A|R) /, split(/\n/, $output));
my %files;
foreach my $line (@lines) {
$line =~ m/^(M|A|R) (.*)/;
$files{$2} = get_cvs_file($2);
$files{$2}->{change_type} = $1;
}
return \%files;
}
# Given a file spec, returns a hash of information about the file extracted
# from the CVS/Entries file.
sub get_cvs_file {
my ($spec) = @_;
my ($volume, $directories, $filename) = File::Spec->splitpath($spec);
my $cvsdir = $directories ? File::Spec->catdir($directories, "CVS") : "CVS";
my $files = File::Spec->catpath($volume, $cvsdir, "Entries");
open(ENTRIES, "<", $files)
or die "Can't read entries file $files for file $spec: $!";
while (<ENTRIES>) {
my ($name, $revision, $timestamp, $conflict, $options, $tagdate) =
($_ =~ m|/([^/]*) # filename
/([^/]*) # revision
/([^/+]*) # timestamp
(\+[^/]*)? # (optional) conflict
/([^/]*) # options
/([^/]*) # tag/date
|x);
next if $name ne $filename;
close ENTRIES;
return { name => $name, revision => $revision, conflict => $conflict,
options => $options, tagdate => $tagdate };
}
die "Couldn't find entry for file $spec in entries file $files.";
}
# Given a set of files, extracts their current working branch, testing for
# multiple branches and date-based tags in the process.
sub get_current_branch {
my ($files) = @_;
my %branches;
foreach my $filename (keys %$files) {
my $entry = $files->{$filename};
$entry->{tagdate} =~ m/^(T|D)?(.*)/;
if ($1 and $1 eq "D") { warn "$filename checked out by date $1\n" }
elsif ($2 eq "") { $branches{"HEAD"}++ }
else { $branches{$2}++ }
if (scalar(keys(%branches)) > 1 && !$DOUBLEOH7) {
die("Modified files checked out from multiple branches:\n "
. join("\n ", map("$_: $files->{$_}->{tagdate}",
sort(keys(%$files))))
. "Sounds scary, so I'm stopping. Want me to continue?\n"
. "Run me again with --live-dangerously and tell my authors\n"
. "how it went.\n");
}
}
return (keys(%branches))[0];
}
# Runs a CVS command and outputs the results. Runs the command in dry run mode
# if dry run is enabled globally ($DRY_RUN) or for this specific function call;
# and dies on error by default, but can be set to merely warn on error.
# Returns the return value of the CVS command, its output, and its errors.
sub run_cvs {
my ($cmd, $args, $dry_run, $warn_on_err) = @_;
# Let callers override dry run setting, since certain information gathering
# routines always run in dry run mode no matter what the global setting is.
my ($rv, $output, $errors) =
system_capture("cvs",
@CVS_OPTIONS,
$dry_run && !$CVS_OPTION_n ? "-n" : (),
$cmd,
@$args);
if ($rv != 0) {
if (!$warn_on_err) {
die "\n$errors\n$ss\n";
}
warn "\n$errors\n$ss\n"
}
else {
print VERBOSE "\n$output\n$ss\n";
}
return ($rv, $output, $errors);
}
# Returns the appropriate CVS command line argument for specifying a branch.
# Usually this is -r <branch name>, but if we're dealing with the special HEAD
# branch it's -A instead.
sub cvs_branch {
my ($branch) = @_;
return $branch eq "HEAD" ? "-A" : ("-r", $branch);
}
# Runs a command and captures its output and errors.
# Returns the command's exit code, output, and errors.
sub system_capture {
# XXX This should be using in-memory files, but they require that we close
# STDOUT and STDERR before reopening them on the in-memory files, and doing
# that on STDERR causes CVS to choke with return value 256.
my ($command, @args) = @_;
my ($rv, $output, $errors);
# Back up the original STDOUT and STDERR so we can restore them later.
open(OLDOUT, ">&STDOUT") or die "Can't back up STDOUT to OLDOUT: $!";
open(OLDERR, ">&STDERR") or die "Can't back up STDERR to OLDERR: $!";
use vars qw( *OLDOUT *OLDERR ); # suppress "used only once" warnings
# Close and reopen STDOUT and STDERR to in-memory files, which are just
# scalars that take output and append it to their value.
# XXX Disabled in-memory files in favor of temp files until in-memory issues
# can be worked out.
#close(STDOUT);
#close(STDERR);
#open(STDOUT, ">", \$output) or die "Can't open STDOUT to output var: $!";
#open(STDERR, ">", \$errors) or die "Can't open STDERR to errors var: $!";
my $outfile = tempfile();
my $errfile = tempfile();
# Perl 5.6.1 filehandle duplication doesn't support the three-argument form
# of open, so we can't just open(STDOUT, ">&", $outfile); instead we have to
# create an alias OUTFILE and then do open(STDOUT, ">&OUTFILE").
local *OUTFILE = *$outfile;
local *ERRFILE = *$errfile;
use vars qw( *OUTFILE *ERRFILE ); # suppress "used only once" warnings
open(STDOUT, ">&OUTFILE") or open(STDOUT, ">&OLDOUT")
and die "Can't dupe STDOUT to output file: $!";
open(STDERR, ">&ERRFILE") or open(STDOUT, ">&OLDOUT")
and open(STDERR, ">&OLDERR")
and die "Can't dupe STDERR to errors file: $!";
# Run the command.
print VERBOSE "$command " . join(" ", @args) . "\n";
$rv = system($command, @args);
# Grab output and errors from the temp files. In a block to localize $/.
# XXX None of this would be necessary if in-memory files was working.
{
local $/ = undef;
seek($outfile, 0, 0);
seek($errfile, 0, 0);
$output = <$outfile>;
$errors = <$errfile>;
}
# Restore original STDOUT and STDERR.
close(STDOUT);
close(STDERR);
open(STDOUT, ">&OLDOUT") or die "Can't restore STDOUT from OLDOUT: $!";
open(STDERR, ">&OLDERR") or die "Can't restore STDERR from OLDERR: $!";
return ($rv, $output, $errors);
}
Ссылка в новой задаче Показать git blame Копировать постоянную ссылку