auto-br-analyze.pl: Fix failure when LANG != C. (RHBZ#545867).
[autobuildrequires.git] / 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     "export LANG=C; ".
62     "xargs -0 ".
63     "rpm -q --qf '%{name} %{epoch} %{version} %{release} %{arch}\n' -f ".
64     "2>&1 | ".
65     "grep -v '^file.*is not owned by any package\$' | ".
66     "grep -v '^error:' | ".
67     "sort -u > $filename";
68 open PIPE, "| $cmd" or die "$cmd: $!";
69 print PIPE "$_\0" foreach (sort keys %files);
70 close PIPE;
71
72 while (<$fh>) {
73     if (/^(\S+) (\d+|\(none\)) (\S+) (\S+) (\S+)$/) {
74         my ($rpm, $epoch, $version, $release, $arch) =
75             ($1, $2, $3, $4, $5);
76         $epoch = "0" if $epoch eq "(none)";
77         push @owners, {
78             rpm => $rpm,
79             epoch => $epoch, version => $version, release => $release,
80             arch => $arch
81         }
82     } else {
83         die "rpm: $_"
84     }
85 }
86
87 # Print the list of BuildRequires.
88
89 foreach (@owners) {
90     my $rpm = $_->{rpm};
91     my $epoch = $_->{epoch};
92     my $version = $_->{version};
93     my $release = $_->{release};
94     my $arch = $_->{arch};
95
96     # Ignore 'rpm', 'rpm-build' and a few others which are introduced
97     # by the rpmbuild system itself.
98     next if $rpm eq "rpm" || $rpm eq "rpm-build" || $rpm eq "python"
99         || $rpm eq "redhat-rpm-config";
100
101     print "BuildRequires: $rpm = ";
102     if ($epoch != 0) {
103         print "$epoch:";
104     }
105     print "$version.$release.$arch\n";
106 }