X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=bee98b9231d60c93ead3e6b8e4b2d12a2f06c2ca;hp=5cdf21e14a5a75fe01fb94c57817b2dc6b8225cb;hb=2d8535ab6b3445dc678191019b71850c4fa8f04f;hpb=230f01deca3c9802b1fbe439cbec393d74527f04 diff --git a/dgit b/dgit index 5cdf21e1..bee98b92 100755 --- a/dgit +++ b/dgit @@ -120,13 +120,17 @@ sub fetchspec () { our $ua; +sub progress { + print @_, "\n"; +} + sub url_get { if (!$ua) { $ua = LWP::UserAgent->new(); $ua->env_proxy; } my $what = $_[$#_]; - print "downloading $what...\n"; + progress "downloading $what..."; my $r = $ua->get(@_) or die $!; return undef if $r->code == 404; $r->is_success or fail "failed to fetch $what: ".$r->status_line; @@ -172,9 +176,9 @@ sub runcmd { sub printdone { if (!$dryrun) { - print "dgit ok: @_\n"; + progress "dgit ok: @_"; } else { - print "would be ok: @_ (but dry run only)\n"; + progress "would be ok: @_ (but dry run only)"; } } @@ -200,7 +204,7 @@ sub cmdoutput { } sub dryrun_report { - printcmd(\*STDOUT,"#",@_); + printcmd(\*STDERR,"#",@_); } sub runcmd_ordryrun { @@ -441,7 +445,7 @@ sub canonicalise_suite () { $csuite = archive_query('canonicalise_suite'); if ($isuite ne $csuite) { # madison canonicalises for us - print "canonical suite name for $isuite is $csuite\n"; + progress "canonical suite name for $isuite is $csuite"; } } @@ -611,7 +615,7 @@ END close C or die $!; my $outputhash = make_commit qw(../commit.tmp); my $cversion = getfield $clogp, 'Version'; - print "synthesised git commit from .dsc $cversion\n"; + progress "synthesised git commit from .dsc $cversion"; if ($lastpush_hash) { runcmd @git, qw(reset --hard), $lastpush_hash; runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp'; @@ -666,7 +670,7 @@ sub ensure_we_have_orig () { fail "existing file $f has hash $got but .dsc". " demands hash $fi->{Hash}". " (perhaps you should delete this file?)"; - print "using existing $f\n"; + progress "using existing $f"; next; } else { die "$f $!" unless $!==&ENOENT; @@ -713,12 +717,12 @@ sub fetch_from_archive () { if (defined $dsc_hash) { $dsc_hash =~ m/\w+/ or fail "invalid hash in .dsc \`$dsc_hash'"; $dsc_hash = $&; - print "last upload to archive specified git hash\n"; + progress "last upload to archive specified git hash"; } else { - print "last upload to archive has NO git hash\n"; + progress "last upload to archive has NO git hash"; } } else { - print "no version available from the archive\n"; + progress "no version available from the archive"; } my $lrref_fn = ".git/".lrref(); @@ -826,11 +830,11 @@ sub clone ($) { close H or die $!; runcmd @git, qw(remote add), 'origin', access_giturl(); if (check_for_git()) { - print "fetching existing git history\n"; + progress "fetching existing git history"; git_fetch_us(); runcmd_ordryrun @git, qw(fetch origin); } else { - print "starting new git history\n"; + progress "starting new git history"; } fetch_from_archive() or no_such_package; runcmd @git, qw(reset --hard), lrref(); @@ -880,21 +884,21 @@ sub commit_quilty_patch () { } fail "unexpected output from git status (is tree clean?)" if $bad; if (!%adds) { - print "nothing quilty to commit, ok.\n"; + progress "nothing quilty to commit, ok."; return; } runcmd_ordryrun @git, qw(add), sort keys %adds; my $m = "Commit Debian 3.0 (quilt) metadata"; - print "$m\n"; + progress "$m"; runcmd_ordryrun @git, qw(commit -m), $m; } sub madformat ($) { my ($format) = @_; return 0 unless $format eq '3.0 (quilt)'; - print "Format \`$format', urgh\n"; + progress "Format \`$format', urgh"; if ($noquilt) { - print "Not doing any fixup of \`$format' due to --no-quilt-fixup"; + progress "Not doing any fixup of \`$format' due to --no-quilt-fixup"; return 0; } return 1; @@ -906,6 +910,8 @@ sub push_parse_changelog ($) { my $clogp = Dpkg::Control::Hash->new(); $clogp->load($clogpfn); + responder_send_file('parsed-changelog', $clogpfn); + $package = getfield $clogp, 'Source'; my $cversion = getfield $clogp, 'Version'; my $tag = debiantag($cversion); @@ -999,7 +1005,7 @@ sub dopush () { } check_not_dirty(); chdir $ud or die $!; - print "checking that $dscfn corresponds to HEAD\n"; + progress "checking that $dscfn corresponds to HEAD"; runcmd qw(dpkg-source -x --), "../../../../$dscfn"; my ($tree,$dir) = mktree_in_ud_from_only_subdir(); chdir '../../../..' or die $!; @@ -1056,7 +1062,7 @@ sub dopush () { if (!$dryrun) { rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!"; } else { - print "[new .dsc left in $dscfn.tmp]\n"; + progress "[new .dsc left in $dscfn.tmp]"; } if ($sign) { @@ -1113,7 +1119,7 @@ sub fetchpullargs () { $isuite = getfield $clogp, 'Distribution'; } canonicalise_suite(); - print "fetching from suite $csuite\n"; + progress "fetching from suite $csuite"; } elsif (@ARGV==1) { ($isuite) = @ARGV; canonicalise_suite(); @@ -1140,15 +1146,24 @@ sub cmd_push { check_not_dirty(); my $clogp = parsechangelog(); $package = getfield $clogp, 'Source'; + my $specsuite; if (@ARGV==0) { - $isuite = getfield $clogp, 'Distribution'; - if ($new_package) { - local ($package) = $existing_package; # this is a hack - canonicalise_suite(); - } + } elsif (@ARGV==1) { + ($specsuite) = (@ARGV); } else { badusage "incorrect arguments to dgit push"; } + $isuite = getfield $clogp, 'Distribution'; + if ($new_package) { + local ($package) = $existing_package; # this is a hack + canonicalise_suite(); + } + if (defined $specsuite && $specsuite ne $isuite) { + canonicalise_suite(); + $csuite eq $specsuite or + fail "dgit push: changelog specifies $isuite ($csuite)". + " but command line specifies $specsuite"; + } if (check_for_git()) { git_fetch_us(); }