Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: f67e5fbf93
Fetching contributors…

Cannot retrieve contributors at this time

executable file 359 lines (326 sloc) 9.995 kB
#!/usr/bin/perl -w
use strict;
use Digest::MD5;
sub parsedsc {
my ($fn) = @_;
my @control;
local *F;
open(F, '<', $fn) || die("$fn: $!\n");
@control = <F>;
close F;
chomp @control;
splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
my @seq = ();
my %tag;
while (@control) {
my $c = shift @control;
last if $c eq ''; # new paragraph
my ($tag, $data) = split(':', $c, 2);
next unless defined $data;
push @seq, $tag;
$tag = uc($tag);
while (@control && $control[0] =~ /^\s/) {
$data .= "\n".substr(shift @control, 1);
}
$data =~ s/^\s+//s;
$data =~ s/\s+$//s;
$tag{$tag} = $data;
}
$tag{'__seq'} = \@seq;
return \%tag;
}
sub writedsc {
my ($fn, $tags) = @_;
open(F, '>', $fn) || die("$fn: $!\n");
my @seq = @{$tags->{'__seq'} || []};
my %seq = map {uc($_) => 1} @seq;
for (sort keys %$tags) {
push @seq, ucfirst(lc($_)) unless $seq{$_};
}
for my $seq (@seq) {
my $ucseq = uc($seq);
my $d = $tags->{$ucseq};
next unless defined $d;
$d =~ s/\n/\n /sg;
print F "$seq: $d\n";
}
print F "\n";
close F;
}
sub listtar {
my ($tar, $skipdebiandir) = @_;
local *F;
my @c;
unless(defined($skipdebiandir)) {
$skipdebiandir = 1;
}
open(F, '-|', 'tar', '--numeric-owner', '-tvf', $tar) || die("tar: $!\n");
while(<F>) {
next unless /^([-dlbcp])(.........)\s+\d+\/\d+\s+(\S+) \d\d\d\d-\d\d-\d\d \d\d:\d\d(?::\d\d)? (.*)$/;
my ($type, $mode, $size, $name) = ($1, $2, $3, $4);
next if $type eq 'd';
if ($type eq 'l') {
next if $skipdebiandir eq 0;
die("debian tar contains link: $name\n");
}
if ($type ne '-') {
next if $skipdebiandir eq 0;
die("debian tar contains unexpected file type: $name\n");
}
$name =~ s/^\.\///;
$name =~ s/^debian\/// if $skipdebiandir eq 1;
push @c, {'name' => $name, 'size' => $size};
}
close(F) || die("tar: $!\n");
return @c;
}
sub extracttar {
my ($tar, $filename, $s) = @_;
local *F;
open(F, '-|', 'tar', '-xOf', $tar, $filename) || die("tar: $!\n");
my $file = '';
while ($s > 0) {
my $l = sysread(F, $file, $s, length($file));
die("tar read error\n") unless $l;
$s -= $l;
}
my @file = split("\n", $file);
close(F);
return @file;
}
sub dodiff {
my ($oldname, $newname, $origtarfile, @content) = @_;
my @oldcontent;
for my $c (@{$origtarfile->{'content'}}) {
if ($c->{'name'} eq $newname) {
@oldcontent = extracttar($origtarfile->{'name'}, $c->{'name'}, $c->{'size'});
}
}
if ($newname eq $origtarfile->{'tardir'}."/debian/changelog") {
my $firstline = $content[0];
my $version = $firstline;
$version =~ s/.*\((.*)\).*/$1/g;
if ($version ne $origtarfile->{'version'}) {
$firstline =~ s/\(.*\)/($origtarfile->{'version'})/g;
my $date = `date -R`;
chomp($date);
my @newcontent = ($firstline, "", " * version number update by debtransform", "", " -- debtransform <build\@opensuse.org> ".$date, "");
push(@newcontent, @content);
@content = @newcontent;
}
}
return unless @content;
print DIFF "--- $oldname\n";
print DIFF "+++ $newname\n";
if (@oldcontent) {
print DIFF "\@\@ -1,".scalar(@oldcontent)." +1,".scalar(@content)." \@\@\n";
print DIFF "-$_\n" for @oldcontent;
} else {
print DIFF "\@\@ -0,0 +1,".scalar(@content)." \@\@\n";
}
print DIFF "+$_\n" for @content;
}
sub dotar {
my ($tar, $tardir, $origin, $origtarfile, @c) = @_;
local *F;
open(F, '-|', 'tar', '-xOf', $tar) || die("tar: $!\n");
for my $c (@c) {
my $s = $c->{'size'};
my $file = '';
while ($s > 0) {
my $l = sysread(F, $file, $s, length($file));
die("tar read error\n") unless $l;
$s -= $l;
}
next if $origin && $origin->{$c->{'name'}} ne $tar;
my @file = split("\n", $file);
dodiff("$tardir.orig/debian/$c->{'name'}", "$tardir/debian/$c->{'name'}", $origtarfile, @file);
}
close(F);
}
sub dofile {
my ($file, $tardir, $dfile, $origtarfile) = @_;
local *F;
open(F, '<', $file) || die("$file: $!\n");
my @file = <F>;
close F;
chomp(@file);
dodiff("$tardir.orig/$dfile", "$tardir/$dfile", $origtarfile, @file);
}
sub doseries {
my ($series, $tardir) = @_;
my $dir = $series;
$dir =~ s/[^\/]+$//;
$dir =~ s/\/+$//;
$dir = '.' if $dir eq '';
local *F;
open(F, '<', $series) || die("$series: $!\n");
my @series = <F>;
close F;
chomp(@series);
for my $patch (@series) {
$patch =~ s/(^|\s+)#.*//;
next if $patch =~ /^\s*$/;
my $level = 1;
$level = $1 if $patch =~ /\s.*-p\s*(\d+)/;
$patch =~ s/\s.*//;
open(F, '<', "$dir/$patch") || die("$dir/$patch: $!\n");
while(<F>) {
chomp;
if ((/^--- ./ || /^\+\+\+ ./) && !/^... \/dev\/null/) {
my $start = substr($_, 0, 4);
$_ = substr($_, 4);
my $l = $level;
while ($l > 0) {
last unless s/.*?\///;
$l--;
}
if ($start eq '--- ') {
print DIFF "$start$tardir.orig/$_\n";
} else {
print DIFF "$start$tardir/$_\n";
}
next;
}
print DIFF "$_\n";
}
close F;
}
}
sub addfile {
my ($file) = @_;
my $base = $file;
$base =~ s/.*\///;
local *F;
open(F, '<', $file) || die("$file: $!\n");
my $size = -s F;
my $ctx = Digest::MD5->new;
$ctx->addfile(*F);
close F;
my $md5 = $ctx->hexdigest();
return "$md5 $size $base";
}
my $changelog;
if (@ARGV > 1 && $ARGV[0] eq '--changelog') {
shift @ARGV;
$changelog = shift @ARGV;
}
die("usage: debtransform [--changelog <changelog>] <srcdir> <dscfile> <outdir>\n") unless @ARGV == 3;
my $dir = $ARGV[0];
my $dsc = $ARGV[1];
my $out = $ARGV[2];
die("$out: $!\n") unless -d $out;
my $tags = parsedsc($dsc);
opendir(D, $dir) || die("$dir: $!\n");
my @dir = grep {$_ ne '.' && $_ ne '..'} readdir(D);
closedir(D);
my %dir = map {$_ => 1} @dir;
my $tarfile = $tags->{'DEBTRANSFORM-TAR'};
my @debtarfiles;
if ($tags->{'DEBTRANSFORM-FILES-TAR'}) {
@debtarfiles = split(' ', $tags->{'DEBTRANSFORM-FILES-TAR'});
}
if (!$tarfile || !@debtarfiles) {
my @tars = grep {/\.tar(?:\.gz|\.bz2)?$/} @dir;
my @debtars = grep {/^debian\.tar(?:\.gz|\.bz2)?$/} @tars;
if (!$tarfile) {
@tars = grep {!/^debian\.tar(?:\.gz|\.bz2)?$/} @tars;
if (@debtarfiles) {
my %debtarfiles = map {$_ => 1} @debtarfiles;
@tars = grep {!$debtarfiles{$_}} @tars;
}
die("package contains no tar file\n") unless @tars;
die("package contains more than one tar file: @tars\n") if @tars > 1;
$tarfile = $tars[0];
}
if (@debtars && !exists($tags->{'DEBTRANSFORM-FILES-TAR'})) {
die("package contains more than one debian tar file\n") if @debtars > 1;
@debtarfiles = ($debtars[0]);
}
}
my $name = $tags->{'SOURCE'};
die("dsc file contains no source\n") unless defined($name);
my $version = $tags->{'VERSION'};
die("dsc file contains no version\n") unless defined($version);
$version =~ s/^\d+://; # no epoch in version, please
# transform
my $tmptar;
if ($tarfile =~ /\.tar\.bz2/) {
my $old = $tarfile;
$tarfile =~ s/\.tar\.bz2/\.tar\.gz/;
$tmptar = "$out/$tarfile";
print "converting $dir/$old to $tarfile\n";
system( ( "debtransformbz2", "$dir/$old", "$tmptar" )) == 0 || die("cannot transform .tar.bz2 to .tar.gz");
}
if ($tarfile =~ /\.zip/) {
my $old = $tarfile;
$tarfile =~ s/\.zip/\.tar\.gz/;
$tmptar = "$out/$tarfile";
print "converting $dir/$old to $tarfile\n";
system( ( "debtransformzip", "$dir/$old", "$tmptar" )) == 0 || die("cannot transform .zip to .tar.gz");
}
my @files;
my $v = $version;
$v =~ s/-[^-]*$//;
$tarfile =~ /.*(\.tar.*?)$/;
my $ntarfile = "${name}_$v.orig$1";
if( $tmptar ) {
link("$tmptar", "$out/$ntarfile") || die("link $dir/$tarfile $out/$ntarfile: $!\n");
unlink("$tmptar");
} else {
link("$dir/$tarfile", "$out/$ntarfile") || die("link $dir/$tarfile $out/$ntarfile: $!\n");
}
push @files, addfile("$out/$ntarfile");
my $tarpath = "$out/$ntarfile";
my $tardir = $tarfile;
$tardir =~ s/\.orig\.tar/\.tar/;
$tardir =~ s/\.tar.*?$//;
my @tarfilecontent = listtar($tarpath, 0);
my $origtarfile = { 'name', $tarpath, 'content', \@tarfilecontent, 'version', $tags->{'VERSION'}, 'tardir', $tardir};
open(DIFF, '>', "$out/${name}_$version.diff") || die("$out/${name}_$version.diff: $!\n");
undef $changelog if $dir{'debian.changelog'};
my %debtarorigin;
my %debtarcontent;
for my $debtarfile (@debtarfiles) {
my @c = listtar("$dir/$debtarfile");
$debtarcontent{$debtarfile} = \@c;
for (@c) {
die("debian tar and directory both contain '$_->{'name'}'\n") if $dir{"debian.$_->{'name'}"};
undef $changelog if $_->{'name'} eq 'changelog';
$debtarorigin{$_->{'name'}} = "$dir/$debtarfile";
}
}
dofile($changelog, $tardir, 'debian/changelog', $origtarfile) if defined $changelog;
for my $debtarfile (@debtarfiles) {
dotar("$dir/$debtarfile", $tardir, \%debtarorigin, $origtarfile, @{$debtarcontent{$debtarfile} });
}
for my $file (grep {/^debian\./} @dir) {
next if $file eq 'debian.series';
next if $file =~ /\.tar$/;
next if $file =~ /\.tar\./;
dofile("$dir/$file", $tardir, 'debian/'.substr($file, 7), $origtarfile);
}
if ($tags->{'DEBTRANSFORM-SERIES'}) {
doseries("$dir/$tags->{'DEBTRANSFORM-SERIES'}", $tardir);
} elsif ($dir{"debian.series"}) {
doseries("$dir/debian.series", $tardir);
} elsif ($dir{"patches.series"}) {
doseries("$dir/patches.series", $tardir);
}
close(DIFF);
if (! -s "$out/${name}_$version.diff") {
unlink("$out/${name}_$version.diff");
} else {
system('gzip', '-9', "$out/${name}_$version.diff");
if (-f "$out/${name}_$version.diff.gz") {
push @files, addfile("$out/${name}_$version.diff.gz");
} else {
push @files, addfile("$out/${name}_$version.diff");
}
}
$tags->{'FILES'} = "\n".join("\n", @files);
delete $tags->{'DEBTRANSFORM-SERIES'};
delete $tags->{'DEBTRANSFORM-TAR'};
delete $tags->{'DEBTRANSFORM-FILES-TAR'};
writedsc("$out/${name}_$version.dsc", $tags);
exit(0);
Jump to Line
Something went wrong with that request. Please try again.