createrpmdeps

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   5 }
   6
   7 use Build;
   8 use strict;
   9
  10 ######################################################################
  11
  12 my $rpmdepfile = $ARGV[0];
  13
  14 my %tag;
  15
  16 my %oldp;
  17 my %oldr;
  18 if (defined($rpmdepfile) && open(F, '<', $rpmdepfile)) {
  19   while (<F>) {
  20     chomp;
  21     if (/^P:([^ ]): /) {
  22       $oldp{$1} = $_;
  23     } elsif (/^R:([^ ]): /) {
  24       $oldr{$1} = $_;
  25     }
  26   }
  27   close F;
  28 }
  29
  30 my $redo = 1;
  31 foreach my $dir (@ARGV) {
  32   $redo = 0;
  33   my @known;
  34   my %known2fn;
  35   my %known2path;
  36   my %fnsize2id;
  37   my $cmd = "find $dir -follow -type f \\( -name \"*.rpm\" -o -name \"*.deb\" \\) -a ! -name \"*src.rpm\" -printf '\%T@/\%s/\%i \%p\\n'";
  38   open(F, '-|', $cmd) or next;
  39   while (<F>) {
  40     chomp;
  41     next unless /^([\d\.]+\/\d+\/\d+) (.*)$/;
  42     my $id = $1;
  43     my $path = $2;
  44     # new find added a fraction part to %T@, ignore it
  45     $id =~ s/^(\d+)\.\d+/$1/;
  46     next unless $path =~ /\.(?:rpm|deb)$/;
  47     my $fn = $path;
  48     $fn =~ s/.*\///;
  49     next if $fn =~ /\.(?:patch|delta)\.rpm$/;
  50     my ($r, $arch);
  51     if ($fn =~ /^(.*)-[^-]+-[^-]+\.([^\. ]+)\.rpm$/) {
  52       $r = $1;
  53       $arch = $2;
  54     } elsif ($path =~ /^(?:.*\/)?([^\/ ]+)\/([^\/ ]+)\.rpm$/) {
  55       #next if $1 eq '.';
  56       $r = $2;
  57       $arch = $1;
  58     } elsif ($fn =~ /^([^_]*)_(?:[^_]*)_([^_]*)\.deb$/) {
  59       $r = $1;
  60       $arch = $2;
  61       $arch = 'noarch' if $arch eq 'all';
  62     } else {
  63       next;
  64     }
  65     next if $arch eq 'src' || $arch eq 'nosrc';
  66     push @known, "$r.$arch-$id";
  67     $known2fn{"$r.$arch-$id"} = $fn;
  68     $known2path{"$r.$arch-$id"} = $path;
  69     my $size = (split('/', $id))[1];
  70     $fnsize2id{"$fn-$size"} = $id;
  71   }
  72
  73   close F;
  74
  75   my %newp;
  76   my %newr;
  77   for (@known) {
  78     $newp{$_} = $oldp{$_} if $oldp{$_};
  79     $newr{$_} = $oldr{$_} if $oldr{$_};
  80   }
  81
  82   my @todo = grep {!($newp{$_} && $newr{$_})} @known;
  83   if (@todo) {
  84     for my $known (@todo) {
  85       my $path = $known2path{$known};
  86       if ($path =~ /\.rpm$/) {
  87         my %res = Build::Rpm::rpmq($path, 1000, 1001, 1002, 1006, 1022, 1047, 1049, 1048, 1050, 1112, 1113);
  88         next unless %res;
  89         Build::Rpm::add_flagsvers(\%res, 1047, 1112, 1113);
  90         Build::Rpm::add_flagsvers(\%res, 1049, 1048, 1050);
  91         my $id = $known;
  92         $id =~ s/.*-//;
  93         if ($known ne "$res{1000}->[0].$res{1022}->[0]-$id") {
  94           $known = "$res{1000}->[0].$res{1022}->[0]-$id";
  95           if (!$known2path{$known}) {
  96             push @known, $known;
  97             $known2path{$known} = $path;
  98           }
  99         }
 100         # rpm3 compatibility: retrofit missing self provides
 101         my $name = $res{1000}->[0];
 102         if (!@{$res{1047} || []} || $res{1047}->[-1] !~ /^\Q$name\E =/) {
 103           my $evr = "$res{1001}->[0]-$res{1002}->[0]";
 104           $evr = "$res{1003}->[0]:$evr" if $res{1003} && $res{1003}->[0];
 105           push @{$res{1047}}, "$name = $evr";
 106         }
 107
 108         $newp{$known} = "P:$known: ".join(' ', @{$res{1047} || []});
 109         $newr{$known} = "R:$known: ".join(' ', @{$res{1049} || []});
 110         #$tag{$known} = $res{1000}->[0]."-".$res{1001}->[0]."-".$res{1002}->[0]." ".$res{1007}->[0]."-".$res{1006}->[0];
 111         $tag{$known} = $res{1000}->[0]."-".$res{1001}->[0]."-".$res{1002}->[0]." ".$res{1006}->[0];
 112       } else {
 113         my %res = Build::Deb::debq($path);
 114         next unless %res;
 115         my ($dn, $da) = ($res{'PACKAGE'}, $res{'ARCHITECTURE'});
 116         $da = 'noarch' if $da eq 'all';
 117         my $id = $known;
 118         $id =~ s/.*-//;
 119         if ($known ne "$dn.$da-$id") {
 120           $known = "$dn.$da-$id";
 121           if (!$known2path{$known}) {
 122             push @known, $known;
 123             $known2path{$known} = $path;
 124           }
 125         }
 126         my @provides = split(',\s*', $res{'PROVIDES'} || '');
 127         my @depends = split(',\s*', $res{'DEPENDS'} || '');
 128         my @predepends = split(',\s*', $res{'PRE-DEPENDS'} || '');
 129         s/\s.*// for @provides;   #for now
 130         s/\s.*// for @depends;    #for now
 131         s/\s.*// for @predepends; #for now
 132         push @depends, @predepends;
 133         push @provides, $res{'PACKAGE'};
 134         $newp{$known} = "P:$known: ".join(' ', @provides);
 135         $newr{$known} = "R:$known: ".join(' ', @depends);
 136       }
 137     }
 138   }
 139   @known = grep {$newp{$_} && $newr{$_}} @known;
 140   for (@known) {
 141     print "F:$_: $known2path{$_}\n";
 142     print "$newp{$_}\n";
 143     print "$newr{$_}\n";
 144     print "I:$_: $tag{$_}\n" if exists $tag{$_};
 145   }
 146 }