diff options
Diffstat (limited to 'dgit')
| -rwxr-xr-x | dgit | 94 |
1 files changed, 87 insertions, 7 deletions
@@ -5,6 +5,8 @@ use IO::Handle; use Data::Dumper; use LWP::UserAgent; use Dpkg::Control::Hash; +use File::Path; +use POSIX; open DEBUG, ">&STDERR" or die $!; @@ -34,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); @@ -45,9 +49,9 @@ 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); @@ -78,11 +82,87 @@ 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 + +$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 (!defined $dsc_hash) { -# runcmd qw(mkdir -p .git/dgit/unpack); +# if ( + +# runcmd qw(git write-tree + + + runcmd qw(mkdir -p ''); # chdir '.git/dgit/unpack' or die $!; @@ -108,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 $!"; @@ -119,7 +199,7 @@ 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(); } } |