7 use Dpkg::Control::Hash;
9 open DEBUG, ">&STDERR" or die $!;
11 our $pdo = 'http://packages.debian.org/';
12 #our $mirror = 'http://mirror.relativity.greenend.org.uk/mirror/debian-ftp/';
14 our $package = '2vcard';
16 our $aliothname = 'iwj@git.debian.org';
17 our $aliothpath = '/git/dgit-test';
18 our $alioth_git = 'git+ssh://$aliothname/$aliothpath';
19 our $alioth_sshtestbodge = [$aliothname,$aliothpath];
21 sub mainbranch () { return "$suite"; }
22 sub uploadingbranch () { return "uploading/$suite"; }
28 $ua = LWP::UserAgent->new();
31 print DEBUG "fetching @_...\n";
32 my $r = $ua->get(@_) or die $!;
33 die "$_[0]: ".$r->status_line."; failed.\n" unless $r->is_success;
34 return $r->decoded_content();
37 sub get_archive_dsc () {
38 my $pdourl = "$pdo/source/$suite/$package";
39 my $pdodata = url_get($pdourl);
40 # FFS. The Debian archive has no sane way to find what
41 # version is currently the tip in any branch (aka, what
42 # is the current version in any suite).
44 Download\ \Q$package\E .*
45 \<a\ href=\"([^"&]+([^"/]+\.dsc))\"\>\2\</a\>
47 or die "screenscraping of $pdourl failed :-(\n";
49 print DEBUG Dumper($pdodata, $&, $dscurl);
50 my $dscdata = url_get($dscurl);
51 my $dscfh = new IO::File \$dscdata, '<' or die $!;
52 print DEBUG Dumper($dscdata, $dscfh);
53 my $dscp = Dpkg::Control::Hash->new(allow_pgp=>1);
54 $dscp->parse($dscfh, 'dsc') or die "parsing of $dscurl failed\n";
55 # my $dscf = $dscp->{'fields'};
57 print DEBUG Dumper($dscp,$dscf);
58 my $fmt = $dscf->{Format};
59 die "unsupported format $fmt, sorry\n" unless $fmt eq '1.0';
63 sub check_for_git () {
65 open P, "ssh $alioth_sshtestbodge->[0] '".
66 "set -e; cd /git/dgit-test;".
67 "if test -d $package.git; then echo 1; else echo 0; fi".
72 die "$r $! $?" unless $r =~ m/^[01]$/;
78 die "$! $?" if system @_;
84 # if (!defined $dsc_hash) {
85 # runcmd qw(mkdir -p .git/dgit/unpack);
86 # chdir '.git/dgit/unpack' or die $!;
95 # open P, "-|", qw(git rev-parse --), $dsc_hash;
100 $dsc = get_archive_dsc();
101 $dsc_hash = $dsc->{'Vcs-git-master'};
102 if (defined $dsc_hash) {
103 $dsc_hash =~ m/\w+/ or die "$dsc_hash $?";
106 my $dstdir = "$package";
107 if (check_for_git()) {
108 runcmd qw(git clone --origin dgit -b), $suite, '--',
109 $alioth_git, $dstdir;
110 chdir "$dstdir" or die "$dstdir $!";
113 mkdir $dstdir or die "$dstdir $!";
114 chdir "$dstdir" or die "$dstdir $!";
116 open H, "> .git/refs/HEAD" or die $!;
117 print H "ref: refs/heads/$suite\n" or die $!;
119 runcmd qw(git remote add dgit), $alioth_git;
120 runcmd "git config branch.$suite.remote dgit";
121 runcmd "git config branch.$suite.merge refs/heads/$suite";
127 my ($archive_or_mirror, $suite, $package) = @_;
128 my $dsc = get_archive_dsc();
131 print Dumper(get_archive_dsc());