auto-br-analyze.pl.in

   1 #!@PERL@ -w
   2 # @configure_input@
   3 #
   4 # Automatic generation of BuildRequires dependencies for rpmbuild.
   5 # Copyright (C) 2008 Red Hat Inc.
   6 # Written by Richard W.M. Jones <rjones@redhat.com>
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # This program is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with this program; if not, write to the Free Software
  20 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 use strict;
  23
  24 use String::ShellQuote;
  25 use File::Temp qw(tempfile);
  26
  27 if (@ARGV != 1) {
  28     die "auto-br-analyze: logfile parameter missing\n";
  29 }
  30
  31 my %files;
  32
  33 my $homedir = $ENV{HOME};
  34
  35 open LOG, "<$ARGV[0]" or die ($ARGV[0], ": $!\n");
  36
  37 while (<LOG>) {
  38     if (/^(open|execve) (.+)/) {
  39         my $file = $2;
  40
  41         # Ignore files which don't exist, and files located in some
  42         # places we ignore (eg. under $HOME).
  43         my ($dev, $ino, $mode) = stat $file;
  44         next unless defined $dev;
  45         next if $homedir && $file =~ /^$homedir/;
  46
  47         $files{$file} = 1;
  48     }
  49 }
  50
  51 close LOG;
  52
  53 # Work out which RPM packages are used.  Note we don't care about
  54 # which specific file is owned by which specific package, which allows
  55 # us to do a lot of nice shell magic for the hard work here.
  56 my @owners;
  57
  58 my ($fh, $filename) = tempfile ();
  59
  60 my $cmd =
  61     "xargs -0 ".
  62     "rpm -q --qf '%{name} %{epoch} %{version} %{release} %{arch}\n' -f ".
  63     "2>&1 | ".
  64     "grep -v '^file.*is not owned by any package\$' | ".
  65     "grep -v '^error:' | ".
  66     "sort -u > $filename";
  67 open PIPE, "| $cmd" or die "$cmd: $!";
  68 print PIPE "$_\0" foreach (sort keys %files);
  69 close PIPE;
  70
  71 while (<$fh>) {
  72     if (/^(\S+) (\d+|\(none\)) (\S+) (\S+) (\S+)$/) {
  73         my ($rpm, $epoch, $version, $release, $arch) =
  74             ($1, $2, $3, $4, $5);
  75         $epoch = "0" if $epoch eq "(none)";
  76         push @owners, {
  77             rpm => $rpm,
  78             epoch => $epoch, version => $version, release => $release,
  79             arch => $arch
  80         }
  81     } else {
  82         die "rpm: $_"
  83     }
  84 }
  85
  86 # Print the list of BuildRequires.
  87
  88 foreach (@owners) {
  89     my $rpm = $_->{rpm};
  90     my $epoch = $_->{epoch};
  91     my $version = $_->{version};
  92     my $release = $_->{release};
  93     my $arch = $_->{arch};
  94
  95     # Ignore 'rpm', 'rpm-build' and a few others which are introduced
  96     # by the rpmbuild system itself.
  97     next if $rpm eq "rpm" || $rpm eq "rpm-build" || $rpm eq "python"
  98         || $rpm eq "redhat-rpm-config";
  99
 100     print "BuildRequires: $rpm = ";
 101     if ($epoch != 0) {
 102         print "$epoch:";
 103     }
 104     print "$version.$release.$arch\n";
 105 }