substitutedeps

#!/usr/bin/perl -w

################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

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, $buildflavor, $obspackage);
$buildflavor = '';	# default to empty

$configdir = ($::ENV{'BUILD_DIR'} || '/usr/lib/build') . '/configs';

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;
  }
  if ($ARGV[0] eq '--buildflavor') {
    shift @ARGV;
    $buildflavor = shift @ARGV;
    next;
  }
  if ($ARGV[0] eq '--obspackage') {
    shift @ARGV;
    $obspackage = 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) {
  $line =~ s/\@BUILD_FLAVOR\@/$buildflavor/g if defined $buildflavor;
  if (defined($obspackage)) {
    $line =~ s/\@OBS_PACKAGE\@/$obspackage/g;
  } else {
    die("recipe contains \@OBS_PACKAGE\@, but no package is set\n") if $line =~ /\@OBS_PACKAGE\@/;
  }
  $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*:\s*(.*?)\s*$/i) {
    my $spec_rel = $1; # User-provided value
    my $oldl = $line;
    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;
	    $b = '0' if $line =~ s/<CI_CNT>/$b/;
	    $line =~ s/<B_CNT>/$b/;
	  }
	} else {
	  # no special replacement rules in the line, simply replace
	  $line =~ s/^(Release\s*:\s*).*/$1$release/i;
	  $line =~ s/<SPEC_REL>/$spec_rel/g;
	}
      }
      $line =~ s/<SPEC_REL>//g;	# no recursion please
    } else {
      # remove macros, as rpm doesn't like them
      $line =~ s/<RELEASE\d*>/0/;
      $line =~ s/<CI_CNT>/0/;
      $line =~ s/<B_CNT>/0/;
    }

    if ($cf->{'releasesuffix'}) {
      my $suffix = $cf->{'releasesuffix'};
      if ($suffix =~ /^file:(.+)$/) {
	my $file = $1;
	if ($file =~ /\//s || $file =~ /^\./) {
	  $suffix = "error:illegal release suffix";
	} else {
	  if (open(RP, '<', "$specdir$file")) {
	    $suffix = "error:no suffix in $file";
	    for (<RP>) {
	      chomp;
	      s/^\s+//;
	      s/\s+$//;
	      $suffix = $_ if $_ && !/^#/;
	    }
	    close RP;
	  } else {
	    $suffix = "error:$file file does not exist";
	  }
	}
      }
      if ($suffix =~ /^error:(.*)$/) {
	$suffix = $1;
	$suffix =~ s/^\s+//;
	$suffix =~ s/\s+$//;
	$suffix = "Error: $suffix";
      }
      $line =~ s/^(Release\s*:\s*.*?)\s*$/$1$suffix/i if $suffix;
    }

    # 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 !~ /^(?:Requires|BuildRequires|PreReq)(?:\([^\)]+\))?:/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*//;
  if ($r =~ /^\(/) {
    # no rich dependency support for now
    print F "$line\n";
    next;
  }
  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);