chiark
/
gitweb
/
~ianmdlvl
/
dgit.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
changelog: Start 9.8
[dgit.git]
/
dgit
diff --git
a/dgit
b/dgit
index 6401524ed90dee03c18914a330c99c17fa02b36a..941a14b93630d198172570a2a943d5ea29874d11 100755
(executable)
--- a/
dgit
+++ b/
dgit
@@
-1191,7
+1191,7
@@
sub url_fetch ($;@) {
confess "$k $v ".$curl->strerror($x)." ?" if $x;
};
confess "$k $v ".$curl->strerror($x)." ?" if $x;
};
- my $response_body;
+ my $response_body
= ''
;
$setopt->(CURLOPT_REDIR_PROTOCOLS, CURLPROTO_HTTPS|CURLPROTO_HTTP);
$setopt->(CURLOPT_URL, $url);
$setopt->(CURLOPT_NOSIGNAL, 1);
$setopt->(CURLOPT_REDIR_PROTOCOLS, CURLPROTO_HTTPS|CURLPROTO_HTTP);
$setopt->(CURLOPT_URL, $url);
$setopt->(CURLOPT_NOSIGNAL, 1);
@@
-1223,6
+1223,8
@@
sub url_fetch ($;@) {
fail f_ "fetch of %s gave HTTP code %s", $url, $code
unless $url =~ m#^file://# or $code =~ m/^2/;
fail f_ "fetch of %s gave HTTP code %s", $url, $code
unless $url =~ m#^file://# or $code =~ m/^2/;
+
+ confess unless defined $response_body;
return $response_body;
}
return $response_body;
}
@@
-1792,7
+1794,9
@@
sub check_for_git () {
CurlOpts => { CURLOPT_NOBODY() => 1 },
Ok404 => 1,
AccessBase => 'git-check';
CurlOpts => { CURLOPT_NOBODY() => 1 },
Ok404 => 1,
AccessBase => 'git-check';
- return defined $result;
+ $result = defined $result;
+ printdebug "dgit-repos check_for_git => $result.\n";
+ return $result;
} elsif ($how eq 'true') {
return 1;
} elsif ($how eq 'false') {
} elsif ($how eq 'true') {
return 1;
} elsif ($how eq 'false') {
@@
-3844,6
+3848,16
@@
END
printdone f_ "ready for work in %s", $dstdir;
}
printdone f_ "ready for work in %s", $dstdir;
}
+sub vcs_git_url_of_ctrl ($) {
+ my ($ctrl) = @_;
+ my $vcsgiturl = $ctrl->{'Vcs-Git'};
+ if (length $vcsgiturl) {
+ $vcsgiturl =~ s/\s+-b\s+\S+//g;
+ $vcsgiturl =~ s/\s+\[[^][]*\]//g;
+ }
+ return $vcsgiturl;
+}
+
sub clone ($) {
# in multisuite, returns twice!
# once in parent after first suite fetched,
sub clone ($) {
# in multisuite, returns twice!
# once in parent after first suite fetched,
@@
-3882,9
+3896,8
@@
sub clone ($) {
progress __ "starting new git history";
}
fetch_from_archive() or no_such_package;
progress __ "starting new git history";
}
fetch_from_archive() or no_such_package;
- my $vcsgiturl =
$dsc->{'Vcs-Git'}
;
+ my $vcsgiturl =
vcs_git_url_of_ctrl $dsc
;
if (length $vcsgiturl) {
if (length $vcsgiturl) {
- $vcsgiturl =~ s/\s+-b\s+\S+//g;
runcmd @git, qw(remote add vcs-git), $vcsgiturl;
}
clone_finish($dstdir);
runcmd @git, qw(remote add vcs-git), $vcsgiturl;
}
clone_finish($dstdir);
@@
-4020,6
+4033,7
@@
sub get_source_format () {
}
$_ = <F>;
F->error and confess "$!";
}
$_ = <F>;
F->error and confess "$!";
+ close F;
chomp;
return ($_, \%options);
}
chomp;
return ($_, \%options);
}
@@
-4959,7
+4973,8
@@
sub cmd_update_vcs_git () {
get_archive_dsc();
$ctrl = $dsc;
}
get_archive_dsc();
$ctrl = $dsc;
}
- my $url = getfield $ctrl, 'Vcs-Git';
+ my $url = vcs_git_url_of_ctrl $ctrl;
+ fail 'no Vcs-Git header in control file' unless length $url;
my @cmd;
my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
my @cmd;
my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF';
@@
-4967,12
+4982,12
@@
sub cmd_update_vcs_git () {
print STDERR f_ "setting up vcs-git: %s\n", $url;
@cmd = (@git, qw(remote add vcs-git), $url);
} elsif ($orgurl eq $url) {
print STDERR f_ "setting up vcs-git: %s\n", $url;
@cmd = (@git, qw(remote add vcs-git), $url);
} elsif ($orgurl eq $url) {
- print STDERR f_ "vcs git
already configur
ed: %s\n", $url;
+ print STDERR f_ "vcs git
unchang
ed: %s\n", $url;
} else {
print STDERR f_ "changing vcs-git url to: %s\n", $url;
@cmd = (@git, qw(remote set-url vcs-git), $url);
}
} else {
print STDERR f_ "changing vcs-git url to: %s\n", $url;
@cmd = (@git, qw(remote set-url vcs-git), $url);
}
- runcmd_ordryrun_local @cmd;
+ runcmd_ordryrun_local @cmd
if @cmd
;
if ($dofetch) {
print f_ "fetching (%s)\n", "@ARGV";
runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;
if ($dofetch) {
print f_ "fetching (%s)\n", "@ARGV";
runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV;