#!/usr/bin/perl -w undef $/; my $DEB_HOST_MULTIARCH = (split /\n/, qx/dpkg-architecture -qDEB_HOST_MULTIARCH/)[0]; my $DEB_HOST_ARCH = (split /\n/, qx/dpkg-architecture -qDEB_HOST_ARCH/)[0]; my $DEB_HOST_ARCH_BITS = (split /\n/, qx/dpkg-architecture -qDEB_HOST_ARCH_BITS/)[0]; sub file_replace { my ($f,$name,$lcname)= @_; my $foutname = $f; $foutname =~ s/[@]NAME[@]/$name/; $foutname =~ s/[@]LCNAME[@]/$lcname/; open IN, "; close IN; s/[@]NAME[@]/$name/g; s/[@]LCNAME[@]/$lcname/g; s/[@]DEB_HOST_MULTIARCH[@]/$DEB_HOST_MULTIARCH/g; open OUT, ">debian/$foutname" or die "Can't write debian/$foutname: $!\n"; print OUT; close OUT; } my $control; my $ctemplate; my $cfilename = 'test-@NAME@.c'; open(my $fctemplate, '<', $cfilename) or die "cannot open file $cfilename"; { local $/ = undef; $ctemplate = <$fctemplate>; } close($fctemplate); # dpkg-shlibdeps now looks inside, but is ok with an empty file. system("touch debian/control"); my @control_in; open IN, "; @control_in = grep !/^\s*$/s, split /\n\s*\n/s; close IN; open ISA_LIST, "; close ISA_LIST; my %archlist; my @structs; foreach my $block (split /\n\s*\n/s) { my $lastfield = undef; my %data = (); foreach (split /\n/s, $block) { next if /^#.*/; next if /^\s*$/; if (/^([^\s:]+?)\s*:\s*(.*?)\s*$/) { $key = $1; $value = $2 // ''; $data{"$key"} = "$value"; $lastfield = "$key"; } elsif (/^(\s\S.*?)\s*$/) { $data{$lastfield} .= "\n$1"; } next; } push @structs, \%data if %data; } for (@structs) { my %entry = %$_; $archlist{$entry{'Architecture'}} = 1; my $name=$entry{'Name'}; my $lcname=lc($name); $name=~/^[a-zA-Z0-9\.+_]+$/ or die "Bad package/isa name: \"$name\".\n"; my $description=$entry{'Description'}; $description=~s/\A\s*\n+//m; $description=~s/\A\s+//m; my @c = @control_in; foreach (@c) { s/[@]NAME[@]/$name/g; s/[@]LCNAME[@]/$lcname/g; s/[@]ARCHITECTURE[@]/$entry{'Architecture'}/g; s/[@]DEB_HOST_MULTIARCH[@]/$DEB_HOST_MULTIARCH/g; s/[@]DESCRIPTION[@]/$description/g; $control.="\n".$_; } open C, '>', "test-$name.c"; my $test=$entry{'Test'}//"return !__builtin_cpu_supports(\"$lcname\");"; my $cfile = $ctemplate; $cfile =~ s/[@]TEST[@]/$test/g; print C $cfile; close C; for my $qemu (qw(qemu-good qemu-bad)) { if (exists $entry{$qemu}) { my $finname = $qemu.'-@NAME@'; my $foutname = $finname; $foutname =~ s/[@]NAME[@]/$name/; open IN, "<$finname" or die "Can't read $finname: $!\n"; local $_=; close IN; s/[@]NAME[@]/$name/g; s/[@]DEB_HOST_MULTIARCH[@]/$DEB_HOST_MULTIARCH/g; s/[@]DEB_HOST_ARCH[@]/$DEB_HOST_ARCH/g; s/[@]DEB_HOST_ARCH_BITS[@]/$DEB_HOST_ARCH_BITS/g; s/[@]QEMU_GOOD[@]/$entry{'qemu-good'}/g; s/[@]QEMU_BAD[@]/$entry{'qemu-bad'}/g; open OUT, ">$foutname" or die "Can't write $foutname: $!\n"; print OUT; close OUT; } } foreach (qw(@LCNAME@-support.preinst @LCNAME@-support.templates @LCNAME@-support.lintian-overrides @LCNAME@-support.maintscript)) { file_replace($_,$name,$lcname); } } my $all_architectures = join(' ',sort(keys %archlist)); my $control_base; my $filename = "debian/control.d/control-base.in"; open(my $fh, '<', $filename) or die "cannot open file $filename"; { local $/ = undef; $control_base = <$fh>; } close($fh); $control_base =~ s/[@]ALL_ARCHITECTURES[@]/$all_architectures/g; $control=$control_base.$control; open CONTROL, ">debian/control" or die "Can't write to debian/control: $!\n"; print CONTROL $control; close CONTROL;