wip

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 7a9c9105f295b50cf207bdecd23bfa68497e453c..9411afc0cdc53e488131c3244778f101025cf8e9 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -5,13 +5,15 @@ use IO::Handle;
 use Data::Dumper;
 use LWP::UserAgent;
 use Dpkg::Control::Hash;
+use File::Path;
+use POSIX;
 
 open DEBUG, ">&STDERR" or die $!;
 
 our $pdo = 'http://packages.debian.org/';
 #our $mirror = 'http://mirror.relativity.greenend.org.uk/mirror/debian-ftp/';
 our $suite = 'sid';
-our $package = 'userv';
+our $package = '2vcard';
 
 our $aliothname = 'iwj@git.debian.org';
 our $aliothpath = '/git/dgit-test';
@@ -21,9 +23,11 @@ our $alioth_sshtestbodge = [$aliothname,$aliothpath];
 sub mainbranch () { return "$suite"; }
 sub uploadingbranch () { return "uploading/$suite"; }
 
+our $ua;
+
 sub url_get {
     if (!$ua) {
-       $ua = LWP::UserAgent->new;
+       $ua = LWP::UserAgent->new();
        $ua->env_proxy;
     }
 print DEBUG "fetching @_...\n";
@@ -32,6 +36,8 @@ print DEBUG "fetching @_...\n";
     return $r->decoded_content();
 }
 
+our ($dscdata,$dscurl);
+
 sub get_archive_dsc () {
     my $pdourl = "$pdo/source/$suite/$package";
     my $pdodata = url_get($pdourl);
@@ -43,17 +49,19 @@ sub get_archive_dsc () {
         \<a\ href=\"([^"&]+([^"/]+\.dsc))\"\>\2\</a\>
     }msx
         or die "screenscraping of $pdourl failed :-(\n";
-    my $dscurl = $1;
+    $dscurl = $1;
 print DEBUG Dumper($pdodata, $&, $dscurl);
-    my $dscdata = url_get($dscurl);
+    $dscdata = url_get($dscurl);
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
 print DEBUG Dumper($dscdata, $dscfh);
     my $dscp = Dpkg::Control::Hash->new(allow_pgp=>1);
     $dscp->parse($dscfh, 'dsc') or die "parsing of $dscurl failed\n";
-    mu $dscf = $dscp->{'fields'};
-    die "unsupported format $dscf->{Format}, sorry\n"
-       unless $dscf->{Format} eq '1.0';
-    return $dsc;
+#    my $dscf = $dscp->{'fields'};
+my $dscf=$dscp;
+print DEBUG Dumper($dscp,$dscf);
+    my $fmt = $dscf->{Format};
+    die "unsupported format $fmt, sorry\n" unless $fmt eq '1.0';
+    return $dscf;
 }
 
 sub check_for_git () {
@@ -74,20 +82,104 @@ sub runcmd {
     die "$! $?" if system @_;
 }
 
-our ($dsc,$dsc_hash);
+our ($dsc,$dsc_hash,$lastupl_hash);
+
+sub generate_commit_from_dsc () {
+    my $ud = '.git/dgit/unpack';
+    remove_tree($ud);
+    mkpath '.git/dgit';
+    mkdir $ud or die $!;
+    chdir $ud or die $!;
+    my @files;
+    foreach (split /\n/, ($dsch->{Checksums-Sha256} || $dsch->{Files})) {
+       next unless m/\S/;
+       m/^\w+ \d+ (\S+)$/ or die "$_ ?";
+       my $f = $1;
+       die if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
+       push @files, $f;
+       link "../../../$f", $f
+           or $!==&ENOENT
+           or die "$f $!";
+    }
+    runcmd qw(dget --), $dscurl;
+    foreach my $f (grep { m/\.tar\.gz$/ } @files) {
+       link $f, "../../../$f"
+           or $!==&EEXIST
+           or die "$f $!";
+    }
+    my (@dirs) = <*/.>;
+    die unless @dirs==1;
+    $dirs[0] =~ m#^([^/]+)/\.$# or die;
+    my $dir = $1;
+    chdir $dir or die "$dir $!";
+    die if stat '.git';
+    die $! unless $!==&ENOENT;
+    runcmd qw(git init);
+    remove_tree(.git/objects);
+    symlink '../../objects','.git/objects' or die $!;
+    runcmd qw(git add -Af);
+    my $tree = cmdoutput qw(git write-tree);
+    chomp $tree or die;
+    runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
+    my $clogp = Dpkg::Control::Hash->new();
+    $clogp->parse('../changelog.tmp','changelog');
+    my $date = cmdoutput qw(date), '+%s %z', qw(-d),$clogp->{Date};
+    my $author = $clogp->{Maintainer};
+    $author =~ s#,.*##ms;
+    my $authline = "$author $date";
+    $authline =~ m/^[^<>]+ \<\S+\> \d+ [-+]\d+$/ or die $authline;
+    open C, ">../commit.tmp" or die $!;
+    print C "tree $tree\n" or die $!;
+    print C "parent $lastupl_hash\n" or die $! if defined $lastupl_hash;
+    print C <<END or die $!;
+author $authline
+committer $authline
 
-sub combine () {
+$clogp->{Changes}
+# generated by dgit
+END
+    close C or die $!;
+    my $commithash = runcmd qw(git hash-object -w -t commit ../commit.tmp);
+    chdir '../../..' or die $!;
+    remove_tree($ud);
+    cmdoutput qw(git log -n1), $commithash;
+    return $commithash;
+}
+
+sub fetch_from_archive () {
+    my $hash;
     if (defined $dsc_hash) {
+       $hash = $dsc_hash;
+    } else {
+       $hash = generate_commit_from_dsc();
+    }
+    cmdoutput qw(git update-ref FETCH_HEAD) $hash;
+}
+
+#sub combine () {
+#    if (
        
+#      runcmd qw(git write-tree
+       
+       
+       runcmd qw(mkdir -p '');
+#      chdir '.git/dgit/unpack' or die $!;
+       
+       
+#      with_tmpdir($td,{
+           
+#    });
+
+#    }
 
-       open P, "-|", qw(git rev-parse --), $dsc_hash;
+#      open P, "-|", qw(git rev-parse --), $dsc_hash;
        
-}
+#}
 
 sub clone () {
     $dsc = get_archive_dsc();
-    $dsc_hash = $dsc->{Vcs-git-master};
-    if (defined $dsh_hash) {
+    $dsc_hash = $dsc->{'Vcs-git-master'};
+    if (defined $dsc_hash) {
        $dsc_hash =~ m/\w+/ or die "$dsc_hash $?";
        $dsc_hash = $&;
     }
@@ -96,7 +188,7 @@ sub clone () {
        runcmd qw(git clone --origin dgit -b), $suite, '--',
            $alioth_git, $dstdir;
        chdir "$dstdir" or die "$dstdir $!";
-       combine();
+       update_from_archive();
     } else {
        mkdir $dstdir or die "$dstdir $!";
        chdir "$dstdir" or die "$dstdir $!";
@@ -107,16 +199,13 @@ sub clone () {
        runcmd qw(git remote add dgit), $alioth_git;
        runcmd "git config branch.$suite.remote dgit";
        runcmd "git config branch.$suite.merge refs/heads/$suite";
-       combine();
+       update_from_archive();
     }
 }
 
 sub fetch () {
     my ($archive_or_mirror, $suite, $package) = @_;
     my $dsc = get_archive_dsc();
+}
     
-    with_tmpdir($td,{
-       
-    });
-
 print Dumper(get_archive_dsc());