#!/usr/bin/perl
# $Id$

use strict;
#use diagnostics;

sub filereq (@) {
	my @strace = qw(strace -kqfF -e file -o |cat --); # okay, I love cat(1)
	open my $fh, "-|", @strace, @_
		or die "@strace @_ failed\n";
	my %trace; my %files; local $_;
	while (<$fh>) {
		chomp;
		if (s/^(\d+)(\s+)(.*)\s+<unfinished\s+\.\.\.>$/$1$2$3/) {
			die "pid $1 unfinished twice\n"
				if defined $trace{$1};
			$trace{$1} = $_;
			next;
		} elsif (s/^(\d+)\s+<\.\.\.\s+\w+\s+resumed>//) {
			die "pid $1 resumed without being unfinished\n"
				if not defined $trace{$1};
			$_ = delete($trace{$1}) . $_;
		}
		$files{$1}++ if /^\d+\s+\w+\("(\/.+?)"/;
	}
	return \%files;
}

use RPM::Database;
my $rpmdb = RPM::Database->new
	or die "rpmdb: $RPM::err\n";

sub packageof ($) {
	my $hdr = $rpmdb->find_by_file($_[0]);
	$hdr ? $$hdr{NAME} : undef;
}

sub packagereq (@) {
	my $files = filereq @_;
	my %packages;
	while (my ($file, undef) = each %$files) {
		next unless -f $file;
		my $package = packageof $file;
		next unless $package;
		push @{$packages{$package}}, $file;
	}
	return \%packages;
}

use Getopt::Long qw(GetOptions);
GetOptions explain => \my $explain,
	filereq => \my $filereq, packageof => \my $packageof,
	packagereq => \my $packagereq;

$filereq ^ $packageof ^ $packagereq or die "usage: $0 --mode arguments\n";

sub out ($) {
	my $tbl = shift;
	foreach my $k (sort keys %$tbl) {
		print $k . "\n";
		next unless $explain;
		foreach my $v (sort @{$$tbl{$k}}) {
			print "\t$v\n";
		}
	}
}

$filereq and out filereq @ARGV or
$packageof and print packageof($ARGV[0]) . "\n" or
$packagereq and out packagereq @ARGV;