Commit 55c7a0d6 authored by ian@well-typed.com's avatar ian@well-typed.com
Browse files

Some sync-all refactoring

parent 0ae042d3
......@@ -18,76 +18,20 @@ my $bare_flag = ""; # NOT the opposite of checked_out_flag (describes local repo
my %tags;
# Figure out where to get the other repositories from.
sub getrepo {
my $repo;
sub inDir {
my $dir = shift;
my $code = shift;
if (defined($defaultrepo)) {
$repo = $defaultrepo;
chomp $repo;
} else {
# Figure out where to get the other repositories from,
# based on where this GHC repo came from.
my $git_dir = $bare_flag ? "--git-dir=ghc.git" : "";
my $branch = `git $git_dir rev-parse --abbrev-ref HEAD`; chomp $branch;
my $remote = `git $git_dir config branch.$branch.remote`; chomp $remote;
if ($remote eq "") {
# remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
$remote = "origin";
}
$repo = `git $git_dir config remote.$remote.url`; chomp $repo;
if ($dir ne '.') {
chdir($dir);
}
my $repo_base;
my $checked_out_tree;
if ($repo =~ /^...*:/) {
# HTTP or SSH
# Above regex says "at least two chars before the :", to avoid
# catching Win32 drives ("C:\").
$repo_base = $repo;
# --checked-out is needed if you want to use a checked-out repo
# over SSH or HTTP
if ($checked_out_flag) {
$checked_out_tree = 1;
} else {
$checked_out_tree = 0;
}
my $result = &$code();
# Don't drop the last part of the path if specified with -r, as
# it expects repos of the form:
#
# http://darcs.haskell.org
#
# rather than
#
# http://darcs.haskell.org/ghc
#
if (!$defaultrepo) {
$repo_base =~ s#/[^/]+/?$##;
}
}
elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
# Local filesystem, either absolute (C:/ or /) or relative (../) path
$repo_base = $repo;
if (-f "$repo/HEAD") {
# assume a local mirror:
$checked_out_tree = 0;
$repo_base =~ s#/[^/]+/?$##;
} elsif (-d "$repo/ghc.git") {
# assume a local mirror:
$checked_out_tree = 0;
} else {
# assume a checked-out tree:
$checked_out_tree = 1;
}
}
else {
die "Couldn't work out repo";
if ($dir ne '.') {
chdir($initial_working_directory);
}
return $repo_base, $checked_out_tree;
return $result;
}
sub parsePackages {
......@@ -161,42 +105,121 @@ sub gitNewWorkdir {
}
}
sub git {
my $dir = shift;
my @args = @_;
&inDir($dir, sub {
my $prefix = $dir eq '.' ? "" : "$dir: ";
message "== ${prefix}running git @args";
system ("git", @args) == 0
or $ignore_failure
or die "git failed: $?";
});
}
sub readgit {
my $dir = shift;
my @args = @_;
&inDir($dir, sub {
open my $fh, '-|', 'git', @args
or die "Executing git @args failed: $!";
my $line = <$fh>;
$line = "" unless defined($line);
chomp $line;
close $fh;
return $line;
});
}
sub configure_repository {
my $localpath = shift;
&git($localpath, "config", "--local", "core.ignorecase", "true");
chdir($localpath);
open my $git_autocrlf, '-|', 'git', 'config', '--get', 'core.autocrlf'
or die "Executing git config failed: $!";
my $autocrlf = <$git_autocrlf>;
$autocrlf = "" unless defined($autocrlf);
chomp $autocrlf;
close($git_autocrlf);
chdir($initial_working_directory);
my $autocrlf = &readgit($localpath, 'config', '--get', 'core.autocrlf');
if ($autocrlf eq "true") {
&git($localpath, "config", "--local", "core.autocrlf", "false");
&git($localpath, "reset", "--hard");
}
}
sub git {
my $dir = shift;
# Figure out where to get the other repositories from.
sub getrepo {
my $repo;
if ($dir eq '.') {
message "== running git @_";
if (defined($defaultrepo)) {
$repo = $defaultrepo;
chomp $repo;
} else {
message "== $dir: running git @_";
chdir($dir);
# Figure out where to get the other repositories from,
# based on where this GHC repo came from.
my $git_dir = $bare_flag ? "ghc.git" : ".";
my $branch = &readgit($git_dir, "rev-parse", "--abbrev-ref", "HEAD");
die "Bad branch: $branch"
unless $branch =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
my $remote = &readgit($git_dir, "config", "branch.$branch.remote");
if ($remote eq "") {
# remotes are not mandatory for branches (e.g. not recorded by default for bare repos)
$remote = "origin";
}
die "Bad remote: $remote"
unless $remote =~ /^[a-zA-Z][a-zA-Z0-9.-]*$/;
$repo = &readgit($git_dir, "config", "remote.$remote.url");
}
system ("git", @_) == 0
or $ignore_failure
or die "git failed: $?";
my $repo_base;
my $checked_out_tree;
if ($dir ne '.') {
chdir($initial_working_directory);
if ($repo =~ /^...*:/) {
# HTTP or SSH
# Above regex says "at least two chars before the :", to avoid
# catching Win32 drives ("C:\").
$repo_base = $repo;
# --checked-out is needed if you want to use a checked-out repo
# over SSH or HTTP
if ($checked_out_flag) {
$checked_out_tree = 1;
} else {
$checked_out_tree = 0;
}
# Don't drop the last part of the path if specified with -r, as
# it expects repos of the form:
#
# http://darcs.haskell.org
#
# rather than
#
# http://darcs.haskell.org/ghc
#
if (!$defaultrepo) {
$repo_base =~ s#/[^/]+/?$##;
}
}
elsif ($repo =~ /^\/|\.\.\/|.:(\/|\\)/) {
# Local filesystem, either absolute (C:/ or /) or relative (../) path
$repo_base = $repo;
if (-f "$repo/HEAD") {
# assume a local mirror:
$checked_out_tree = 0;
$repo_base =~ s#/[^/]+/?$##;
} elsif (-d "$repo/ghc.git") {
# assume a local mirror:
$checked_out_tree = 0;
} else {
# assume a checked-out tree:
$checked_out_tree = 1;
}
}
else {
die "Couldn't work out repo";
}
return $repo_base, $checked_out_tree;
}
sub gitall {
......@@ -375,13 +398,7 @@ sub gitall {
}
close($lsremote);
open my $revparse, '-|', 'git', 'rev-parse', '--verify', 'HEAD'
or die "Executing rev-parse failed: $!";
my $myhead;
$myhead = <$revparse>;
# or die "Failed to read from rev-parse: $!";
chomp $myhead;
close($revparse);
my $myhead = &readgit('.', 'rev-parse', '--verify', 'HEAD');
if (not defined($remote_heads{$myhead})) {
die "Sub module $localpath needs to be pushed; see http://hackage.haskell.org/trac/ghc/wiki/Repositories/Upstream";
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment