substitutedeps

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   5 }
   6
   7 use strict;
   8
   9 use Build;
  10
  11 my ($dist, $rpmdeps, $archs, $configdir, $release, $changelog);
  12
  13 while (@ARGV)  {
  14   if ($ARGV[0] eq '--dist') {
  15     shift @ARGV;
  16     $dist = shift @ARGV;
  17     next;
  18   }
  19   if ($ARGV[0] eq '--archpath') {
  20     shift @ARGV;
  21     $archs = shift @ARGV;
  22     next;
  23   }
  24   if ($ARGV[0] eq '--configdir') {
  25     shift @ARGV;
  26     $configdir = shift @ARGV;
  27     next;
  28   }
  29   if ($ARGV[0] eq '--release') {
  30     shift @ARGV;
  31     $release = shift @ARGV;
  32     next;
  33   }
  34   if ($ARGV[0] eq '--changelog') {
  35     shift @ARGV;
  36     $changelog = shift @ARGV;
  37     next;
  38   }
  39   last;
  40 }
  41 die("Usage: substitutedeps --dist <dist> --archpath <archpath> [--configdir <configdir>] <specin> <specout>\n") unless @ARGV == 2;
  42 my $spec = $ARGV[0];
  43 my $newspec = $ARGV[1];
  44
  45 my $cf = Build::read_config_dist($dist, $archs, $configdir);
  46
  47 #######################################################################
  48
  49 my $xspec = [];
  50 my $d = Build::parse($cf, $spec, $xspec) || {};
  51 my @sdeps = @{$d->{'deps'} || []};
  52 my @neg = map {substr($_, 1)} grep {/^-/} @{$d->{'deps'} || []};
  53 my %neg = map {$_ => 1} @neg;
  54 @sdeps = grep {!$neg{$_}} @sdeps;
  55 @sdeps = Build::do_subst($cf, @sdeps);
  56 @sdeps = grep {!$neg{$_}} @sdeps;
  57 my %sdeps = map {$_ => 1} @sdeps;
  58
  59 open(F, '>', $newspec) || die("$newspec: $!\n");
  60
  61 my $used;
  62 my $inchangelog = 0;
  63 for my $l (@$xspec) {
  64   $used = 1;
  65   if (ref($l)) {
  66     if (!defined($l->[1])) {
  67       $used = 0;
  68       $l = $l->[0];
  69     } else {
  70       $l = $l->[1];
  71     }
  72   }
  73
  74   if ($inchangelog) {
  75     $inchangelog = 0 if $l =~ /^\s*%[^%]/;
  76     next if $inchangelog;
  77   }
  78   if ($changelog && ($l =~ /\s*\%changelog\b/)) {
  79     $inchangelog = 1;
  80     next;
  81   }
  82
  83   if ($release) {
  84     if ($l =~ /^Release:/i) {
  85       if (!($l =~ s/<RELEASE\d*>/$release/g)) {
  86         if ($l =~ /<(?:CI_CNT|B_CNT)>/) {
  87           # XXX: should pass ci_cnt/b_cnt instead
  88           if ($release =~ /(\d+)\.(\d+)$/) {
  89             my ($ci, $b) = ($1, $2);
  90             $l =~ s/<CI_CNT>/$ci/;
  91             $l =~ s/<B_CNT>/$b/;
  92           } elsif ($release =~ /(\d+)$/) {
  93             my $b = $1;
  94             $l =~ s/<B_CNT>/$b/ unless $l =~ s/<CI_CNT>/$b/;
  95           }
  96         } else {
  97           $l =~ s/^(Release:\s*).*/$1$release/i;
  98         }
  99       }
 100     }
 101   }
 102
 103   if (!$used || ($l !~ /^(?:Build)?Requires:/i)) {
 104     print F "$l\n";
 105     next;
 106   }
 107
 108   my $isbuildrequires = 0;
 109   $isbuildrequires = 1 if $l =~ /^BuildRequires:/i;
 110   my $r = $l;
 111   $r =~ s/^[^:]*:\s*//;
 112   my @deps = $r =~ /([^\s\[,]+)(\s+[<=>]+\s+[^\s\[,]+)?[\s,]*/g;
 113   my @ndeps = ();
 114   my $replace = 0;
 115   my @f2 = Build::do_subst_vers($cf, @deps);
 116   my %f2 = @f2;
 117   if ($isbuildrequires) {
 118     delete $f2{$_} for @neg;
 119     delete $f2{$_} for grep {/^-/} keys %f2;
 120   }
 121   while (@deps) {
 122     my ($pack, $vers) = splice(@deps, 0, 2);
 123     $vers = '' unless defined $vers;
 124     if (($isbuildrequires && $sdeps{$pack}) || exists($f2{$pack})) {
 125       push @ndeps, "$pack$vers";
 126       delete $f2{$pack};
 127     } else {
 128       $replace = 1;
 129     }
 130   }
 131   if (%f2) {
 132     while (@f2) {
 133       my ($pack, $vers) = splice(@f2, 0, 2);
 134       next unless exists $f2{$pack};
 135       $vers = '' unless defined $vers;
 136       push @ndeps, "$pack$vers";
 137     }
 138     $replace = 1
 139   }
 140   if ($replace) {
 141     $l =~ /^(.*?:\s*)/;
 142     print F $1.join(' ', @ndeps)."\n" if @ndeps;
 143   } else {
 144     print F "$l\n";
 145   }
 146 }
 147
 148 if ($changelog) {
 149   print F "%changelog\n";
 150   if (open(CF, '<', $changelog)) {
 151     while(<CF>) {
 152       print F $_;
 153     }
 154     close CF;
 155   }
 156 }
 157
 158 close(F) || die("close: $!\n");
 159
 160 exit(0);