Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: d0e2e48e9b
Fetching contributors…

Cannot retrieve contributors at this time

executable file 277 lines (255 sloc) 7.001 kb
#!/usr/bin/perl -w
BEGIN {
unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
}
use strict;
use Build;
sub expand {
my ($config, $str) = @_;
my @xspec;
my %cf = %$config;
$cf{'save_expanded'} = 1;
Build::Rpm::parse(\%cf, [ "$str" ], \@xspec);
return @xspec && ref($xspec[0]) ? $xspec[0]->[1] : '';
}
my ($dist, $buildroot, $rpmdeps, $archs, $configdir, $release, $changelog);
while (@ARGV) {
if ($ARGV[0] eq '--root') {
shift @ARGV;
$buildroot = shift @ARGV;
next;
}
if ($ARGV[0] eq '--dist') {
shift @ARGV;
$dist = shift @ARGV;
next;
}
if ($ARGV[0] eq '--archpath') {
shift @ARGV;
$archs = shift @ARGV;
next;
}
if ($ARGV[0] eq '--configdir') {
shift @ARGV;
$configdir = shift @ARGV;
next;
}
if ($ARGV[0] eq '--release') {
shift @ARGV;
$release = shift @ARGV;
next;
}
if ($ARGV[0] eq '--changelog') {
shift @ARGV;
$changelog = shift @ARGV;
next;
}
last;
}
die("Usage: substitutedeps --dist <dist> --archpath <archpath> [--configdir <configdir>] <specin> <specout>\n") unless @ARGV == 2;
my $spec = $ARGV[0];
my $specdir = $spec;
$specdir =~ s/[^\/]*$//;
$specdir = "./" if $specdir eq '';
my $newspec = $ARGV[1];
my $cf = Build::read_config_dist($dist, $archs, $configdir);
$cf->{'warnings'} = 1;
#######################################################################
my $xspec = [];
my $d = Build::parse($cf, $spec, $xspec) || {};
my @sdeps = @{$d->{'deps'} || []};
my @neg = map {substr($_, 1)} grep {/^-/} @{$d->{'deps'} || []};
my %neg = map {$_ => 1} @neg;
@sdeps = grep {!$neg{$_}} @sdeps;
@sdeps = Build::do_subst($cf, @sdeps);
@sdeps = grep {!$neg{$_}} @sdeps;
my %sdeps = map {$_ => 1} @sdeps;
open(F, '>', $newspec) || die("$newspec: $!\n");
my $used;
my $inchangelog = 0;
my $mainpkg = '';
my $pkg;
for my $line (@$xspec) {
$used = 1;
if (ref($line)) {
if (!defined($line->[1])) {
$used = 0;
$line = $line->[0];
} else {
$line = $line->[1];
}
}
if ($inchangelog) {
$inchangelog = 0 if $line =~ /^\s*%[^%]/;
next if $inchangelog;
}
if ($changelog && ($line =~ /\s*\%changelog\b/)) {
$inchangelog = 1;
next;
}
if ($line =~ /^Name\s*:\s*(\S+)/i) {
$pkg = $mainpkg = $1 unless $mainpkg;
}
if ($line =~ /^\s*%package\s+(-n\s+)?(\S+)/) {
if ($1) {
$pkg = $2;
} else {
$pkg = "$mainpkg-$2";
}
}
if ($line =~ /^Release:(.*)\s*$/i) {
my $spec_rel = $1; # User-provided value
my $oldl = $line;
if (defined $release) {
$line =~ s/<SPEC_REL>/$spec_rel/;
if (!($line =~ s/<RELEASE\d*>/$release/g)) {
if ($line =~ /<(?:CI_CNT|B_CNT)>/) {
# XXX: should pass ci_cnt/b_cnt instead
if ($release =~ /(\d+)\.(\d+)$/) {
my ($ci, $b) = ($1, $2);
$line =~ s/<CI_CNT>/$ci/;
$line =~ s/<B_CNT>/$b/;
} elsif ($release =~ /(\d+)$/) {
my $b = $1;
$b = '0' if $line =~ s/<CI_CNT>/$b/;
$line =~ s/<B_CNT>/$b/;
}
} else {
$line =~ s/^(Release:\s*).*/$1$release/i;
}
}
} else {
# remove macros, as rpm doesn't like them
$line =~ s/<RELEASE\d*>/0/;
$line =~ s/<CI_CNT>/0/;
$line =~ s/<B_CNT>/0/;
$line =~ s/<SPEC_REL>/0/;
}
# this is to be compatible to legacy autobuild.
# you can specify a releaseprg in the project configuration,
# if your package contains this file it is executed and its
# output is used as a release.
# use only if you really must.
if ($cf->{'releaseprg'} && -f "$specdir$cf->{'releaseprg'}") {
my $newl = $line;
$newl =~ s/^Release:\s*//;
$oldl =~ s/^Release:\s*//;
my $project = expand($cf, "%?_project") || 'BUILD_BASENAME';
my $arch = expand($cf, "%?_target_cpu") || 'noarch';
$::ENV{'BUILD_OLDRELEASE'} = $oldl;
my @nl;
my $interpreter = "/bin/bash";
if (open(RP, '<', "$specdir$cf->{'releaseprg'}")) {
@nl = <RP>;
close RP;
if (@nl && $nl[0] =~ /^#!\s*(\S*)/) {
$interpreter = $1;
}
}
if ($buildroot) {
my $sd = $specdir;
$sd =~ s/^\Q$buildroot\E//;
open(RP, "-|", 'chroot', $buildroot, $interpreter, "$sd$cf->{'releaseprg'}", $project, $newl, $pkg, $arch) || die("$cf->{'releaseprg'}: $!\n");
} else {
open(RP, "-|", $interpreter, "$specdir$cf->{'releaseprg'}", $project, $newl, $pkg, $arch) || die("$cf->{'releaseprg'}: $!\n");
}
@nl = grep {$_ ne ''} <RP>;
if (!close(RP)) {
warn("$cf->{'releaseprg'} failed: $?\n");
}
# and another compatibility hack: if the prg returns pkg:<package>,
# the release of the package will be used. yuck...
if (@nl && $nl[0] =~ s/^pkg://) {
my $relpkg = $nl[0];
chomp $relpkg;
if ($buildroot) {
open(RP, "-|", 'chroot', $buildroot, 'rpm', '-q', '--qf', '%{RELEASE}', $relpkg) || die("rpm: $!\n");
} else {
open(RP, "-|", 'rpm', '-q', '--qf', '%{RELEASE}', $relpkg) || die("rpm: $!\n");
}
@nl = grep {$_ ne ''} <RP>;
if (!close(RP)) {
warn("rpm package query of '$relpkg' failed: $?\n");
}
}
if ($nl[0]) {
chomp $nl[0];
$line =~ s/^(Release:\s*).*/$1$nl[0]/i;
if (defined $release) {
if (!($line =~ s/<RELEASE\d*>/$release/g)) {
if ($line =~ /<(?:CI_CNT|B_CNT)>/) {
# XXX: should pass ci_cnt/b_cnt instead
if ($release =~ /(\d+)\.(\d+)$/) {
my ($ci, $b) = ($1, $2);
$line =~ s/<CI_CNT>/$ci/;
$line =~ s/<B_CNT>/$b/;
} elsif ($release =~ /(\d+)$/) {
my $b = $1;
$line =~ s/<B_CNT>/$b/ unless $line =~ s/<CI_CNT>/$b/;
}
}
}
}
}
}
# all compat stuff done. we return to your scheduled program
}
if (!$used || ($line !~ /^(?:Build)?Requires:/i)) {
print F "$line\n";
next;
}
if ($line =~ /%\(/) {
# too hard for us
print F "$line\n";
next;
}
my $isbuildrequires = 0;
$isbuildrequires = 1 if $line =~ /^BuildRequires:/i;
my $r = $line;
$r =~ s/^[^:]*:\s*//;
my @deps = $r =~ /([^\s\[,]+)(\s+[<=>]+\s+[^\s\[,]+)?[\s,]*/g;
my @ndeps = ();
my $replace = 0;
my @f2 = Build::do_subst_vers($cf, @deps);
my %f2 = @f2;
if ($isbuildrequires) {
delete $f2{$_} for @neg;
delete $f2{$_} for grep {/^-/} keys %f2;
}
while (@deps) {
my ($pack, $vers) = splice(@deps, 0, 2);
$vers = '' unless defined $vers;
if (($isbuildrequires && $sdeps{$pack}) || exists($f2{$pack})) {
push @ndeps, "$pack$vers";
delete $f2{$pack};
} else {
$replace = 1;
}
}
if (%f2) {
while (@f2) {
my ($pack, $vers) = splice(@f2, 0, 2);
next unless exists $f2{$pack};
$vers = '' unless defined $vers;
push @ndeps, "$pack$vers";
}
$replace = 1
}
if ($replace) {
$line =~ /^(.*?:\s*)/;
print F $1.join(' ', @ndeps)."\n" if @ndeps;
} else {
print F "$line\n";
}
}
if ($changelog) {
print F "%changelog\n";
if (open(CF, '<', $changelog)) {
while(<CF>) {
print F $_;
}
close CF;
}
}
close(F) || die("close: $!\n");
exit(0);
Jump to Line
Something went wrong with that request. Please try again.