return getfield( (mergeinfo_getclogp $_[0]), 'Version' );
}
+sub fetch_from_archive_record_1 ($) {
+ my ($hash) = @_;
+ runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
+ 'DGIT_ARCHIVE', $hash;
+ cmdoutput @git, qw(log -n2), $hash;
+ # ... gives git a chance to complain if our commit is malformed
+}
+
+sub fetch_from_archive_record_2 ($) {
+ my ($hash) = @_;
+ my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
+ if (act_local()) {
+ cmdoutput @upd_cmd;
+ } else {
+ dryrun_report @upd_cmd;
+ }
+}
+
sub fetch_from_archive () {
ensure_setup_existing_tree();
if $lastpush_hash;
$chkff->($lastfetch_hash, 'local tracking tip (last fetch)');
- runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
- 'DGIT_ARCHIVE', $hash;
- cmdoutput @git, qw(log -n2), $hash;
- # ... gives git a chance to complain if our commit is malformed
+ fetch_from_archive_record_1($hash);
if (defined $skew_warning_vsn) {
mkpath '.git/dgit';
}
if ($lastfetch_hash ne $hash) {
- my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
- if (act_local()) {
- cmdoutput @upd_cmd;
- } else {
- dryrun_report @upd_cmd;
- }
+ fetch_from_archive_record_2($hash);
}
lrfetchref_used lrfetchref();
setup_useremail();
}
+sub clone_set_head () {
+ open H, "> .git/HEAD" or die $!;
+ print H "ref: ".lref()."\n" or die $!;
+ close H or die $!;
+}
+sub clone_finish ($) {
+ my ($dstdir) = @_;
+ runcmd @git, qw(reset --hard), lrref();
+ runcmd qw(bash -ec), <<'END';
+ set -o pipefail
+ git ls-tree -r --name-only -z HEAD | \
+ xargs -0r touch -r . --
+END
+ printdone "ready for work in $dstdir";
+}
+
sub clone ($) {
my ($dstdir) = @_;
- canonicalise_suite();
badusage "dry run makes no sense with clone" unless act_local();
+ canonicalise_suite();
my $hasgit = check_for_git();
mkdir $dstdir or fail "create \`$dstdir': $!";
changedir $dstdir;
runcmd @git, qw(init -q);
+ clone_set_head();
my $giturl = access_giturl(1);
if (defined $giturl) {
- open H, "> .git/HEAD" or die $!;
- print H "ref: ".lref()."\n" or die $!;
- close H or die $!;
runcmd @git, qw(remote add), 'origin', $giturl;
}
if ($hasgit) {
runcmd @git, qw(remote add vcs-git), $vcsgiturl;
}
setup_new_tree();
- runcmd @git, qw(reset --hard), lrref();
- runcmd qw(bash -ec), <<'END';
- set -o pipefail
- git ls-tree -r --name-only -z HEAD | \
- xargs -0r touch -r . --
-END
- printdone "ready for work in $dstdir";
+ clone_finish($dstdir);
}
sub fetch () {
+ canonicalise_suite();
if (check_for_git()) {
git_fetch_us();
}
return if $!==&ENOENT;
die "chdir $cwd_remove: $!";
}
+ printdebug "clone rmonerror removing $dstdir\n";
if (stat $dstdir) {
rmtree($dstdir) or die "remove $dstdir: $!\n";
} elsif (grep { $! == $_ }
$package = getfield $sourcep, 'Source';
}
if (@ARGV==0) {
-# $isuite = branchsuite(); # this doesn't work because dak hates canons
+ $isuite = branchsuite();
if (!$isuite) {
my $clogp = parsechangelog();
$isuite = getfield $clogp, 'Distribution';
}
- canonicalise_suite();
- progress "fetching from suite $csuite";
} elsif (@ARGV==1) {
($isuite) = @ARGV;
- canonicalise_suite();
} else {
badusage "incorrect arguments to dgit fetch or dgit pull";
}