[build] fix typo in qemu-reg
[opensuse:build.git] / debtransform
1 #!/usr/bin/perl -w
2
3 use strict;
4 use Digest::MD5;
5
6 sub parsedsc {
7   my ($fn) = @_;
8   my @control;
9   local *F;
10   open(F, '<', $fn) || die("$fn: $!\n");
11   @control = <F>;
12   close F;
13   chomp @control;
14   splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
15   my @seq = ();
16   my %tag;
17   while (@control) {
18     my $c = shift @control;
19     last if $c eq '';   # new paragraph
20     my ($tag, $data) = split(':', $c, 2);
21     next unless defined $data;
22     push @seq, $tag;
23     $tag = uc($tag);
24     while (@control && $control[0] =~ /^\s/) {
25       $data .= "\n".substr(shift @control, 1);
26     }
27     $data =~ s/^\s+//s;
28     $data =~ s/\s+$//s;
29     $tag{$tag} = $data;
30   }
31   $tag{'__seq'} = \@seq;
32   return \%tag;
33 }
34
35 sub writedsc {
36   my ($fn, $tags) = @_;
37   open(F, '>', $fn) || die("$fn: $!\n");
38   my @seq = @{$tags->{'__seq'} || []};
39   my %seq = map {uc($_) => 1} @seq;
40   for (sort keys %$tags) {
41     push @seq, ucfirst(lc($_)) unless $seq{$_};
42   }
43   for my $seq (@seq) {
44     my $ucseq = uc($seq);
45     my $d = $tags->{$ucseq};
46     next unless defined $d;
47     $d =~ s/\n/\n /sg;
48     print F "$seq: $d\n";
49   }
50   print F "\n";
51   close F;
52 }
53
54 sub listtar {
55   my ($tar) = @_;
56   local *F;
57   my @c;
58   open(F, '-|', 'tar', '--numeric-owner', '-tvf', $tar) || die("tar: $!\n");
59   while(<F>) {
60     next unless /^([-dlbcp])(.........)\s+\d+\/\d+\s+(\S+) \d\d\d\d-\d\d-\d\d \d\d:\d\d(?::\d\d)? (.*)$/;
61     my ($type, $mode, $size, $name) = ($1, $2, $3, $4);
62     next if $type eq 'd';
63     die("debian tar contains link: $name\n") if $type eq 'l';
64     die("debian tar contains unexpected file type: $name\n") if $type ne '-';
65     $name =~ s/^\.\///;
66     $name =~ s/^debian\///;
67     push @c, {'name' => $name, 'size' => $size};
68   }
69   close(F) || die("tar: $!\n");
70   return @c;
71 }
72
73 sub dotar {
74   my ($tar, $tardir, $origin, @c) = @_;
75   local *F;
76   open(F, '-|', 'tar', '-xOf', $tar) || die("tar: $!\n");
77   for my $c (@c) {
78     my $s = $c->{'size'};
79     my $file = '';
80     while ($s > 0) {
81       my $l = sysread(F, $file, $s, length($file));
82       die("tar read error\n") unless $l;
83       $s -= $l;
84     }
85     next if $origin && $origin->{$c->{'name'}} ne $tar;
86     my @file = split("\n", $file);
87     print DIFF "--- $tardir.orig/debian/$c->{'name'}\n";
88     print DIFF "+++ $tardir/debian/$c->{'name'}\n";
89     next unless @file;
90     print DIFF "\@\@ -0,0 +1,".scalar(@file)." \@\@\n";
91     print DIFF "+$_\n" for @file;
92   }
93   close(F);
94 }
95
96 sub dofile {
97   my ($file, $tardir, $dfile) = @_;
98   local *F;
99   open(F, '<', $file) || die("$file: $!\n");
100   my @file = <F>;
101   close F;
102   chomp(@file);
103   print DIFF "--- $tardir.orig/$dfile\n";
104   print DIFF "+++ $tardir/$dfile\n";
105   return unless @file;
106   print DIFF "\@\@ -0,0 +1,".scalar(@file)." \@\@\n";
107   print DIFF "+$_\n" for @file;
108 }
109
110 sub doseries {
111   my ($series, $tardir) = @_;
112   my $dir = $series;
113   $dir =~ s/[^\/]+$//;
114   $dir =~ s/\/+$//;
115   $dir = '.' if $dir eq '';
116   local *F;
117   open(F, '<', $series) || die("$series: $!\n");
118   my @series = <F>;
119   close F;
120   chomp(@series);
121   for my $patch (@series) {
122     $patch =~ s/(^|\s+)#.*//;
123     next if $patch =~ /^\s*$/;
124     my $level = 1;
125     $level = $1 if $patch =~ /\s.*-p\s*(\d+)/;
126     $patch =~ s/\s.*//;
127     open(F, '<', "$dir/$patch") || die("$dir/$patch: $!\n");
128     while(<F>) {
129       chomp;
130       if ((/^--- ./ || /^\+\+\+ ./) && !/^... \/dev\/null/) {
131         my $start = substr($_, 0, 4);
132         $_ = substr($_, 4);
133         my $l = $level;
134         while ($l > 0) {
135           last unless s/.*?\///;
136           $l--;
137         }
138         if ($start eq '--- ') {
139           print DIFF "$start$tardir.orig/$_\n";
140         } else {
141           print DIFF "$start$tardir/$_\n";
142         }
143         next;
144       }
145       print DIFF "$_\n";
146     }
147     close F;
148   }
149 }
150
151 sub addfile {
152   my ($file) = @_;
153   my $base = $file;
154   $base =~ s/.*\///;
155   local *F;
156   open(F, '<', $file) || die("$file: $!\n");
157   my $size = -s F;
158   my $ctx = Digest::MD5->new;
159   $ctx->addfile(*F);
160   close F;
161   my $md5 = $ctx->hexdigest();
162   return "$md5 $size $base";
163 }
164
165 my $changelog;
166
167 if (@ARGV > 1 && $ARGV[0] eq '--changelog') {
168   shift @ARGV;
169   $changelog = shift @ARGV;
170 }
171 die("usage: debtransform [--changelog <changelog>] <srcdir> <dscfile> <outdir>\n") unless @ARGV == 3;
172
173 my $dir = $ARGV[0];
174 my $dsc = $ARGV[1];
175 my $out = $ARGV[2];
176
177 die("$out: $!\n") unless -d $out;
178
179 my $tags = parsedsc($dsc);
180
181 opendir(D, $dir) || die("$dir: $!\n");
182 my @dir = grep {$_ ne '.' && $_ ne '..'} readdir(D);
183 closedir(D);
184 my %dir = map {$_ => 1} @dir;
185
186 my $tarfile = $tags->{'DEBTRANSFORM-TAR'};
187 my @debtarfiles;
188 if ($tags->{'DEBTRANSFORM-FILES-TAR'}) {
189   @debtarfiles = split(' ', $tags->{'DEBTRANSFORM-FILES-TAR'});
190 }
191
192 if (!$tarfile || !@debtarfiles) {
193   my @tars = grep {/\.tar(?:\.gz|\.bz2)?$/} @dir;
194   my @debtars = grep {/^debian\.tar(?:\.gz|\.bz2)?$/} @tars;
195   if (!$tarfile) {
196     @tars = grep {!/^debian\.tar(?:\.gz|\.bz2)?$/} @tars;
197     if (@debtarfiles) {
198       my %debtarfiles = map {$_ => 1} @debtarfiles;
199       @tars = grep {!$debtarfiles{$_}} @tars;
200     }
201     die("package contains no tar file\n") unless @tars;
202     die("package contains more than one tar file: @tars\n") if @tars > 1;
203     $tarfile = $tars[0];
204   }
205   if (@debtars && !exists($tags->{'DEBTRANSFORM-FILES-TAR'})) {
206     die("package contains more than one debian tar file\n") if @debtars > 1;
207     @debtarfiles = ($debtars[0]);
208   }
209 }
210
211 my $name = $tags->{'SOURCE'};
212 die("dsc file contains no source\n") unless defined($name);
213 my $version = $tags->{'VERSION'};
214 die("dsc file contains no version\n") unless defined($version);
215 $version =~ s/^\d+://;  # no epoch in version, please
216
217 # transform 
218 my $tmptar;
219 if ($tarfile =~ /\.tar\.bz2/) {
220     my $old = $tarfile;
221     $tarfile =~ s/\.tar\.bz2/\.tar\.gz/;
222     $tmptar = "$out/$tarfile";
223     print "converting $old to $tarfile\n";
224     system( ( "debtransformbz2", "$old", "$tmptar" )) == 0 || die("cannot transform .tar.bz2 to .tar.gz");
225 }
226 if ($tarfile =~ /\.zip/) {
227     my $old = $tarfile;
228     $tarfile =~ s/\.zip/\.tar\.gz/;
229     $tmptar = "$out/$tarfile";
230     print "converting $old to $tarfile\n";
231     system( ( "debtransformzip", "$old", "$tmptar" )) == 0 || die("cannot transform .zip to .tar.gz");
232 }
233
234 my $tardir = $tarfile;
235 $tardir =~ s/\.orig\.tar/\.tar/;
236 $tardir =~ s/\.tar.*?$//;
237
238 my @files;
239 my $v = $version;
240 $v =~ s/-[^-]*$//;
241 $tarfile =~ /.*(\.tar.*?)$/;
242 my $ntarfile = "${name}_$v.orig$1";
243 if( $tmptar ) {
244   link("$tmptar", "$out/$ntarfile") || die("link $dir/$tarfile $out/$ntarfile: $!\n");
245   unlink("$tmptar");
246 } else {
247   link("$dir/$tarfile", "$out/$ntarfile") || die("link $dir/$tarfile $out/$ntarfile: $!\n");
248 }
249 push @files, addfile("$out/$ntarfile");
250
251 open(DIFF, '>', "$out/${name}_$version.diff") || die("$out/${name}_$version.diff: $!\n");
252
253 undef $changelog if $dir{'debian.changelog'};
254
255 my %debtarorigin;
256 my %debtarcontent;
257 for my $debtarfile (@debtarfiles) {
258   my @c = listtar("$dir/$debtarfile");
259   $debtarcontent{$debtarfile} = \@c;
260   for (@c) {
261     die("debian tar and directory both contain '$_->{'name'}'\n") if $dir{"debian.$_->{'name'}"};
262     undef $changelog if $_->{'name'} eq 'changelog';
263     $debtarorigin{$_->{'name'}} = "$dir/$debtarfile";
264   }
265 }
266
267 dofile($changelog, $tardir, 'debian/changelog') if defined $changelog;
268
269 for my $debtarfile (@debtarfiles) {
270   dotar("$dir/$debtarfile", $tardir, \%debtarorigin, @{$debtarcontent{$debtarfile} });
271 }
272
273 for my $file (grep {/^debian\./} @dir) {
274   next if $file eq 'debian.series';
275   next if $file =~ /\.tar$/;
276   next if $file =~ /\.tar\./;
277   dofile("$dir/$file", $tardir, 'debian/'.substr($file, 7));
278 }
279
280 if ($tags->{'DEBTRANSFORM-SERIES'}) {
281   doseries("$dir/$tags->{'DEBTRANSFORM-SERIES'}", $tardir);
282 } elsif ($dir{"debian.series"}) {
283   doseries("$dir/debian.series", $tardir);
284 } elsif ($dir{"patches.series"}) {
285   doseries("$dir/patches.series", $tardir);
286 }
287
288 close(DIFF);
289
290 if (! -s "$out/${name}_$version.diff") {
291   unlink("$out/${name}_$version.diff");
292 } else {
293   system('gzip', '-9', "$out/${name}_$version.diff");
294   if (-f "$out/${name}_$version.diff.gz") {
295     push @files, addfile("$out/${name}_$version.diff.gz");
296   } else {
297     push @files, addfile("$out/${name}_$version.diff");
298   }
299 }
300
301 $tags->{'FILES'} = "\n".join("\n", @files);
302 delete $tags->{'DEBTRANSFORM-SERIES'};
303 delete $tags->{'DEBTRANSFORM-TAR'};
304 delete $tags->{'DEBTRANSFORM-FILES-TAR'};
305 writedsc("$out/${name}_$version.dsc", $tags);
306 exit(0);