#!/usr/bin/perl
#
#
#	rpmquery - Query tool for RPM.
#
#	Use "perldoc rpmfind" for help.
#
#	This script is Copyright (C) 1999	Jochen Wiedmann
#						Am Eisteich 9
#						72555 Metzingen
#					        Germany
#
#						E-Mail: joe@ispsoft.de
#
#	You may distribute under the terms of either the GNU General
#	Public License or the Artistic License, as specified in the
#	Perl README.
#


use strict;
use Symbol ();
use File::Find ();
use Getopt::Long ();

my $VERSION = "rpmquery 12-Dec-1999, by Jochen Wiedmann\n";
my @default_skipdirs = qw(/proc);


sub Usage {
    print STDERR <<"USAGE";
Usage: $0 <action> [<options>]

Possible actions are:
  --unknown		Find all files not belonging to any RPM package.
  --showrc=<variable>	Prints the value of an RPM variable.

Possible options are:
  --debug		Turn on debugging mode (really verbose).
  --help		Print this message and exit with error status.
  --nodefaultskipdirs   By default the following directories are ignored:
USAGE
    foreach my $dir (@default_skipdirs) {
	print STDERR "                            $dir\n";
    }
    print STDERR <<"USAGE";
			This option cleans the list. See also the
			option --skipdir.
  --skipdir=<dir>	Adds directory <dir> to the list of directories
			being ignored. See also the option
			--nodefaultskipdirs.
USAGE
    exit 1;
}

use vars qw($debug $defaultskipdirs $skipdir $showrc $unknown);
$defaultskipdirs = 1;
$skipdir = [];
$showrc = [];
Getopt::Long::GetOptions('debug' => \$debug,
			 'defaultskipdirs' => \$defaultskipdirs,
			 'help' => \&Usage,
			 'showrc=s@' => $showrc,
			 'skipdir=s@' => $skipdir,
			 'unknown' => \$unknown);

my $action = 0;
if ($unknown) {
    $action = 1;

    # Find all files not belonging to any RPM package
    my @skipdirs = @default_skipdirs if $defaultskipdirs;
    push(@skipdirs, @$skipdir);
    my %skipdirshash = map { $_ => 1 } @skipdirs;

    my %total_files;
    my $findsub = sub {
	return if $_ eq "." || $_ eq "..";
	if (exists $skipdirshash{$File::Find::name}) {
	    $File::Find::prune = 1;
	    return;
	}
	return if -d $_;
	$total_files{$File::Find::name} = 0;
	print "Adding file: $File::Find::name\n" if $debug;
    };

    File::Find::find($findsub, "/");

    my @rpmlist;
    my $ph = Symbol::gensym();
    open($ph, "rpm -qa |") or die "Failed to create RPM list: $!";
    while (defined(my $line = <$ph>)) {
	$line =~ s/\s+$//;
	push(@rpmlist, $line);
	print "Found package $line\n" if $debug;
    }
    close($ph);

    my %rpmfiles;
    foreach my $rpmpackage (@rpmlist) {
	print "Processing package $rpmpackage\n" if $debug;
	if (!open($ph, "rpm -ql $rpmpackage |")) {
	    print STDERR "Failed to determine contents of RPM package",
		" $rpmpackage: $!\n";
	    next;
	}
	while (defined(my $line = <$ph>)) {
	    $line =~ s/\s+$//;
	    $total_files{$line} = $rpmpackage;
	    print "Removing file $line (package $rpmpackage)\n" if $debug;
	}
	close($ph);
    }

    print "Sorting ...\n" if $debug;
    print sort {$a cmp $b} map { $total_files{$_} ? () : "$_\n" }
	keys %total_files;
}

if (@$showrc) {
    $action = 1;

    # Query an RPM variable
    my $version;
    my $version_output = `rpm --version 2>&1`;
    my $showrc_output = `rpm --showrc`;
    my $findvar;
    if ($version_output =~ /^RPM version 3\./) {
	$version = 3;
	$findvar = sub {
	    my $var = shift;
	    if ($showrc_output =~ /^\-\d+\:\s+\Q$var\E\s+(.*)$/m) {
		my $value = $1;
		$value =~ s/\%\{(.*?)\}/&$findvar($1)/eg;
		$value;
	    } else {
		print STDERR "Unknown RPM variable: $var\n";
		exit 1;
	    }
	};
    } elsif ($version_output =~ /rpm\s+version\s+2\.+/i) {
	$version = 2;
	$findvar = sub {
	    my $var = shift;
	    if ($showrc_output =~ /^\Q$var\s+\S+\s+(.*)$/m) {
		$1;
	    } else {
		print STDERR "Unknown RPM variable: $var\n";
		exit 1;
	    }
	};
    } else {
	print STDERR "Unknown RPM version:\n$version_output\n";
	exit 1;
    }
    foreach my $var (@$showrc) {
	print &$findvar($var), "\n";
    }
}

if (!$action) {
    # No action supplied
    Usage();
}


__END__

=pod

=head1 NAME

rpmquery - RPM query tool


=head1 SYNOPSIS

  # Find all files not belonging to any RPM package:
  rpmquery --unknown

  # Query the value of an RPM macro
  rpmquery --showrc=<macro>


=head1 DESCRIPTION

This program implements some query facilities that are not part of the
current (RPM 3.0.3, as of this writing) RPM package. (At least not AFAIK,
let me know if I am wrong.)

=head2 Find all files not belonging to any RPM package.

  rpmquery --unknown [E<lt>optionsE<gt>]

It is quite simple to find all RPM packages, by doing a

  rpmquery -qa

Likewise, it is simple to determine a list of files owned by an RPM
package with

  rpmquery -ql E<lt>packageE<gt>

However, it is diffucult to determine files that are I<not> owned by
any RPM package.

This action first creates a list of all files stored on your hard
drive. It then combines B<rpm -qa> and B<rpm -ql> to remove all
files from the list, that are owned by some package. Finally it
sorts and prints the remaining list.

Typically there are some directories or files that you don't want to
appear on the list, by default

	F</proc>

You can add files or directories to the list with

	--skipdir=E<lt>some_dirE<gt>

The option may be repeated to add more directories or files. If you
want the list to be initially empty, use the option

	--nodefaultskipdirs


=head2 Query the value of an RPM macro

RPM has a lot of builtin macros, for example the paths of the RPM source
directory, the build directory and so on. One can query the macro values
easily with

	rpm --showrc

Parsing the output was quite easy with RPM 2, but it became really
difficult with RPM 3, as the macros are now recursive: For example
to determine the RPM source directory, one now has to interpret the
following lines of output:

	-14: _sourcedir %{_topdir}/SOURCES
	-14: _topdir %{_usrsrc}/redhat
	-14: _usrsrc %{_usr}/src
	-14: _usr /usr

This is quite simple with rpmquery:

	B<rpmquery --showrc=_sourcedir>

will emit

	/usr/src/redhat/SOURCES

and additionally it will work with RPM 2 and RPM 3 the same.


=head1 AUTHOR AND COPYRIGHT

This script is Copyright (C) 1999

	Jochen Wiedmann
	Am Eisteich 9
	72555 Metzingen
        Germany

	E-Mail: joe@ispsoft.de

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl README.


=head1 CPAN

This file is available as a CPAN script. The following subsections are
for CPAN's automatic link generation and not for humans. You can safely
ignore them.


=head2 SCRIPT CATEGORIES

UNIX/System_administration


=head2 README

This script can be used to query information not supplied by the I<rpm>
tool.


=head2 PREREQUISITES

None.


=head1 TODO

=over

=item *

Add support for multiline variables in --showrc.

=back


=head1 SEE ALSO

L<rpm>, L<makerpm>

=cut