better docs

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 60138fea122567892caad6d4b352727d37fda25d..1e7be7286de63a62972f1f67b06de54d5d2f415a 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -26,7 +26,6 @@ use Dpkg::Control::Hash;
 use File::Path;
 use POSIX;
 
-our $mirror = 'http://mirror.relativity.greenend.org.uk/mirror/debian-ftp/';
 our $suite = 'sid';
 our $package;
 
@@ -139,11 +138,12 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.debian.git-proto' => 'git+ssh://',
               'dgit-distro.debian.git-path' => '/git/dgit-repos',
               'dgit-distro.debian.git-check' => 'ssh-cmd',
-              'dgit-distro.debian.git-create' => 'ssh-cmd');
+              'dgit-distro.debian.git-create' => 'ssh-cmd',
+              'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/');
 
 sub cfg {
     foreach my $c (@_) {
-       my $v = cmdoutput_errok(qw(git config --), $c);
+       my $v = cmdoutput_errok(@git, qw(config --), $c);
        if ($?==0) {
            chomp $v;
            return $v;
@@ -156,10 +156,14 @@ sub cfg {
     return undef;
 }
 
+sub access_distro () {
+    return cfg("dgit-suite.$suite.distro",
+              "dgit.default.distro");
+}
+
 sub access_cfg ($) {
     my ($key) = @_;
-    my $distro = cfg("dgit-suite.$suite.distro",
-                    "dgit.default.distro");
+    my $distro = access_distro();
     my $value = cfg("dgit-distro.$distro.$key",
                    "dgit.default.$key");
     return $value;
@@ -171,7 +175,7 @@ sub access_gituserhost () {
     return defined($user) && length($user) ? "$user\@$host" : $host;
 }
 
-sub access_giturl ($) {
+sub access_giturl () {
     my $url = access_cfg('git-url');
     if (!defined $url) {
        $url =
@@ -179,7 +183,7 @@ sub access_giturl ($) {
            access_gituserhost().
            access_cfg('git-path');
     }
-    return "$url/package.git";
+    return "$url/$package.git";
 }             
 
 sub parsecontrol {
@@ -199,8 +203,14 @@ sub parsechangelog {
 
 our $rmad;
 
-sub askmadison () {
-    $rmad ||= cmdoutput qw(rmadison -asource),"-s$suite",$package;
+sub archive_query () {
+    my $query = access_cfg('archive-query');
+    $query ||= "madison:".access_distro();
+    $query =~ s/^(\w+):// or die "$query ?";
+    my $proto = $1;
+    my $url = $'; #';
+    die unless $proto eq 'madison';
+    $rmad ||= cmdoutput qw(rmadison -asource),"-s$suite","-u$url",$package;
     $rmad =~ m/^ \s*( [^ \t|]+ )\s* \|
                  \s*( [^ \t|]+ )\s* \|
                  \s*( [^ \t|]+ )\s* \|
@@ -213,18 +223,19 @@ sub askmadison () {
        $suite = $3;
     }
     $4 eq 'source' or die "$rmad ?";
-    return $vsn;
+    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
+    my $subpath = "/pool/main/$prefix/$package/${package}_$vsn.dsc";
+    return ($vsn,$subpath);
 }
 
 sub canonicalise_suite () {
-    askmadison();
+    archive_query();
 }
 
 sub get_archive_dsc () {
-    my $vsn = askmadison();
+    my ($vsn,$subpath) = archive_query();
     # fixme madison does not show us the component
-    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
-    $dscurl = "$mirror/pool/main/$prefix/$package/${package}_$vsn.dsc";
+    $dscurl = access_cfg('mirror').$subpath;
     $dscdata = url_get($dscurl);
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
     print DEBUG Dumper($dscdata);
@@ -407,7 +418,7 @@ sub is_fast_fwd ($$) {
 
 sub git_fetch_us () {
     die "cannot dry run with fetch" if $dryrun;
-    runcmd @git, qw(fetch),$remotename,fetchspec();
+    runcmd @git, qw(fetch),access_giturl(),fetchspec();
 }
 
 sub fetch_from_archive () {
@@ -466,7 +477,7 @@ sub clone ($) {
     open H, "> .git/HEAD" or die $!;
     print H "ref: ".lref()."\n" or die $!;
     close H or die $!;
-    runcmd @git, qw(remote add), 'origin', access_giturl($package);
+    runcmd @git, qw(remote add), 'origin', access_giturl();
     if (check_for_git()) {
        print "fetching existing git history\n";
        git_fetch_us();
@@ -495,7 +506,6 @@ sub pull () {
 sub dopush () {
     runcmd @git, qw(diff --quiet HEAD);
     my $clogp = parsechangelog();
-    die if defined $package;
     $package = $clogp->{Source};
     my $dscfn = "${package}_$clogp->{Version}.dsc";
     stat "../$dscfn" or die "$dscfn $!";
@@ -530,7 +540,7 @@ sub dopush () {
     if (!check_for_git()) {
        create_remote_git_repo();
     }
-    runcmd_ordryrun @git, qw(push),$remotename,"HEAD:".rrref();
+    runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
     if ($sign) {
        my @tag_cmd = (@git, qw(tag -s -m),
                       "Release $dsc->{Version} for $suite [dgit]");
@@ -542,8 +552,10 @@ sub dopush () {
        push @debsign_cmd, $changesfile;
        runcmd_ordryrun @debsign_cmd;
     }
-    runcmd_ordryrun @git, qw(push),$remotename,"refs/tags/$tag";
-    runcmd_ordryrun @dput, $changesfile;
+    runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
+    my $host = access_cfg('upload-host');
+    my @hostarg = defined($host) ? ($host,) : ();
+    runcmd_ordryrun @dput, @hostarg, $changesfile;
 }
 
 sub cmd_clone {
@@ -655,7 +667,7 @@ sub parseopts () {
                } elsif (s/^-D/-/) {
                    open DEBUG, ">&STDERR" or die $!;
                } elsif (s/^-c(.*=.*)//s) {
-                   push @git, $1;
+                   push @git, '-c', $1;
                } elsif (s/^-C(.*)//s) {
                    $changesfile = $1;
                } elsif (s/^-k(.*)//s) {